X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/db0406bb64f7e5dceeb257c7e350f1e80ed9c1c1..ce1438d696bd670b5aba5690ce4f73b836b20194:/lisp/server.el diff --git a/lisp/server.el b/lisp/server.el index c421ee0981..42da7a210c 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -235,9 +235,10 @@ If local sockets are not supported, this is nil.") (defun server-clients-with (property value) "Return a list of clients with PROPERTY set to VALUE." (let (result) - (dolist (proc server-clients result) + (dolist (proc server-clients) (when (equal value (process-get proc property)) - (push proc result))))) + (push proc result))) + result)) (defun server-add-client (proc) "Create a client for process PROC, if it doesn't already have one. @@ -735,7 +736,8 @@ Server mode runs a process that accepts commands from the frame)) -(defun server-create-window-system-frame (display nowait proc parent-id) +(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 @@ -750,7 +752,8 @@ Server mode runs a process that accepts commands from the ;; killing emacs on that frame. (let* ((params `((client . ,(if nowait 'nowait proc)) ;; This is a leftover, see above. - (environment . ,(process-get proc 'env)))) + (environment . ,(process-get proc 'env)) + ,@parameters)) (display (or display (frame-parameter nil 'display) (getenv "DISPLAY") @@ -831,6 +834,9 @@ The following commands are accepted by the server: `-current-frame' Forbid the creation of new frames. +`-frame-parameters ALIST' + Set the parameters of the created frame. + `-nowait' Request that the next frame created should not be associated with this client. @@ -939,6 +945,7 @@ The following commands are accepted by the client: commands dir use-current-frame + frame-parameters ;parameters for newly created frame tty-name ; nil, `window-system', or the tty name. tty-type ; string. files @@ -959,6 +966,13 @@ The following commands are accepted by the client: ;; -current-frame: Don't create frames. (`"-current-frame" (setq use-current-frame t)) + ;; -frame-parameters: Set frame parameters + (`"-frame-parameters" + (let ((alist (pop args-left))) + (if coding-system + (setq alist (decode-coding-string alist coding-system))) + (setq frame-parameters (car (read-from-string alist))))) + ;; -display DISPLAY: ;; Open X frames on the given display instead of the default. (`"-display" @@ -1074,7 +1088,8 @@ The following commands are accepted by the client: (if display (server-select-display display))) ((eq tty-name 'window-system) (server-create-window-system-frame display nowait proc - parent-id)) + parent-id + frame-parameters)) ;; When resuming on a tty, tty-name is nil. (tty-name (server-create-tty-frame tty-name tty-type proc)))) @@ -1322,10 +1337,11 @@ specifically for the clients and did not exist before their request for it." "Ask before killing a server buffer." (or (not server-buffer-clients) (let ((res t)) - (dolist (proc server-buffer-clients res) + (dolist (proc server-buffer-clients) (when (and (memq proc server-clients) (eq (process-status proc) 'open)) - (setq res nil)))) + (setq res nil))) + res) (yes-or-no-p (format "Buffer `%s' still has clients; kill it? " (buffer-name (current-buffer)))))) @@ -1333,10 +1349,11 @@ specifically for the clients and did not exist before their request for it." "Ask before exiting Emacs if it has live clients." (or (not server-clients) (let (live-client) - (dolist (proc server-clients live-client) + (dolist (proc server-clients) (when (memq t (mapcar 'buffer-live-p (process-get proc 'buffers))) - (setq live-client t)))) + (setq live-client t))) + live-client) (yes-or-no-p "This Emacs session has clients; exit anyway? "))) (defun server-kill-buffer ()