Mercurial > emacs
changeset 83018:1465425fe2d3
Romain Francoise's and Ami Fischman's bugfixes.
src/term.c (create_tty_output): Fix syntax error. Reported by Ami
Fischman (ami at fischman dot org).
lisp/loadup.el: Load term/x-win.el if X is available.
lisp/startup.el (handle-args-function-alist)
(window-system-initialization-alist): New variables.
(command-line): Don't load term/x-win.el, use the above variables.
lisp/x-win.el: (x-initialize-window-system): New function, move X
initialization here.
(x-initialized): New variable.
lisp/frame.el (make-frame-on-display): Don't initialize X twice, and
make sure to pass the correct display parameter to x-open-connection.
Reported by Romain Francoise (romain at orebokech dot com).
git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-58
author | Karoly Lorentey <lorentey@elte.hu> |
---|---|
date | Thu, 22 Jan 2004 02:36:55 +0000 |
parents | 4c6128c0d7e2 |
children | 82c3b4da43ca |
files | README.multi-tty lisp/frame.el lisp/loadup.el lisp/startup.el lisp/term/x-win.el src/term.c |
diffstat | 6 files changed, 185 insertions(+), 142 deletions(-) [+] |
line wrap: on
line diff
--- a/README.multi-tty Mon Jan 12 16:36:35 2004 +0000 +++ b/README.multi-tty Thu Jan 22 02:36:55 2004 +0000 @@ -140,6 +140,8 @@ THINGS TO DO ------------ +** emacs -nw --eval '(y-or-n-p "Foobar")' segfaults. + ** Fix color handling during tty+X combo sessions. (It seems that tty sessions automatically convert the face colors to terminal colors when the face is loaded. This conversion must happen instead on
--- a/lisp/frame.el Mon Jan 12 16:36:35 2004 +0000 +++ b/lisp/frame.el Thu Jan 22 02:36:55 2004 +0000 @@ -570,7 +570,9 @@ (interactive "sMake frame on display: ") (or (string-match "\\`[^:]*:[0-9]+\\(\\.[0-9]+\\)?\\'" display) (error "Invalid display, not HOST:SERVER or HOST:SERVER.SCREEN")) - (load (concat term-file-prefix "x-win")) + (unless x-initialized + (setq x-display-name display) + (x-initialize-window-system)) (make-frame `((window-system . x) (display . ,display) . ,parameters))) (defun make-frame-on-tty (device type &optional parameters)
--- a/lisp/loadup.el Mon Jan 12 16:36:35 2004 +0000 +++ b/lisp/loadup.el Thu Jan 22 02:36:55 2004 +0000 @@ -190,6 +190,13 @@ (load "emacs-lisp/float-sup"))) (message "%s" (garbage-collect)) +(when (fboundp 'x-create-frame) + (load "mouse") + (load "international/fontset") + (load "term/x-win")) + +(message "%s" (garbage-collect)) + (load "vc-hooks") (load "ediff-hook") (message "%s" (garbage-collect))
--- a/lisp/startup.el Mon Jan 12 16:36:35 2004 +0000 +++ b/lisp/startup.el Thu Jan 22 02:36:55 2004 +0000 @@ -590,6 +590,20 @@ (defvar tool-bar-originally-present nil "Non-nil if tool-bars are present before user and site init files are read.") +(defvar handle-args-function-alist '((nil . tty-handle-args)) + "Functions for processing window-system dependent command-line arguments. +Window system startup files should add their own function to this +alist, which should parse the command line arguments. Those +pertaining to the window system should be processed and removed +from the returned command line.") + +(defvar window-system-initialization-alist '((nil . ignore)) + "Alist of window-system initialization functions. +Window-system startup files should add their own initialization +function to this list. The function should take no arguments, +and initialize the window system environment to prepare for +opening the first frame (e.g. open a connection to the server).") + ;; Handle the X-like command-line arguments "-fg", "-bg", "-name", etc. (defun tty-handle-args (args) (let (rest) @@ -709,14 +723,21 @@ ;; Read window system's init file if using a window system. (condition-case error - (if (and initial-window-system (not noninteractive)) - (load (concat term-file-prefix - (symbol-name initial-window-system) - "-win") - ;; Every window system should have a startup file; - ;; barf if we can't find it. - nil t)) - ;; If we can't read it, print the error message and exit. + (unless noninteractive + (if (and initial-window-system + (not (featurep + (intern (concat (symbol-name initial-window-system) + "-win"))))) + (error "Unsupported window system `%s'" initial-window-system)) + ;; Process window-system specific command line parameters. + (setq command-line-args + (funcall (or (cdr (assq initial-window-system handle-args-function-alist)) + (error "Unsupported window system `%s'" initial-window-system)) + command-line-args)) + ;; 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)))) + ;; If there was an error, print the error message and exit. (error (princ (if (eq (car error) 'error) @@ -735,10 +756,6 @@ (setq initial-window-system nil) (kill-emacs))) - ;; Windowed displays do this inside their *-win.el. - (unless (or (display-graphic-p) noninteractive) - (setq command-line-args (tty-handle-args command-line-args))) - (set-locale-environment nil) ;; Convert the arguments to Emacs internal representation.
--- a/lisp/term/x-win.el Mon Jan 12 16:36:35 2004 +0000 +++ b/lisp/term/x-win.el Thu Jan 22 02:36:55 2004 +0000 @@ -24,10 +24,16 @@ ;;; Commentary: -;; X-win.el: this file is loaded from ../lisp/startup.el when it recognizes -;; that X windows are to be used. Command line switches are parsed and those -;; pertaining to X are processed and removed from the command line. The -;; X display is opened and hooks are set for popping up the initial window. +;; X-win.el: this file defines functions to initialize the X window +;; system and process X-specific command line parameters before +;; creating the first X frame. + +;; Note that contrary to previous Emacs versions, the act of loading +;; this file should not have the side effect of initializing the +;; window system or processing command line arguments (this file is +;; now loaded in loadup.el). See the variables +;; `handle-args-function-alist' and +;; `window-system-initialization-alist' for more details. ;; startup.el will then examine startup files, and eventually call the hooks ;; which create the first window(s). @@ -1159,10 +1165,6 @@ ;;;; Function keys -;;; XXX This might be wrong with multi-tty support. -(substitute-key-definition 'suspend-emacs 'iconify-or-deiconify-frame - global-map) - ;; Map certain keypad keys into ASCII characters ;; that people usually expect. (define-key function-key-map [backspace] [127]) @@ -2237,7 +2239,7 @@ (if text (remove-text-properties 0 (length text) '(foreign-selection nil) text)) text)) - + ;;; Return the value of the current X selection. ;;; Consult the selection, and the cut buffer. Treat empty strings ;;; as if they were unset. @@ -2329,132 +2331,143 @@ )) -;;; Do the actual X Windows setup here; the above code just defines -;;; functions and variables that we use now. - -(setq command-line-args (x-handle-args command-line-args)) - -;;; Make sure we have a valid resource name. -(or (stringp x-resource-name) - (let (i) - (setq x-resource-name (invocation-name)) - - ;; Change any . or * characters in x-resource-name to hyphens, - ;; so as not to choke when we use it in X resource queries. - (while (setq i (string-match "[.*]" x-resource-name)) - (aset x-resource-name i ?-)))) - -(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 and we - ;; are the initial display. - (eq initial-window-system 'x)) - -(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)) - -;; Setup the default fontset. -(setup-default-fontset) - -;; Create the standard fontset. -(create-fontset-from-fontset-spec standard-fontset-spec t) - -;; Create fontset specified in X resources "Fontset-N" (N is 0, 1, ...). -(create-fontset-from-x-resource) - -;; Try to create a fontset from a font specification which comes -;; from initial-frame-alist, default-frame-alist, or X resource. -;; A font specification in command line argument (i.e. -fn XXXX) -;; should be already in default-frame-alist as a `font' -;; parameter. However, any font specifications in site-start -;; library, user's init file (.emacs), and default.el are not -;; yet handled here. +;;; Window system initialization. -(let ((font (or (cdr (assq 'font initial-frame-alist)) - (cdr (assq 'font default-frame-alist)) - (x-get-resource "font" "Font"))) - xlfd-fields resolved-name) - (if (and font - (not (query-fontset font)) - (setq resolved-name (x-resolve-font-name font)) - (setq xlfd-fields (x-decompose-font-name font))) - (if (string= "fontset" (aref xlfd-fields xlfd-regexp-registry-subnum)) - (new-fontset font (x-complement-fontset-spec xlfd-fields nil)) - ;; Create a fontset from FONT. The fontset name is - ;; generated from FONT. - (create-fontset-from-ascii-font font resolved-name "startup")))) - -;; Sun expects the menu bar cut and paste commands to use the clipboard. -;; This has ,? to match both on Sunos and on Solaris. -(if (string-match "Sun Microsystems,? Inc\\." - (x-server-vendor)) - (menu-bar-enable-clipboard)) - -;; Apply a geometry resource to the initial frame. Put it at the end -;; of the alist, so that anything specified on the command line takes -;; precedence. -(let* ((res-geometry (x-get-resource "geometry" "Geometry")) - parsed) - (if res-geometry - (progn - (setq parsed (x-parse-geometry res-geometry)) - ;; If the resource specifies a position, - ;; call the position and size "user-specified". - (if (or (assq 'top parsed) (assq 'left parsed)) - (setq parsed (cons '(user-position . t) - (cons '(user-size . t) parsed)))) - ;; All geometry parms apply to the initial frame. - (setq initial-frame-alist (append initial-frame-alist parsed)) - ;; The size parms apply to all frames. - (if (assq 'height parsed) - (setq default-frame-alist - (cons (cons 'height (cdr (assq 'height parsed))) - default-frame-alist))) - (if (assq 'width parsed) - (setq default-frame-alist - (cons (cons 'width (cdr (assq 'width parsed))) - default-frame-alist)))))) - -;; Check the reverseVideo resource. -(let ((case-fold-search t)) - (let ((rv (x-get-resource "reverseVideo" "ReverseVideo"))) - (if (and rv - (string-match "^\\(true\\|yes\\|on\\)$" rv)) - (setq default-frame-alist - (cons '(reverse . t) default-frame-alist))))) - -;; Set x-selection-timeout, measured in milliseconds. -(let ((res-selection-timeout - (x-get-resource "selectionTimeout" "SelectionTimeout"))) - (setq x-selection-timeout 20000) - (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) + +(defvar x-initialized nil + "Non-nil if the X window system has been initialized.") + +(defun x-initialize-window-system () + "Initialize Emacs for X frames and open the first connection to an X server." + ;; Make sure we have a valid resource name. + (or (stringp x-resource-name) + (let (i) + (setq x-resource-name (invocation-name)) + + ;; Change any . or * characters in x-resource-name to hyphens, + ;; so as not to choke when we use it in X resource queries. + (while (setq i (string-match "[.*]" x-resource-name)) + (aset x-resource-name i ?-)))) + + (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 and we + ;; are the initial display. + (eq initial-window-system 'x)) + + (setq x-cut-buffer-max (min (- (/ (x-server-max-request-size) 2) 100) + x-cut-buffer-max)) + + ;; Setup the default fontset. + (setup-default-fontset) -;;; Arrange for the kill and yank functions to set and check the clipboard. -(setq interprogram-cut-function 'x-select-text) -(setq interprogram-paste-function 'x-cut-buffer-or-selection-value) + ;; Create the standard fontset. + (create-fontset-from-fontset-spec standard-fontset-spec t) + + ;; Create fontset specified in X resources "Fontset-N" (N is 0, 1, ...). + (create-fontset-from-x-resource) + + ;; Try to create a fontset from a font specification which comes + ;; from initial-frame-alist, default-frame-alist, or X resource. + ;; A font specification in command line argument (i.e. -fn XXXX) + ;; should be already in default-frame-alist as a `font' + ;; parameter. However, any font specifications in site-start + ;; library, user's init file (.emacs), and default.el are not + ;; yet handled here. -;;; Turn off window-splitting optimization; X is usually fast enough -;;; that this is only annoying. -(setq split-window-keep-point t) + (let ((font (or (cdr (assq 'font initial-frame-alist)) + (cdr (assq 'font default-frame-alist)) + (x-get-resource "font" "Font"))) + xlfd-fields resolved-name) + (if (and font + (not (query-fontset font)) + (setq resolved-name (x-resolve-font-name font)) + (setq xlfd-fields (x-decompose-font-name font))) + (if (string= "fontset" (aref xlfd-fields xlfd-regexp-registry-subnum)) + (new-fontset font (x-complement-fontset-spec xlfd-fields nil)) + ;; Create a fontset from FONT. The fontset name is + ;; generated from FONT. + (create-fontset-from-ascii-font font resolved-name "startup")))) + + ;; Sun expects the menu bar cut and paste commands to use the clipboard. + ;; This has ,? to match both on Sunos and on Solaris. + (if (string-match "Sun Microsystems,? Inc\\." + (x-server-vendor)) + (menu-bar-enable-clipboard)) -;; Motif direct handling of f10 wasn't working right, -;; So temporarily we've turned it off in lwlib-Xm.c -;; and turned the Emacs f10 back on. -;; ;; Motif normally handles f10 itself, so don't try to handle it a second time. -;; (if (featurep 'motif) -;; (global-set-key [f10] 'ignore)) + ;; Apply a geometry resource to the initial frame. Put it at the end + ;; of the alist, so that anything specified on the command line takes + ;; precedence. + (let* ((res-geometry (x-get-resource "geometry" "Geometry")) + parsed) + (if res-geometry + (progn + (setq parsed (x-parse-geometry res-geometry)) + ;; If the resource specifies a position, + ;; call the position and size "user-specified". + (if (or (assq 'top parsed) (assq 'left parsed)) + (setq parsed (cons '(user-position . t) + (cons '(user-size . t) parsed)))) + ;; All geometry parms apply to the initial frame. + (setq initial-frame-alist (append initial-frame-alist parsed)) + ;; The size parms apply to all frames. + (if (assq 'height parsed) + (setq default-frame-alist + (cons (cons 'height (cdr (assq 'height parsed))) + default-frame-alist))) + (if (assq 'width parsed) + (setq default-frame-alist + (cons (cons 'width (cdr (assq 'width parsed))) + default-frame-alist)))))) + + ;; Check the reverseVideo resource. + (let ((case-fold-search t)) + (let ((rv (x-get-resource "reverseVideo" "ReverseVideo"))) + (if (and rv + (string-match "^\\(true\\|yes\\|on\\)$" rv)) + (setq default-frame-alist + (cons '(reverse . t) default-frame-alist))))) -;; Turn on support for mouse wheels. -(mouse-wheel-mode 1) + ;; Set x-selection-timeout, measured in milliseconds. + (let ((res-selection-timeout + (x-get-resource "selectionTimeout" "SelectionTimeout"))) + (setq x-selection-timeout 20000) + (if res-selection-timeout + (setq x-selection-timeout (string-to-number res-selection-timeout)))) + + ;; XXX This is wrong in general with multi-tty support. + (substitute-key-definition 'suspend-emacs 'iconify-or-deiconify-frame + global-map) + + ;; XXX This is wrong in general with multi-tty support. + (add-hook 'suspend-hook 'x-win-suspend-error) + + ;; Arrange for the kill and yank functions to set and check the clipboard. + (setq interprogram-cut-function 'x-select-text) + (setq interprogram-paste-function 'x-cut-buffer-or-selection-value) + + ;; Turn off window-splitting optimization; X is usually fast enough + ;; that this is only annoying. + (setq split-window-keep-point t) + + ;; Motif direct handling of f10 wasn't working right, + ;; So temporarily we've turned it off in lwlib-Xm.c + ;; and turned the Emacs f10 back on. + ;; ;; Motif normally handles f10 itself, so don't try to handle it a second time. + ;; (if (featurep 'motif) + ;; (global-set-key [f10] 'ignore)) + + ;; Turn on support for mouse wheels. + (mouse-wheel-mode 1) + + (setq x-initialized t)) + +(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)) (provide 'x-win)
--- a/src/term.c Mon Jan 12 16:36:35 2004 +0000 +++ b/src/term.c Thu Jan 22 02:36:55 2004 +0000 @@ -2908,10 +2908,12 @@ void create_tty_output (struct frame *f) { + struct tty_output *t; + if (! FRAME_TERMCAP_P (f)) abort (); - struct tty_output *t = xmalloc (sizeof (struct tty_output)); + t = xmalloc (sizeof (struct tty_output)); bzero (t, sizeof (struct tty_output)); t->display_info = FRAME_DISPLAY (f)->display_info.tty;