diff options
Diffstat (limited to 'lisp/server.el')
| -rw-r--r-- | lisp/server.el | 178 |
1 files changed, 131 insertions, 47 deletions
diff --git a/lisp/server.el b/lisp/server.el index ac5db197f3e..d510df1208a 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -90,12 +90,12 @@ (defcustom server-use-tcp nil "If non-nil, use TCP sockets instead of local sockets." - :set #'(lambda (sym val) - (unless (featurep 'make-network-process '(:family local)) - (setq val t) - (unless load-in-progress - (message "Local sockets unsupported, using TCP sockets"))) - (set-default sym val)) + :set (lambda (sym val) + (unless (featurep 'make-network-process '(:family local)) + (setq val t) + (unless load-in-progress + (message "Local sockets unsupported, using TCP sockets"))) + (set-default sym val)) :type 'boolean :version "22.1") @@ -485,11 +485,11 @@ If CLIENT is non-nil, add a description of it to the logged message." (when (and (frame-live-p frame) proc ;; See if this is the last frame for this client. - (>= 1 (let ((frame-num 0)) - (dolist (f (frame-list)) - (when (eq proc (frame-parameter f 'client)) - (setq frame-num (1+ frame-num)))) - frame-num))) + (not (seq-some + (lambda (f) + (and (not (eq frame f)) + (eq proc (frame-parameter f 'client)))) + (frame-list)))) (server-log (format "server-handle-delete-frame, frame %s" frame) proc) (server-delete-client proc 'noframe)))) ; Let delete-frame delete the frame later. @@ -881,7 +881,7 @@ This handles splitting the command if it would be bigger than &optional parameters) (let* ((display (or display (frame-parameter nil 'display) - (error "Please specify display."))) + (error "Please specify display"))) (w (or (cdr (assq 'window-system parameters)) (window-system-for-display display)))) @@ -900,12 +900,17 @@ This handles splitting the command if it would be bigger than ) (cond (w - (server--create-frame - nowait proc - `((display . ,display) - ,@(if parent-id - `((parent-id . ,(string-to-number parent-id)))) - ,@parameters))) + (condition-case nil + (server--create-frame + nowait proc + `((display . ,display) + ,@(if parent-id + `((parent-id . ,(string-to-number parent-id)))) + ,@parameters)) + (error + (server-log "Window system unsupported" proc) + (server-send-string proc "-window-system-unsupported \n") + nil))) (t (server-log "Window system unsupported" proc) @@ -1078,7 +1083,7 @@ The following commands are accepted by the client: `-suspend' Suspend this terminal, i.e., stop the client process. - Sent when the user presses C-z." + Sent when the user presses \\[suspend-frame]." (server-log (concat "Received " string) proc) ;; First things first: let's check the authentication (unless (process-get proc :authenticated) @@ -1580,13 +1585,13 @@ specifically for the clients and did not exist before their request for it." (server-buffer-done (current-buffer)))) (defun server-kill-emacs-query-function () - "Ask before exiting Emacs if it has live clients." - (or (not (let (live-client) - (dolist (proc server-clients) - (when (memq t (mapcar #'buffer-live-p - (process-get proc 'buffers))) - (setq live-client t))) - live-client)) + "Ask before exiting Emacs if it has live clients. +A \"live client\" is a client with at least one live buffer +associated with it." + (or (not (seq-some (lambda (proc) + (seq-some #'buffer-live-p + (process-get proc 'buffers))) + server-clients)) (yes-or-no-p "This Emacs session has clients; exit anyway? "))) (defun server-kill-buffer () @@ -1716,6 +1721,9 @@ be a cons cell (LINENUMBER . COLUMNNUMBER)." (when server-raise-frame (select-frame-set-input-focus (window-frame))))) +(defvar server-stop-automatically nil + "Internal status variable for `server-stop-automatically'.") + ;;;###autoload (defun server-save-buffers-kill-terminal (arg) ;; Called from save-buffers-kill-terminal in files.el. @@ -1724,27 +1732,103 @@ With ARG non-nil, silently save all file-visiting buffers, then kill. If emacsclient was started with a list of filenames to edit, then only these files will be asked to be saved." - (let ((proc (frame-parameter nil 'client))) - (cond ((eq proc 'nowait) - ;; Nowait frames have no client buffer list. - (if (cdr (frame-list)) - (progn (save-some-buffers arg) - (delete-frame)) - ;; If we're the last frame standing, kill Emacs. - (save-buffers-kill-emacs arg))) - ((processp proc) - (let ((buffers (process-get proc 'buffers))) - (save-some-buffers - arg (if buffers - ;; Only files from emacsclient file list. - (lambda () (memq (current-buffer) buffers)) - ;; No emacsclient file list: don't override - ;; `save-some-buffers-default-predicate' (unless - ;; ARG is non-nil), since we're not killing - ;; Emacs (unlike `save-buffers-kill-emacs'). - (and arg t))) - (server-delete-client proc))) - (t (error "Invalid client frame"))))) + (if server-stop-automatically + (server-stop-automatically--handle-delete-frame (selected-frame)) + (let ((proc (frame-parameter nil 'client))) + (cond ((eq proc 'nowait) + ;; Nowait frames have no client buffer list. + (if (cdr (frame-list)) + (progn (save-some-buffers arg) + (delete-frame)) + ;; If we're the last frame standing, kill Emacs. + (save-buffers-kill-emacs arg))) + ((processp proc) + (let ((buffers (process-get proc 'buffers))) + (save-some-buffers + arg (if buffers + ;; Only files from emacsclient file list. + (lambda () (memq (current-buffer) buffers)) + ;; No emacsclient file list: don't override + ;; `save-some-buffers-default-predicate' (unless + ;; ARG is non-nil), since we're not killing + ;; Emacs (unlike `save-buffers-kill-emacs'). + (and arg t))) + (server-delete-client proc))) + (t (error "Invalid client frame")))))) + +(defun server-stop-automatically--handle-delete-frame (frame) + "Handle deletion of FRAME when `server-stop-automatically' is used." + (when server-stop-automatically + (if (if (and (processp (frame-parameter frame 'client)) + (eq this-command 'save-buffers-kill-terminal)) + (progn + (dolist (f (frame-list)) + (when (and (eq (frame-parameter frame 'client) + (frame-parameter f 'client)) + (not (eq frame f))) + (set-frame-parameter f 'client nil) + (let ((server-stop-automatically nil)) + (delete-frame f)))) + (if (cddr (frame-list)) + (let ((server-stop-automatically nil)) + (delete-frame frame) + nil) + t)) + (null (cddr (frame-list)))) + (let ((server-stop-automatically nil)) + (save-buffers-kill-emacs) + (delete-frame frame))))) + +(defun server-stop-automatically--maybe-kill-emacs () + "Handle closing of Emacs daemon when `server-stop-automatically' is used." + (unless (cdr (frame-list)) + (when (and + (not (memq t (mapcar (lambda (b) + (and (buffer-file-name b) + (buffer-modified-p b))) + (buffer-list)))) + (not (memq t (mapcar (lambda (p) + (and (memq (process-status p) + '(run stop open listen)) + (process-query-on-exit-flag p))) + (process-list))))) + (kill-emacs)))) + +;;;###autoload +(defun server-stop-automatically (arg) + "Automatically stop server as specified by ARG. + +If ARG is the symbol `empty', stop the server when it has no +remaining clients, no remaining unsaved file-visiting buffers, +and no running processes with a `query-on-exit' flag. + +If ARG is the symbol `delete-frame', ask the user when the last +frame is deleted whether each unsaved file-visiting buffer must +be saved and each running process with a `query-on-exit' flag +can be stopped, and if so, stop the server itself. + +If ARG is the symbol `kill-terminal', ask the user when the +terminal is killed with \\[save-buffers-kill-terminal] \ +whether each unsaved file-visiting +buffer must be saved and each running process with a `query-on-exit' +flag can be stopped, and if so, stop the server itself. + +Any other value of ARG will cause this function to signal an error. + +This function is meant to be called from the user init file." + (when (daemonp) + (setq server-stop-automatically arg) + (cond + ((eq arg 'empty) + (setq server-stop-automatically nil) + (run-with-timer 10 2 + #'server-stop-automatically--maybe-kill-emacs)) + ((eq arg 'delete-frame) + (add-hook 'delete-frame-functions + #'server-stop-automatically--handle-delete-frame)) + ((eq arg 'kill-terminal)) + (t + (error "Unexpected argument"))))) (define-key ctl-x-map "#" 'server-edit) |