;;; 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
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")
+;; 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)))
`(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))))
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 (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
;; 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
- (format "Emacs server named %S already running" server-name)
- :warning)
+ (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
(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
- (system-process-attributes
+ (process-attributes
(string-to-number (match-string 1))))
t)
:other))
(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.
(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))
;; We can't use the Emacs daemon's
;; terminal frame.
(not (and (daemonp)
- (= (length (frame-list)) 1)
+ (null (cdr (frame-list)))
(eq (selected-frame)
terminal-frame)))))
(setq tty-name nil tty-type nil)
(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) nil (cdr (car files)))
- (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
(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.
-
+ "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)