From f2bb5747f0b548b6de1f639adf1c106de6fae499 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 10 Nov 2020 23:26:28 -0500 Subject: [PATCH] * lisp/server.el: Refactor frame creation functions (server--create-frame): New function, extracted from `server-create-dumb-terminal-frame`. (server-create-window-system-frame, server-create-tty-frame): (server-create-dumb-terminal-frame): Use it. --- lisp/server.el | 89 +++++++++++++++++++++++--------------------------- 1 file changed, 41 insertions(+), 48 deletions(-) diff --git a/lisp/server.el b/lisp/server.el index 734fb8a34ac..763f651fefc 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -832,7 +832,6 @@ This handles splitting the command if it would be bigger than (error "Invalid terminal device")) (unless type (error "Invalid terminal type")) - (add-to-list 'frame-inherited-parameters 'client) (let ((frame (server-with-environment (process-get proc 'env) @@ -844,32 +843,19 @@ This handles splitting the command if it would be bigger than "TERMINFO_DIRS" "TERMPATH" ;; rxvt wants these "COLORFGBG" "COLORTERM") - (make-frame `((window-system . nil) - (tty . ,tty) - (tty-type . ,type) - ;; Ignore nowait here; we always need to - ;; clean up opened ttys when the client dies. - (client . ,proc) - ;; This is a leftover from an earlier - ;; attempt at making it possible for process - ;; run in the server process to use the - ;; environment of the client process. - ;; It has no effect now and to make it work - ;; we'd need to decide how to make - ;; process-environment interact with client - ;; envvars, and then to change the - ;; C functions `child_setup' and - ;; `getenv_internal' accordingly. - (environment . ,(process-get proc 'env)) - ,@parameters))))) + (server--create-frame + ;; Ignore nowait here; we always need to + ;; clean up opened ttys when the client dies. + nil proc + `((window-system . nil) + (tty . ,tty) + (tty-type . ,type) + ,@parameters))))) ;; ttys don't use the `display' parameter, but callproc.c does to set ;; the DISPLAY environment on subprocesses. (set-frame-parameter frame 'display (getenv-internal "DISPLAY" (process-get proc 'env))) - (select-frame frame) - (process-put proc 'frame frame) - (process-put proc 'terminal (frame-terminal frame)) frame)) (defun server-create-window-system-frame (display nowait proc parent-id @@ -895,25 +881,12 @@ This handles splitting the command if it would be bigger than ) (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)) + (server--create-frame + nowait proc + `((display . ,display) + ,@(if parent-id + `((parent-id . ,(string-to-number parent-id)))) + ,@parameters))) (t (server-log "Window system unsupported" proc) @@ -921,16 +894,41 @@ This handles splitting the command if it would be bigger than nil)))) (defun server-create-dumb-terminal-frame (nowait proc &optional parameters) + ;; If the destination is a dumb terminal, we can't really run Emacs + ;; in its tty. So instead, we use whichever terminal is currently + ;; selected. This situation typically occurs when `emacsclient' is + ;; running inside something like an Emacs shell buffer (bug#25547). + (let ((frame (server--create-frame nowait proc parameters))) + ;; The client is not the exclusive owner of this terminal, so don't + ;; delete the terminal when the client exits. + ;; FIXME: Maybe we just shouldn't set the `terminal' property instead? + (process-put proc 'no-delete-terminal t) + frame)) + +(defun server--create-frame (nowait proc parameters) (add-to-list 'frame-inherited-parameters 'client) + ;; When `nowait' is set, 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 ((frame (make-frame `((client . ,(if nowait 'nowait proc)) - ;; This is a leftover, see above. + ;; This is a leftover from an earlier + ;; attempt at making it possible for process + ;; run in the server process to use the + ;; environment of the client process. + ;; It has no effect now and to make it work + ;; we'd need to decide how to make + ;; process-environment interact with client + ;; envvars, and then to change the + ;; C functions `child_setup' and + ;; `getenv_internal' accordingly. (environment . ,(process-get proc 'env)) ,@parameters)))) (server-log (format "%s created" frame) proc) (select-frame frame) (process-put proc 'frame frame) (process-put proc 'terminal (frame-terminal frame)) - (process-put proc 'no-delete-terminal t) frame)) (defun server-goto-toplevel (proc) @@ -1280,11 +1278,6 @@ The following commands are accepted by the client: (setq tty-name nil tty-type nil) (if display (server-select-display display))) ((equal tty-type "dumb") - ;; Emacsclient is likely running inside something - ;; like an Emacs shell buffer. We can't run an - ;; Emacs frame in a tty like this, so instead, use - ;; whichever terminal is currently - ;; selected. (bug#25547) (server-create-dumb-terminal-frame nowait proc frame-parameters)) ((or (and (eq system-type 'windows-nt) -- 2.39.2