;;; server.el --- Lisp code for GNU Emacs running as server process
;; Copyright (C) 1986, 1987, 1992, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
-;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
;; Author: William Sommerfeld <wesommer@athena.mit.edu>
;; Maintainer: FSF
:version "22.1")
(put 'server-host 'risky-local-variable t)
-(defcustom server-auth-dir (concat user-emacs-directory "server/")
+(defcustom server-auth-dir (locate-user-emacs-file "server/")
"Directory for server authentication files."
:group 'server
:type 'directory
it with the Emacs server. If nil, kill only buffers as specified by
`server-temp-file-regexp'.
Please note that only buffers that still have a client are killed,
-i.e. buffers visited with \"emacsclient --no-wait\" are never killed in
-this way."
+i.e. buffers visited with \"emacsclient --no-wait\" are never killed
+in this way."
:group 'server
:type 'boolean
:version "21.1")
are done with it in the server.")
(make-variable-buffer-local 'server-existing-buffer)
-(defvar server-name "server")
+(defcustom server-name "server"
+ "The name of the Emacs server, if this Emacs process creates one.
+The command `server-start' makes use of this. It should not be
+changed while a server is running."
+ :group 'server
+ :type 'string
+ :version "23.1")
-(defvar server-socket-dir (format "/tmp/emacs%d" (user-uid))
- "The directory in which to place the server socket.")
+;; We do not use `temporary-file-directory' here, because emacsclient
+;; does not read the init file.
+(defvar server-socket-dir
+ (and (featurep 'make-network-process '(:family local))
+ (format "%s/emacs%d" (or (getenv "TMPDIR") "/tmp") (user-uid)))
+ "The directory in which to place the server socket.
+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 ((process-environment process-environment))
(dolist (,var ,vars)
(let ((,value (getenv-internal ,var ,env)))
- (push (if (null ,value)
- ,var
- (concat ,var "=" ,value))
+ (push (if (stringp ,value)
+ (concat ,var "=" ,value)
+ ,var)
process-environment)))
(progn ,@body))))
(defun server-delete-client (proc &optional noframe)
"Delete PROC, including its buffers, terminals and frames.
-If NOFRAME is non-nil, let the frames live. (To be used from
-`delete-frame-functions'.)"
+If NOFRAME is non-nil, let the frames live.
+Updates `server-clients'."
(server-log (concat "server-delete-client" (if noframe " noframe")) proc)
;; Force a new lookup of client (prevents infinite recursion).
(when (memq proc server-clients)
(process-query-on-exit-flag proc))
(set-process-query-on-exit-flag proc nil))
;; Delete the associated connection file, if applicable.
- ;; This is actually problematic: the file may have been overwritten by
- ;; another Emacs server in the mean time, so it's not ours any more.
- ;; (and (process-contact proc :server)
- ;; (eq (process-status proc) 'closed)
- ;; (ignore-errors (delete-file (process-get proc :server-file))))
+ ;; Although there's no 100% guarantee that the file is owned by the
+ ;; running Emacs instance, server-start uses server-running-p to check
+ ;; for possible servers before doing anything, so it *should* be ours.
+ (and (process-contact proc :server)
+ (eq (process-status proc) 'closed)
+ (ignore-errors (delete-file (process-get proc :server-file))))
(server-log (format "Status changed to %s: %s" (process-status proc) msg) proc)
(server-delete-client proc))
(defun server-select-display (display)
;; If the current frame is on `display' we're all set.
- ;; Similarly if we are unable to open a frames on other displays, there's
+ ;; Similarly if we are unable to open frames on other displays, there's
;; nothing more we can do.
(unless (or (not (fboundp 'make-frame-on-display))
(equal (frame-parameter (selected-frame) 'display) display))
(set-frame-parameter frame 'server-dummy-buffer nil)))
(defun server-handle-delete-frame (frame)
- "Delete the client connection when the emacsclient frame is deleted."
+ "Delete the client connection when the emacsclient frame is deleted.
+\(To be used from `delete-frame-functions'.)"
(let ((proc (frame-parameter frame 'client)))
(when (and (frame-live-p frame)
proc
arg t t))
(defun server-send-string (proc string)
- "A wrapper around `proc-send-string' for logging."
+ "A wrapper around `process-send-string' for logging."
(server-log (concat "Sent " string) proc)
(process-send-string proc string))
Emacs distribution as your standard \"editor\".
Optional argument LEAVE-DEAD (interactively, a prefix arg) means just
-kill any existing server communications subprocess."
+kill any existing server communications subprocess.
+
+If a server is already running, the server is not started.
+To force-start a server, do \\[server-force-delete] and then
+\\[server-start]."
(interactive "P")
- (when (or
- (not server-clients)
- (yes-or-no-p
- "The current server still has clients; delete them? "))
- (when server-process
- ;; kill it dead!
- (ignore-errors (delete-process server-process)))
- ;; Delete the socket files made by previous server invocations.
- (condition-case ()
- (delete-file (expand-file-name server-name server-socket-dir))
- (error nil))
- ;; If this Emacs already had a server, clear out associated status.
- (while server-clients
- (server-delete-client (car server-clients)))
- ;; Now any previous server is properly stopped.
- (if leave-dead
- (progn
- (server-log (message "Server stopped"))
- (setq server-process nil))
- (let* ((server-dir (if server-use-tcp server-auth-dir server-socket-dir))
- (server-file (expand-file-name server-name server-dir)))
+ (when (or (not server-clients)
+ ;; Ask the user before deleting existing clients---except
+ ;; when we can't get user input, which may happen when
+ ;; doing emacsclient --eval "(kill-emacs)" in daemon mode.
+ (if (and (daemonp)
+ (null (cdr (frame-list)))
+ (eq (selected-frame) terminal-frame))
+ leave-dead
+ (yes-or-no-p
+ "The current server still has clients; delete them? ")))
+ (let* ((server-dir (if server-use-tcp server-auth-dir server-socket-dir))
+ (server-file (expand-file-name server-name server-dir)))
+ (when server-process
+ ;; kill it dead!
+ (ignore-errors (delete-process server-process)))
+ ;; Delete the socket files made by previous server invocations.
+ (if (not (eq t (server-running-p server-name)))
+ ;; Remove any leftover socket or authentication file
+ (ignore-errors (delete-file server-file))
+ (setq server-mode nil) ;; already set by the minor mode code
+ (display-warning
+ 'server
+ (concat "Unable to start the Emacs server.\n"
+ (format "There is an existing Emacs server, named %S.\n"
+ server-name)
+ "To start the server in this Emacs process, stop the existing
+server or call `M-x server-force-delete' to forcibly disconnect it.")
+ :warning)
+ (setq leave-dead t))
+ ;; If this Emacs already had a server, clear out associated status.
+ (while server-clients
+ (server-delete-client (car server-clients)))
+ ;; Now any previous server is properly stopped.
+ (if leave-dead
+ (progn
+ (unless (eq t leave-dead) (server-log (message "Server stopped")))
+ (setq server-process nil))
;; Make sure there is a safe directory in which to place the socket.
(server-ensure-safe-dir server-dir)
- ;; Remove any leftover socket or authentication file.
- (ignore-errors (delete-file server-file))
(when server-process
(server-log (message "Restarting server")))
(letf (((default-file-modes) ?\700))
:service server-file
:plist '(:authenticated t)))))
(unless server-process (error "Could not start server process"))
+ (process-put server-process :server-file server-file)
(when server-use-tcp
(let ((auth-key
(loop
" " (int-to-string (emacs-pid))
"\n" auth-key)))))))))
-(defun server-running-p (&optional name)
- "Test whether server NAME is running."
+;;;###autoload
+(defun server-force-delete (&optional name)
+ "Unconditionally delete connection file for server NAME.
+If server is running, it is first stopped.
+NAME defaults to `server-name'. With argument, ask for NAME."
(interactive
(list (if current-prefix-arg
(read-string "Server name: " nil nil server-name))))
+ (when server-mode (with-temp-message nil (server-mode -1)))
+ (let ((file (expand-file-name (or name server-name)
+ (if server-use-tcp
+ server-auth-dir
+ server-socket-dir))))
+ (condition-case nil
+ (progn
+ (delete-file file)
+ (message "Connection file %S deleted" file))
+ (file-error
+ (message "No connection file %S" file)))))
+
+(defun server-running-p (&optional name)
+ "Test whether server NAME is running.
+
+Return values:
+ nil the server is definitely not running.
+ t the server seems to be running.
+ something else we cannot determine whether it's running without using
+ commands which may have to wait for a long time."
(unless name (setq name server-name))
(condition-case nil
- (progn
+ (if server-use-tcp
+ (with-temp-buffer
+ (insert-file-contents-literally (expand-file-name name server-auth-dir))
+ (or (and (looking-at "127\\.0\\.0\\.1:[0-9]+ \\([0-9]+\\)")
+ (assq 'comm
+ (process-attributes
+ (string-to-number (match-string 1))))
+ t)
+ :other))
(delete-process
(make-network-process
:name "server-client-test" :family 'local :server nil :noquery t
(server-quote-arg text)))))))))
(defun server-create-tty-frame (tty type proc)
+ (unless tty
+ (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)
"TERMINFO_DIRS" "TERMPATH"
;; rxvt wants these
"COLORFGBG" "COLORTERM")
- (make-frame-on-tty tty 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)))))))
+ (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)))))))
;; ttys don't use the `display' parameter, but callproc.c does to set
;; the DISPLAY environment on subprocesses.
(switch-to-buffer (get-buffer-create "*scratch*") 'norecord)
frame)))
-
(defun server-goto-toplevel (proc)
(condition-case nil
;; If we're running isearch, we must abort it to allow Emacs to
(defun* server-process-filter (proc string)
"Process a request from the server to edit some files.
PROC is the server process. STRING consists of a sequence of
-commands prefixed by a dash. Some commands have arguments; these
-are &-quoted and need to be decoded by `server-unquote-arg'. The
-filter parses and executes these commands.
+commands prefixed by a dash. Some commands have arguments;
+these are &-quoted and need to be decoded by `server-unquote-arg'.
+The filter parses and executes these commands.
To illustrate the protocol, here is an example command that
emacsclient sends to create a new X frame (note that the whole
sequence is sent on a single line):
- -env HOME /home/lorentey
- -env DISPLAY :0.0
+ -env HOME=/home/lorentey
+ -env DISPLAY=:0.0
... lots of other -env commands
-display :0.0
-window-system
controlling tty.
`-ignore COMMENT'
- Do nothing, but put the comment in the server
- log. Useful for debugging.
+ Do nothing, but put the comment in the server log.
+ Useful for debugging.
The following commands are accepted by the client:
frame ; The frame that was opened for the client (if any).
display ; Open the frame on this display.
dontkill ; t if the client should not be killed.
- (commands ())
+ commands
dir
- (tty-name nil) ;nil, `window-system', or the tty name.
- tty-type ;string.
- (files nil)
- (filepos nil)
+ use-current-frame
+ tty-name ;nil, `window-system', or the tty name.
+ tty-type ;string.
+ files
+ filepos
command-line-args-left
arg)
;; Remove this line from STRING.
((equal "-nowait" arg) (setq nowait t))
;; -current-frame: Don't create frames.
- ((equal "-current-frame" arg) (setq tty-name nil))
+ ((equal "-current-frame" arg) (setq use-current-frame t))
;; -display DISPLAY:
;; Open X frames on the given display instead of the default.
(cdr command-line-args-left))
(setq tty-name (pop command-line-args-left)
tty-type (pop command-line-args-left)
- dontkill t))
+ dontkill (or dontkill
+ (not use-current-frame))))
;; -position LINE[:COLUMN]: Set point to the given
;; position in the next file.
(let ((file (pop command-line-args-left)))
(if coding-system
(setq file (decode-coding-string file coding-system)))
- (setq file (command-line-normalize-file-name file))
+ (setq file (expand-file-name file dir))
(push (cons file filepos) files)
(server-log (format "New file: %s %s"
file (or filepos "")) proc))
;; -eval EXPR: Evaluate a Lisp expression.
((and (equal "-eval" arg)
command-line-args-left)
+ (if use-current-frame
+ (setq use-current-frame 'always))
(lexical-let ((expr (pop command-line-args-left)))
(if coding-system
(setq expr (decode-coding-string expr coding-system)))
;; Unknown command.
(t (error "Unknown command: %s" arg))))
- (setq frame
- (case tty-name
- ((nil) (if display (server-select-display display)))
- ((window-system)
- (server-create-window-system-frame display nowait proc))
- (t (server-create-tty-frame tty-name tty-type proc))))
+ (setq frame
+ (cond
+ ((and use-current-frame
+ (or (eq use-current-frame 'always)
+ ;; We can't use the Emacs daemon's
+ ;; terminal frame.
+ (not (and (daemonp)
+ (null (cdr (frame-list)))
+ (eq (selected-frame)
+ terminal-frame)))))
+ (setq tty-name nil tty-type nil)
+ (if display (server-select-display display)))
+ ((eq tty-name 'window-system)
+ (server-create-window-system-frame display nowait proc))
+ ;; When resuming on a tty, tty-name is nil.
+ (tty-name
+ (server-create-tty-frame tty-name tty-type proc))))
(process-put
proc 'continuation
(error (server-return-error proc err))))
(defun server-execute (proc files nowait commands dontkill frame tty-name)
- (condition-case err
- (let* ((buffers
- (when files
- (run-hooks 'pre-command-hook)
- (prog1 (server-visit-files files proc nowait)
- (run-hooks 'post-command-hook)))))
-
- (mapc 'funcall (nreverse commands))
-
- ;; Delete the client if necessary.
- (cond
- (nowait
- ;; Client requested nowait; return immediately.
- (server-log "Close nowait client" proc)
- (server-delete-client proc))
- ((and (not dontkill) (null buffers))
- ;; This client is empty; get rid of it immediately.
- (server-log "Close empty client" proc)
- (server-delete-client proc)))
- (cond
- ((or isearch-mode (minibufferp))
- nil)
- ((and frame (null buffers))
- (message "%s" (substitute-command-keys
- "When done with this frame, type \\[delete-frame]")))
- ((not (null buffers))
- (server-switch-buffer (car buffers))
- (run-hooks 'server-switch-hook)
- (unless nowait
+ ;; This is run from timers and process-filters, i.e. "asynchronously".
+ ;; But w.r.t the user, this is not really asynchronous since the timer
+ ;; is run after 0s and the process-filter is run in response to the
+ ;; user running `emacsclient'. So it is OK to override the
+ ;; inhibit-quit flag, which is good since `commands' (as well as
+ ;; find-file-noselect via the major-mode) can run arbitrary code,
+ ;; including code that needs to wait.
+ (with-local-quit
+ (condition-case err
+ (let* ((buffers
+ (when files
+ (run-hooks 'pre-command-hook)
+ (prog1 (server-visit-files files proc nowait)
+ (run-hooks 'post-command-hook)))))
+
+ (mapc 'funcall (nreverse commands))
+
+ ;; Delete the client if necessary.
+ (cond
+ (nowait
+ ;; Client requested nowait; return immediately.
+ (server-log "Close nowait client" proc)
+ (server-delete-client proc))
+ ((and (not dontkill) (null buffers))
+ ;; This client is empty; get rid of it immediately.
+ (server-log "Close empty client" proc)
+ (server-delete-client proc)))
+ (cond
+ ((or isearch-mode (minibufferp))
+ nil)
+ ((and frame (null buffers))
(message "%s" (substitute-command-keys
- "When done with a buffer, type \\[server-edit]")))))
- (when (and frame (null tty-name))
- (server-unselect-display frame)))
- (error (server-return-error proc err))))
+ "When done with this frame, type \\[delete-frame]")))
+ ((not (null buffers))
+ (server-switch-buffer (car buffers) nil (cdr (car files)))
+ (run-hooks 'server-switch-hook)
+ (unless nowait
+ (message "%s" (substitute-command-keys
+ "When done with a buffer, type \\[server-edit]")))))
+ (when (and frame (null tty-name))
+ (server-unselect-display frame)))
+ (error (server-return-error proc err)))))
(defun server-return-error (proc err)
(ignore-errors
;; tell it that it is done, and forget it entirely.
(unless buffers
(server-log "Close" proc)
- (server-delete-client proc)))))
+ (if for-killing
+ ;; `server-delete-client' might delete the client's
+ ;; frames, which might change the current buffer. We
+ ;; don't want that (bug#640).
+ (save-current-buffer
+ (server-delete-client proc))
+ (server-delete-client proc))))))
(when (and (bufferp buffer) (buffer-name buffer))
;; We may or may not kill this buffer;
;; if we do, do not call server-buffer-done recursively
The variable `server-temp-file-regexp' controls which filenames
are considered temporary."
(and (buffer-file-name buffer)
- (string-match server-temp-file-regexp (buffer-file-name buffer))))
+ (string-match-p server-temp-file-regexp (buffer-file-name buffer))))
(defun server-done ()
"Offer to save current buffer, mark it as \"done\" for clients.
(server-clients (apply 'server-switch-buffer (server-done)))
(t (message "No server editing buffers exist"))))
-(defun server-switch-buffer (&optional next-buffer killed-one)
+(defun server-switch-buffer (&optional next-buffer killed-one filepos)
"Switch to another buffer, preferably one that has a client.
Arg NEXT-BUFFER is a suggestion; if it is a live buffer, use it.
KILLED-ONE is t in a recursive call if we have already killed one
temp-file server buffer. This means we should avoid the final
\"switch to some other buffer\" since we've already effectively
-done that."
+done that.
+
+FILEPOS specifies a new buffer position for NEXT-BUFFER, if we
+visit NEXT-BUFFER in an existing window. If non-nil, it should
+be a cons cell (LINENUMBER . COLUMNNUMBER)."
(if (null next-buffer)
(progn
(let ((rest server-clients))
(funcall server-window next-buffer)
(let ((win (get-buffer-window next-buffer 0)))
(if (and win (not server-window))
- ;; The buffer is already displayed: just reuse the window.
+ ;; The buffer is already displayed: just reuse the
+ ;; window. If FILEPOS is non-nil, use it to replace the
+ ;; window's own value of point.
(progn
(select-window win)
- (set-buffer next-buffer))
+ (set-buffer next-buffer)
+ (when filepos
+ (server-goto-line-column filepos)))
;; Otherwise, let's find an appropriate window.
(cond ((window-live-p server-window)
(select-window server-window))
(select-frame-set-input-focus (window-frame (selected-window))))))
;;;###autoload
-(defun server-save-buffers-kill-terminal (proc &optional arg)
+(defun server-save-buffers-kill-terminal (arg)
;; Called from save-buffers-kill-terminal in files.el.
- "Offer to save each buffer, then kill PROC.
-
-With prefix arg, silently save all file-visiting buffers, then kill.
+ "Offer to save each buffer, then kill the current client.
+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."
- ;; save-buffers-kill-terminal occasionally calls us with proc set
- ;; to `nowait' (comes from the value of the `client' frame parameter).
- (when (processp proc)
- (let ((buffers (process-get proc 'buffers)))
- ;; If client is bufferless, emulate a normal Emacs session
- ;; exit and offer to save all buffers. Otherwise, offer to
- ;; save only the buffers belonging to the client.
- (save-some-buffers arg
- (if buffers
- (lambda () (memq (current-buffer) buffers))
- t))
- (server-delete-client proc))))
+ (let ((proc (frame-parameter (selected-frame) '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)))
+ ;; If client is bufferless, emulate a normal Emacs exit
+ ;; and offer to save all buffers. Otherwise, offer to
+ ;; save only the buffers belonging to the client.
+ (save-some-buffers
+ arg (if buffers
+ (lambda () (memq (current-buffer) buffers))
+ t))
+ (server-delete-client proc)))
+ (t (error "Invalid client frame")))))
(define-key ctl-x-map "#" 'server-edit)
HCoop / bpt / emacs.git / blobdiff