Fix bug #8221 with description of how HOME is set on Windows.
[bpt/emacs.git] / lisp / server.el
CommitLineData
55535639 1;;; server.el --- Lisp code for GNU Emacs running as server process
c88ab9ce 2
0d30b337 3;; Copyright (C) 1986, 1987, 1992, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
5df4f04c 4;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
e6ce8c42 5;; Free Software Foundation, Inc.
6d74b528 6
630cc463 7;; Author: William Sommerfeld <wesommer@athena.mit.edu>
e4874521 8;; Maintainer: FSF
d7b4d18f 9;; Keywords: processes
630cc463 10
9ae0f972 11;; Changes by peck@sun.com and by rms.
35dfa9b6 12;; Overhaul by Karoly Lorentey <lorentey@elte.hu> for multi-tty support.
9ae0f972 13
14;; This file is part of GNU Emacs.
15
eb3fa2cf 16;; GNU Emacs is free software: you can redistribute it and/or modify
9ae0f972 17;; it under the terms of the GNU General Public License as published by
eb3fa2cf
GM
18;; the Free Software Foundation, either version 3 of the License, or
19;; (at your option) any later version.
9ae0f972 20
21;; GNU Emacs is distributed in the hope that it will be useful,
22;; but WITHOUT ANY WARRANTY; without even the implied warranty of
23;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
24;; GNU General Public License for more details.
25
26;; You should have received a copy of the GNU General Public License
eb3fa2cf 27;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
9ae0f972 28
630cc463 29;;; Commentary:
9ae0f972 30
b578f267
EN
31;; This Lisp code is run in Emacs when it is to operate as
32;; a server for other processes.
9ae0f972 33
b578f267 34;; Load this library and do M-x server-edit to enable Emacs as a server.
44a56b29
SM
35;; Emacs opens up a socket for communication with clients. If there are no
36;; client buffers to edit, server-edit acts like (switch-to-buffer
37;; (other-buffer))
9ae0f972 38
b578f267
EN
39;; When some other program runs "the editor" to edit a file,
40;; "the editor" can be the Emacs client program ../lib-src/emacsclient.
41;; This program transmits the file names to Emacs through
42;; the server subprocess, and Emacs visits them and lets you edit them.
9ae0f972 43
6d3a46f7 44;; Note that any number of clients may dispatch files to Emacs to be edited.
9ae0f972 45
b578f267 46;; When you finish editing a Server buffer, again call server-edit
64f51134
JPW
47;; to mark that buffer as done for the client and switch to the next
48;; Server buffer. When all the buffers for a client have been edited
b578f267 49;; and exited with server-edit, the client "editor" will return
64f51134 50;; to the program that invoked it.
9ae0f972 51
b578f267
EN
52;; Your editing commands and Emacs's display output go to and from
53;; the terminal in the usual way. Thus, server operation is possible
54;; only when Emacs can talk to the terminal at the time you invoke
55;; the client. This is possible in four cases:
9ae0f972 56
b578f267
EN
57;; 1. On a window system, where Emacs runs in one window and the
58;; program that wants to use "the editor" runs in another.
9ae0f972 59
b578f267
EN
60;; 2. On a multi-terminal system, where Emacs runs on one terminal and the
61;; program that wants to use "the editor" runs on another.
9ae0f972 62
b578f267
EN
63;; 3. When the program that wants to use "the editor" is running
64;; as a subprocess of Emacs.
9ae0f972 65
b578f267
EN
66;; 4. On a system with job control, when Emacs is suspended, the program
67;; that wants to use "the editor" will stop and display
68;; "Waiting for Emacs...". It can then be suspended, and Emacs can be
69;; brought into the foreground for editing. When done editing, Emacs is
70;; suspended again, and the client program is brought into the foreground.
9ae0f972 71
64f51134
JPW
72;; The buffer local variable "server-buffer-clients" lists
73;; the clients who are waiting for this buffer to be edited.
b578f267
EN
74;; The global variable "server-clients" lists all the waiting clients,
75;; and which files are yet to be edited for each.
630cc463 76
0acb1916
SM
77;; Todo:
78
79;; - handle command-line-args-left.
80;; - move most of the args processing and decision making from emacsclient.c
81;; to here.
82;; - fix up handling of the client's environment (place it in the terminal?).
83
630cc463 84;;; Code:
8b3e840e
SM
85
86(eval-when-compile (require 'cl))
87
ab1c7f35
RS
88(defgroup server nil
89 "Emacs running as a server process."
90 :group 'external)
91
337e3c70
JB
92(defcustom server-use-tcp nil
93 "If non-nil, use TCP sockets instead of local sockets."
94 :set #'(lambda (sym val)
95 (unless (featurep 'make-network-process '(:family local))
96 (setq val t)
97 (unless load-in-progress
98 (message "Local sockets unsupported, using TCP sockets")))
99 (when val (random t))
100 (set-default sym val))
101 :group 'server
102 :type 'boolean
103 :version "22.1")
104
105(defcustom server-host nil
106 "The name or IP address to use as host address of the server process.
107If set, the server accepts remote connections; otherwise it is local."
108 :group 'server
109 :type '(choice
110 (string :tag "Name or IP address")
111 (const :tag "Local" nil))
112 :version "22.1")
113(put 'server-host 'risky-local-variable t)
114
d6c180c4 115(defcustom server-auth-dir (locate-user-emacs-file "server/")
3e70541a
JB
116 "Directory for server authentication files.
117
118NOTE: On FAT32 filesystems, directories are not secure;
119files can be read and modified by any user or process.
120It is strongly suggested to set `server-auth-dir' to a
121directory residing in a NTFS partition instead."
337e3c70
JB
122 :group 'server
123 :type 'directory
124 :version "22.1")
125(put 'server-auth-dir 'risky-local-variable t)
126
90caccca 127(defcustom server-raise-frame t
ff348fba 128 "If non-nil, raise frame when switching to a buffer."
90caccca
JB
129 :group 'server
130 :type 'boolean
131 :version "22.1")
132
ab1c7f35 133(defcustom server-visit-hook nil
ff348fba 134 "Hook run when visiting a file for the Emacs server."
ab1c7f35 135 :group 'server
0c851d78 136 :type 'hook)
ab1c7f35
RS
137
138(defcustom server-switch-hook nil
ff348fba 139 "Hook run when switching to a buffer for the Emacs server."
ab1c7f35 140 :group 'server
0c851d78 141 :type 'hook)
ab1c7f35
RS
142
143(defcustom server-done-hook nil
ff348fba 144 "Hook run when done editing a buffer for the Emacs server."
ab1c7f35 145 :group 'server
0c851d78 146 :type 'hook)
f9b3ef88 147
64f51134
JPW
148(defvar server-process nil
149 "The current server process.")
9ae0f972 150
151(defvar server-clients nil
152 "List of current server clients.
448f754f 153Each element is a process.")
0a125897 154
9ae0f972 155(defvar server-buffer-clients nil
5f3c1a63 156 "List of client processes requesting editing of current buffer.")
faf931a8 157(make-variable-buffer-local 'server-buffer-clients)
9ae0f972 158;; Changing major modes should not erase this local.
159(put 'server-buffer-clients 'permanent-local t)
160
33186f32 161(defcustom server-window nil
ff348fba 162 "Specification of the window to use for selecting Emacs server buffers.
ec40ed9f 163If nil, use the selected window.
408784a7 164If it is a function, it should take one argument (a buffer) and
33186f32
DL
165display and select it. A common value is `pop-to-buffer'.
166If it is a window, use that.
167If it is a frame, use the frame's selected window.
168
169It is not meaningful to set this to a specific frame or window with Custom.
170Only programs can do so."
171 :group 'server
bf247b6e 172 :version "22.1"
33186f32
DL
173 :type '(choice (const :tag "Use selected window"
174 :match (lambda (widget value)
175 (not (functionp value)))
176 nil)
ee9272ff 177 (function-item :tag "Display in new frame" switch-to-buffer-other-frame)
33186f32
DL
178 (function-item :tag "Use pop-to-buffer" pop-to-buffer)
179 (function :tag "Other function")))
ec40ed9f 180
ab1c7f35 181(defcustom server-temp-file-regexp "^/tmp/Re\\|/draft$"
ff348fba 182 "Regexp matching names of temporary files.
33186f32
DL
183These are deleted and reused after each edit by the programs that
184invoke the Emacs server."
ab1c7f35
RS
185 :group 'server
186 :type 'regexp)
9ae0f972 187
c6a117f0 188(defcustom server-kill-new-buffers t
ff348fba 189 "Whether to kill buffers when done with them.
c6a117f0 190If non-nil, kill a buffer unless it already existed before editing
f258b525 191it with the Emacs server. If nil, kill only buffers as specified by
c6a117f0 192`server-temp-file-regexp'.
f258b525 193Please note that only buffers that still have a client are killed,
a77ad240
JB
194i.e. buffers visited with \"emacsclient --no-wait\" are never killed
195in this way."
c6a117f0
GM
196 :group 'server
197 :type 'boolean
198 :version "21.1")
199
9ae0f972 200(or (assq 'server-buffer-clients minor-mode-alist)
b7621225 201 (push '(server-buffer-clients " Server") minor-mode-alist))
9ae0f972 202
c6a117f0 203(defvar server-existing-buffer nil
ca0c7250 204 "Non-nil means the buffer existed before the server was asked to visit it.
4dd04714 205This means that the server should not kill the buffer when you say you
ca0c7250 206are done with it in the server.")
c6a117f0
GM
207(make-variable-buffer-local 'server-existing-buffer)
208
77c4d024
CY
209(defcustom server-name "server"
210 "The name of the Emacs server, if this Emacs process creates one.
211The command `server-start' makes use of this. It should not be
212changed while a server is running."
213 :group 'server
214 :type 'string
215 :version "23.1")
03ae35cf 216
03542605
CY
217;; We do not use `temporary-file-directory' here, because emacsclient
218;; does not read the init file.
f77b11a0 219(defvar server-socket-dir
a77ad240
JB
220 (and (featurep 'make-network-process '(:family local))
221 (format "%s/emacs%d" (or (getenv "TMPDIR") "/tmp") (user-uid)))
222 "The directory in which to place the server socket.
223If local sockets are not supported, this is nil.")
0c851d78 224
9002956f
KL
225(defun server-clients-with (property value)
226 "Return a list of clients with PROPERTY set to VALUE."
227 (let (result)
448f754f
SM
228 (dolist (proc server-clients result)
229 (when (equal value (process-get proc property))
230 (push proc result)))))
9002956f
KL
231
232(defun server-add-client (proc)
233 "Create a client for process PROC, if it doesn't already have one.
234New clients have no properties."
448f754f 235 (add-to-list 'server-clients proc))
9002956f 236
59e085e0
KL
237(defmacro server-with-environment (env vars &rest body)
238 "Evaluate BODY with environment variables VARS set to those in ENV.
65f64034
KL
239The environment variables are then restored to their previous values.
240
59e085e0
KL
241VARS should be a list of strings.
242ENV should be in the same format as `process-environment'."
65f64034 243 (declare (indent 2))
13ba3740
SM
244 (let ((var (make-symbol "var"))
245 (value (make-symbol "value")))
246 `(let ((process-environment process-environment))
59e085e0 247 (dolist (,var ,vars)
e159b869 248 (let ((,value (getenv-internal ,var ,env)))
abab01f2
JB
249 (push (if (stringp ,value)
250 (concat ,var "=" ,value)
251 ,var)
13ba3740
SM
252 process-environment)))
253 (progn ,@body))))
65f64034 254
448f754f 255(defun server-delete-client (proc &optional noframe)
c48254fb 256 "Delete PROC, including its buffers, terminals and frames.
a77ad240
JB
257If NOFRAME is non-nil, let the frames live.
258Updates `server-clients'."
ff91dc79 259 (server-log (concat "server-delete-client" (if noframe " noframe")) proc)
9002956f 260 ;; Force a new lookup of client (prevents infinite recursion).
448f754f
SM
261 (when (memq proc server-clients)
262 (let ((buffers (process-get proc 'buffers)))
9002956f 263
5f3c1a63 264 ;; Kill the client's buffers.
9002956f 265 (dolist (buf buffers)
6ed9e43a
KL
266 (when (buffer-live-p buf)
267 (with-current-buffer buf
6ed9e43a 268 ;; Kill the buffer if necessary.
5f3c1a63
KL
269 (when (and (equal server-buffer-clients
270 (list proc))
6ed9e43a
KL
271 (or (and server-kill-new-buffers
272 (not server-existing-buffer))
5f3c1a63
KL
273 (server-temp-file-p))
274 (not (buffer-modified-p)))
275 (let (flag)
276 (unwind-protect
277 (progn (setq server-buffer-clients nil)
278 (kill-buffer (current-buffer))
279 (setq flag t))
280 (unless flag
281 ;; Restore clients if user pressed C-g in `kill-buffer'.
282 (setq server-buffer-clients (list proc)))))))))
9002956f 283
160f0817
KL
284 ;; Delete the client's frames.
285 (unless noframe
286 (dolist (frame (frame-list))
287 (when (and (frame-live-p frame)
288 (equal proc (frame-parameter frame 'client)))
289 ;; Prevent `server-handle-delete-frame' from calling us
290 ;; recursively.
291 (set-frame-parameter frame 'client nil)
292 (delete-frame frame))))
293
448f754f 294 (setq server-clients (delq proc server-clients))
5f3c1a63 295
9002956f 296 ;; Delete the client's tty.
448f754f 297 (let ((terminal (process-get proc 'terminal)))
977ede64
DN
298 ;; Only delete the terminal if it is non-nil.
299 (when (and terminal (eq (terminal-live-p terminal) t))
6ed8eeff 300 (delete-terminal terminal)))
9002956f 301
9002956f 302 ;; Delete the client's process.
448f754f
SM
303 (if (eq (process-status proc) 'open)
304 (delete-process proc))
9002956f
KL
305
306 (server-log "Deleted" proc))))
307
88fd26a1 308(defvar server-log-time-function 'current-time-string
f03ea9d9 309 "Function to generate timestamps for `server-buffer'.")
88fd26a1 310
28cbade4
SM
311(defconst server-buffer " *server*"
312 "Buffer used internally by Emacs's server.
313One use is to log the I/O for debugging purposes (see `server-log'),
314the other is to provide a current buffer in which the process filter can
f03ea9d9 315safely let-bind buffer-local variables like `default-directory'.")
28cbade4
SM
316
317(defvar server-log nil
318 "If non-nil, log the server's inputs and outputs in the `server-buffer'.")
319
8b3e840e 320(defun server-log (string &optional client)
28cbade4 321 "If `server-log' is non-nil, log STRING to `server-buffer'.
c48254fb 322If CLIENT is non-nil, add a description of it to the logged message."
28cbade4
SM
323 (when server-log
324 (with-current-buffer (get-buffer-create server-buffer)
337e3c70 325 (goto-char (point-max))
88fd26a1 326 (insert (funcall server-log-time-function)
974b73e8 327 (cond
88fd26a1
JB
328 ((null client) " ")
329 ((listp client) (format " %s: " (car client)))
330 (t (format " %s: " client)))
337e3c70
JB
331 string)
332 (or (bolp) (newline)))))
9ae0f972 333
334(defun server-sentinel (proc msg)
9002956f 335 "The process sentinel for Emacs server connections."
cbfc02e4
RF
336 ;; If this is a new client process, set the query-on-exit flag to nil
337 ;; for this process (it isn't inherited from the server process).
338 (when (and (eq (process-status proc) 'open)
339 (process-query-on-exit-flag proc))
340 (set-process-query-on-exit-flag proc nil))
757e1681 341 ;; Delete the associated connection file, if applicable.
c63a334e
JB
342 ;; Although there's no 100% guarantee that the file is owned by the
343 ;; running Emacs instance, server-start uses server-running-p to check
344 ;; for possible servers before doing anything, so it *should* be ours.
345 (and (process-contact proc :server)
346 (eq (process-status proc) 'closed)
347 (ignore-errors (delete-file (process-get proc :server-file))))
9002956f
KL
348 (server-log (format "Status changed to %s: %s" (process-status proc) msg) proc)
349 (server-delete-client proc))
0c851d78 350
13ba3740
SM
351(defun server-select-display (display)
352 ;; If the current frame is on `display' we're all set.
a77ad240 353 ;; Similarly if we are unable to open frames on other displays, there's
1a4a884c
SM
354 ;; nothing more we can do.
355 (unless (or (not (fboundp 'make-frame-on-display))
356 (equal (frame-parameter (selected-frame) 'display) display))
13ba3740
SM
357 ;; Otherwise, look for an existing frame there and select it.
358 (dolist (frame (frame-list))
359 (when (equal (frame-parameter frame 'display) display)
360 (select-frame frame)))
361 ;; If there's no frame on that display yet, create and select one.
362 (unless (equal (frame-parameter (selected-frame) 'display) display)
363 (let* ((buffer (generate-new-buffer " *server-dummy*"))
364 (frame (make-frame-on-display
365 display
366 ;; Make it display (and remember) some dummy buffer, so
367 ;; we can detect later if the frame is in use or not.
ff91dc79 368 `((server-dummy-buffer . ,buffer)
13ba3740
SM
369 ;; This frame may be deleted later (see
370 ;; server-unselect-display) so we want it to be as
371 ;; unobtrusive as possible.
372 (visibility . nil)))))
373 (select-frame frame)
374 (set-window-buffer (selected-window) buffer)
375 frame))))
376
377(defun server-unselect-display (frame)
378 (when (frame-live-p frame)
379 ;; If the temporary frame is in use (displays something real), make it
380 ;; visible. If not (which can happen if the user's customizations call
381 ;; pop-to-buffer etc.), delete it to avoid preserving the connection after
382 ;; the last real frame is deleted.
383 (if (and (eq (frame-first-window frame)
384 (next-window (frame-first-window frame) 'nomini))
385 (eq (window-buffer (frame-first-window frame))
386 (frame-parameter frame 'server-dummy-buffer)))
387 ;; The temp frame still only shows one buffer, and that is the
388 ;; internal temp buffer.
389 (delete-frame frame)
390 (set-frame-parameter frame 'visibility t))
391 (kill-buffer (frame-parameter frame 'server-dummy-buffer))
392 (set-frame-parameter frame 'server-dummy-buffer nil)))
393
77134727 394(defun server-handle-delete-frame (frame)
a77ad240
JB
395 "Delete the client connection when the emacsclient frame is deleted.
396\(To be used from `delete-frame-functions'.)"
9002956f 397 (let ((proc (frame-parameter frame 'client)))
e519a50b
KL
398 (when (and (frame-live-p frame)
399 proc
160f0817 400 ;; See if this is the last frame for this client.
d5381da2 401 (>= 1 (let ((frame-num 0))
aabf0cb9 402 (dolist (f (frame-list))
160f0817
KL
403 (when (eq proc (frame-parameter f 'client))
404 (setq frame-num (1+ frame-num))))
405 frame-num)))
9002956f 406 (server-log (format "server-handle-delete-frame, frame %s" frame) proc)
de93c791 407 (server-delete-client proc 'noframe)))) ; Let delete-frame delete the frame later.
9002956f 408
6ed8eeff 409(defun server-handle-suspend-tty (terminal)
9002956f 410 "Notify the emacsclient process to suspend itself when its tty device is suspended."
6ed8eeff
KL
411 (dolist (proc (server-clients-with 'terminal terminal))
412 (server-log (format "server-handle-suspend-tty, terminal %s" terminal) proc)
6d3a46f7 413 (condition-case err
6afdd335 414 (server-send-string proc "-suspend \n")
44954c2f
SM
415 (file-error ;The pipe/socket was closed.
416 (ignore-errors (server-delete-client proc))))))
44a56b29 417
0c851d78 418(defun server-unquote-arg (arg)
6afdd335
KL
419 "Remove &-quotation from ARG.
420See `server-quote-arg' and `server-process-filter'."
0c851d78
SM
421 (replace-regexp-in-string
422 "&." (lambda (s)
423 (case (aref s 1)
424 (?& "&")
425 (?- "-")
426 (?n "\n")
427 (t " ")))
428 arg t t))
9ae0f972 429
0b0d3e0b 430(defun server-quote-arg (arg)
9002956f 431 "In ARG, insert a & before each &, each space, each newline, and -.
0b0d3e0b 432Change spaces to underscores, too, so that the return value never
6afdd335
KL
433contains a space.
434
435See `server-unquote-arg' and `server-process-filter'."
0b0d3e0b
KL
436 (replace-regexp-in-string
437 "[-&\n ]" (lambda (s)
438 (case (aref s 0)
439 (?& "&&")
440 (?- "&-")
441 (?\n "&n")
442 (?\s "&_")))
443 arg t t))
444
6afdd335 445(defun server-send-string (proc string)
a77ad240 446 "A wrapper around `process-send-string' for logging."
6afdd335
KL
447 (server-log (concat "Sent " string) proc)
448 (process-send-string proc string))
449
724629d2
SM
450(defun server-ensure-safe-dir (dir)
451 "Make sure DIR is a directory with no race-condition issues.
452Creates the directory if necessary and makes sure:
453- there's no symlink involved
454- it's owned by us
455- it's not readable/writable by anybody else."
456 (setq dir (directory-file-name dir))
d7554167 457 (let ((attrs (file-attributes dir 'integer)))
724629d2 458 (unless attrs
337e3c70 459 (letf (((default-file-modes) ?\700)) (make-directory dir t))
d7554167 460 (setq attrs (file-attributes dir 'integer)))
3e70541a 461
724629d2 462 ;; Check that it's safe for use.
3e70541a
JB
463 (let* ((uid (nth 2 attrs))
464 (w32 (eq system-type 'windows-nt))
465 (safe (catch :safe
466 (unless (eq t (car attrs)) ; is a dir?
467 (throw :safe nil))
468 (when (and w32 (zerop uid)) ; on FAT32?
469 (display-warning
470 'server
471 (format "Using `%s' to store Emacs-server authentication files.
472Directories on FAT32 filesystems are NOT secure against tampering.
473See variable `server-auth-dir' for details."
474 (file-name-as-directory dir))
475 :warning)
476 (throw :safe t))
477 (unless (eql uid (user-uid)) ; is the dir ours?
478 (throw :safe nil))
479 (when w32 ; on NTFS?
480 (throw :safe t))
481 (unless (zerop (logand ?\077 (file-modes dir)))
482 (throw :safe nil))
483 t)))
484 (unless safe
485 (error "The directory `%s' is unsafe" dir)))))
724629d2 486
7229064d 487;;;###autoload
381d186f 488(defun server-start (&optional leave-dead inhibit-prompt)
9ae0f972 489 "Allow this Emacs process to be a server for client processes.
490This starts a server communications subprocess through which
6d3a46f7
KL
491client \"editors\" can send your editing commands to this Emacs
492job. To use the server, set up the program `emacsclient' in the
9ae0f972 493Emacs distribution as your standard \"editor\".
494
bd410bb0 495Optional argument LEAVE-DEAD (interactively, a prefix arg) means just
c63a334e
JB
496kill any existing server communications subprocess.
497
381d186f
CY
498If a server is already running, restart it. If clients are
499running, ask the user for confirmation first, unless optional
500argument INHIBIT-PROMPT is non-nil.
501
c63a334e
JB
502To force-start a server, do \\[server-force-delete] and then
503\\[server-start]."
9ae0f972 504 (interactive "P")
97e121cc
CY
505 (when (or (not server-clients)
506 ;; Ask the user before deleting existing clients---except
507 ;; when we can't get user input, which may happen when
508 ;; doing emacsclient --eval "(kill-emacs)" in daemon mode.
381d186f
CY
509 (cond
510 ((and (daemonp)
511 (null (cdr (frame-list)))
512 (eq (selected-frame) terminal-frame))
513 leave-dead)
514 (inhibit-prompt t)
515 (t (yes-or-no-p
516 "The current server still has clients; delete them? "))))
c63a334e
JB
517 (let* ((server-dir (if server-use-tcp server-auth-dir server-socket-dir))
518 (server-file (expand-file-name server-name server-dir)))
519 (when server-process
520 ;; kill it dead!
521 (ignore-errors (delete-process server-process)))
522 ;; Delete the socket files made by previous server invocations.
523 (if (not (eq t (server-running-p server-name)))
524 ;; Remove any leftover socket or authentication file
525 (ignore-errors (delete-file server-file))
526 (setq server-mode nil) ;; already set by the minor mode code
c31ee003
CY
527 (display-warning
528 'server
529 (concat "Unable to start the Emacs server.\n"
530 (format "There is an existing Emacs server, named %S.\n"
531 server-name)
532 "To start the server in this Emacs process, stop the existing
533server or call `M-x server-force-delete' to forcibly disconnect it.")
534 :warning)
35f372ca 535 (setq leave-dead t))
c63a334e
JB
536 ;; If this Emacs already had a server, clear out associated status.
537 (while server-clients
538 (server-delete-client (car server-clients)))
539 ;; Now any previous server is properly stopped.
540 (if leave-dead
541 (progn
35f372ca 542 (unless (eq t leave-dead) (server-log (message "Server stopped")))
c63a334e 543 (setq server-process nil))
974b73e8
KL
544 ;; Make sure there is a safe directory in which to place the socket.
545 (server-ensure-safe-dir server-dir)
974b73e8
KL
546 (when server-process
547 (server-log (message "Restarting server")))
548 (letf (((default-file-modes) ?\700))
e4019195 549 (add-hook 'suspend-tty-functions 'server-handle-suspend-tty)
974b73e8
KL
550 (add-hook 'delete-frame-functions 'server-handle-delete-frame)
551 (add-hook 'kill-buffer-query-functions 'server-kill-buffer-query-function)
552 (add-hook 'kill-emacs-query-functions 'server-kill-emacs-query-function)
381d186f 553 (add-hook 'kill-emacs-hook 'server-force-stop) ;Cleanup upon exit.
974b73e8
KL
554 (setq server-process
555 (apply #'make-network-process
556 :name server-name
557 :server t
558 :noquery t
559 :sentinel 'server-sentinel
560 :filter 'server-process-filter
561 ;; We must receive file names without being decoded.
562 ;; Those are decoded by server-process-filter according
1b0a6c68
SM
563 ;; to file-name-coding-system. Also don't get
564 ;; confused by CRs since we don't quote them.
565 :coding 'raw-text-unix
28cbade4 566 ;; The other args depend on the kind of socket used.
974b73e8 567 (if server-use-tcp
d5b8058f 568 (list :family 'ipv4 ;; We're not ready for IPv6 yet
974b73e8 569 :service t
d5b8058f 570 :host (or server-host "127.0.0.1") ;; See bug#6781
974b73e8
KL
571 :plist '(:authenticated nil))
572 (list :family 'local
573 :service server-file
574 :plist '(:authenticated t)))))
575 (unless server-process (error "Could not start server process"))
c63a334e 576 (process-put server-process :server-file server-file)
974b73e8
KL
577 (when server-use-tcp
578 (let ((auth-key
579 (loop
d76e2046
JB
580 ;; The auth key is a 64-byte string of random chars in the
581 ;; range `!'..`~'.
582 for i below 64
583 collect (+ 33 (random 94)) into auth
584 finally return (concat auth))))
974b73e8
KL
585 (process-put server-process :auth-key auth-key)
586 (with-temp-file server-file
587 (set-buffer-multibyte nil)
588 (setq buffer-file-coding-system 'no-conversion)
589 (insert (format-network-address
590 (process-contact server-process :local))
591 " " (int-to-string (emacs-pid))
592 "\n" auth-key)))))))))
33186f32 593
381d186f
CY
594(defun server-force-stop ()
595 "Kill all connections to the current server.
596This function is meant to be called from `kill-emacs-hook'."
bf6442c3 597 (server-start t t))
381d186f 598
c63a334e
JB
599;;;###autoload
600(defun server-force-delete (&optional name)
601 "Unconditionally delete connection file for server NAME.
602If server is running, it is first stopped.
603NAME defaults to `server-name'. With argument, ask for NAME."
604 (interactive
605 (list (if current-prefix-arg
606 (read-string "Server name: " nil nil server-name))))
607 (when server-mode (with-temp-message nil (server-mode -1)))
608 (let ((file (expand-file-name (or name server-name)
609 (if server-use-tcp
610 server-auth-dir
611 server-socket-dir))))
612 (condition-case nil
613 (progn
614 (delete-file file)
615 (message "Connection file %S deleted" file))
616 (file-error
617 (message "No connection file %S" file)))))
618
44954c2f 619(defun server-running-p (&optional name)
c63a334e
JB
620 "Test whether server NAME is running.
621
622Return values:
623 nil the server is definitely not running.
624 t the server seems to be running.
625 something else we cannot determine whether it's running without using
626 commands which may have to wait for a long time."
44954c2f
SM
627 (unless name (setq name server-name))
628 (condition-case nil
c63a334e
JB
629 (if server-use-tcp
630 (with-temp-buffer
631 (insert-file-contents-literally (expand-file-name name server-auth-dir))
d9569a55 632 (or (and (looking-at "127\\.0\\.0\\.1:[0-9]+ \\([0-9]+\\)")
c63a334e 633 (assq 'comm
a20878b6 634 (process-attributes
c63a334e
JB
635 (string-to-number (match-string 1))))
636 t)
637 :other))
44954c2f
SM
638 (delete-process
639 (make-network-process
640 :name "server-client-test" :family 'local :server nil :noquery t
641 :service (expand-file-name name server-socket-dir)))
642 t)
643 (file-error nil)))
644
33186f32
DL
645;;;###autoload
646(define-minor-mode server-mode
647 "Toggle Server mode.
648With ARG, turn Server mode on if ARG is positive, off otherwise.
649Server mode runs a process that accepts commands from the
650`emacsclient' program. See `server-start' and Info node `Emacs server'."
651 :global t
652 :group 'server
bf247b6e 653 :version "22.1"
33186f32
DL
654 ;; Fixme: Should this check for an existing server socket and do
655 ;; nothing if there is one (for multiple Emacs sessions)?
656 (server-start (not server-mode)))
9ae0f972 657\f
13ba3740
SM
658(defun server-eval-and-print (expr proc)
659 "Eval EXPR and send the result back to client PROC."
660 (let ((v (eval (car (read-from-string expr)))))
661 (when (and v proc)
662 (with-temp-buffer
663 (let ((standard-output (current-buffer)))
664 (pp v)
665 (let ((text (buffer-substring-no-properties
666 (point-min) (point-max))))
667 (server-send-string
668 proc (format "-print %s\n"
669 (server-quote-arg text)))))))))
670
671(defun server-create-tty-frame (tty type proc)
f79b43b2
DN
672 (unless tty
673 (error "Invalid terminal device"))
674 (unless type
675 (error "Invalid terminal type"))
4419b755 676 (add-to-list 'frame-inherited-parameters 'client)
13ba3740
SM
677 (let ((frame
678 (server-with-environment (process-get proc 'env)
679 '("LANG" "LC_CTYPE" "LC_ALL"
680 ;; For tgetent(3); list according to ncurses(3).
681 "BAUDRATE" "COLUMNS" "ESCDELAY" "HOME" "LINES"
682 "NCURSES_ASSUMED_COLORS" "NCURSES_NO_PADDING"
683 "NCURSES_NO_SETBUF" "TERM" "TERMCAP" "TERMINFO"
c48254fb 684 "TERMINFO_DIRS" "TERMPATH"
13ba3740
SM
685 ;; rxvt wants these
686 "COLORFGBG" "COLORTERM")
f79b43b2
DN
687 (make-frame `((window-system . nil)
688 (tty . ,tty)
689 (tty-type . ,type)
690 ;; Ignore nowait here; we always need to
691 ;; clean up opened ttys when the client dies.
692 (client . ,proc)
693 ;; This is a leftover from an earlier
694 ;; attempt at making it possible for process
695 ;; run in the server process to use the
696 ;; environment of the client process.
697 ;; It has no effect now and to make it work
698 ;; we'd need to decide how to make
699 ;; process-environment interact with client
700 ;; envvars, and then to change the
701 ;; C functions `child_setup' and
702 ;; `getenv_internal' accordingly.
703 (environment . ,(process-get proc 'env)))))))
052056a9 704
e159b869
SM
705 ;; ttys don't use the `display' parameter, but callproc.c does to set
706 ;; the DISPLAY environment on subprocesses.
707 (set-frame-parameter frame 'display
708 (getenv-internal "DISPLAY" (process-get proc 'env)))
13ba3740 709 (select-frame frame)
448f754f 710 (process-put proc 'frame frame)
448f754f 711 (process-put proc 'terminal (frame-terminal frame))
13ba3740
SM
712
713 ;; Display *scratch* by default.
714 (switch-to-buffer (get-buffer-create "*scratch*") 'norecord)
715
716 ;; Reply with our pid.
717 (server-send-string proc (concat "-emacs-pid "
718 (number-to-string (emacs-pid)) "\n"))
719 frame))
720
721(defun server-create-window-system-frame (display nowait proc)
4419b755 722 (add-to-list 'frame-inherited-parameters 'client)
e159b869 723 (if (not (fboundp 'make-frame-on-display))
13ba3740
SM
724 (progn
725 ;; This emacs does not support X.
726 (server-log "Window system unsupported" proc)
727 (server-send-string proc "-window-system-unsupported \n")
728 nil)
729 ;; Flag frame as client-created, but use a dummy client.
730 ;; This will prevent the frame from being deleted when
731 ;; emacsclient quits while also preventing
732 ;; `server-save-buffers-kill-terminal' from unexpectedly
733 ;; killing emacs on that frame.
734 (let* ((params `((client . ,(if nowait 'nowait proc))
4419b755 735 ;; This is a leftover, see above.
13ba3740
SM
736 (environment . ,(process-get proc 'env))))
737 (frame (make-frame-on-display
738 (or display
739 (frame-parameter nil 'display)
740 (getenv "DISPLAY")
741 (error "Please specify display"))
448f754f 742 params)))
13ba3740 743 (server-log (format "%s created" frame) proc)
13ba3740 744 (select-frame frame)
448f754f
SM
745 (process-put proc 'frame frame)
746 (process-put proc 'terminal (frame-terminal frame))
13ba3740
SM
747
748 ;; Display *scratch* by default.
749 (switch-to-buffer (get-buffer-create "*scratch*") 'norecord)
750 frame)))
751
13ba3740
SM
752(defun server-goto-toplevel (proc)
753 (condition-case nil
754 ;; If we're running isearch, we must abort it to allow Emacs to
755 ;; display the buffer and switch to it.
756 (dolist (buffer (buffer-list))
757 (with-current-buffer buffer
758 (when (bound-and-true-p isearch-mode)
759 (isearch-cancel))))
760 ;; Signaled by isearch-cancel.
761 (quit (message nil)))
762 (when (> (recursion-depth) 0)
763 ;; We're inside a minibuffer already, so if the emacs-client is trying
764 ;; to open a frame on a new display, we might end up with an unusable
765 ;; frame because input from that display will be blocked (until exiting
766 ;; the minibuffer). Better exit this minibuffer right away.
767 ;; Similarly with recursive-edits such as the splash screen.
768 (run-with-timer 0 nil (lexical-let ((proc proc))
769 (lambda () (server-execute-continuation proc))))
770 (top-level)))
771
772;; We use various special properties on process objects:
773;; - `env' stores the info about the environment of the emacsclient process.
774;; - `continuation' is a no-arg function that we need to execute. It contains
775;; commands we wanted to execute in some earlier invocation of the process
776;; filter but that we somehow were unable to process at that time
777;; (e.g. because we first need to throw to the toplevel).
778
779(defun server-execute-continuation (proc)
780 (let ((continuation (process-get proc 'continuation)))
781 (process-put proc 'continuation nil)
782 (if continuation (ignore-errors (funcall continuation)))))
783
337e3c70 784(defun* server-process-filter (proc string)
33186f32 785 "Process a request from the server to edit some files.
6afdd335 786PROC is the server process. STRING consists of a sequence of
909049cb
JB
787commands prefixed by a dash. Some commands have arguments;
788these are &-quoted and need to be decoded by `server-unquote-arg'.
789The filter parses and executes these commands.
6afdd335
KL
790
791To illustrate the protocol, here is an example command that
792emacsclient sends to create a new X frame (note that the whole
793sequence is sent on a single line):
794
909049cb
JB
795 -env HOME=/home/lorentey
796 -env DISPLAY=:0.0
6afdd335
KL
797 ... lots of other -env commands
798 -display :0.0
799 -window-system
800
6afdd335
KL
801The following commands are accepted by the server:
802
974b73e8
KL
803`-auth AUTH-STRING'
804 Authenticate the client using the secret authentication string
a38daa0a 805 AUTH-STRING.
974b73e8 806
59e085e0 807`-env NAME=VALUE'
6afdd335
KL
808 An environment variable on the client side.
809
2828d5f9
KL
810`-dir DIRNAME'
811 The current working directory of the client process.
812
92071250
KL
813`-current-frame'
814 Forbid the creation of new frames.
815
6afdd335
KL
816`-nowait'
817 Request that the next frame created should not be
818 associated with this client.
819
820`-display DISPLAY'
821 Set the display name to open X frames on.
822
823`-position LINE[:COLUMN]'
824 Go to the given line and column number
825 in the next file opened.
826
827`-file FILENAME'
828 Load the given file in the current frame.
829
830`-eval EXPR'
831 Evaluate EXPR as a Lisp expression and return the
832 result in -print commands.
833
834`-window-system'
835 Open a new X frame.
836
837`-tty DEVICENAME TYPE'
838 Open a new tty frame at the client.
839
6afdd335
KL
840`-suspend'
841 Suspend this tty frame. The client sends this string in
842 response to SIGTSTP and SIGTTOU. The server must cease all I/O
843 on this tty until it gets a -resume command.
844
2828d5f9 845`-resume'
c48254fb 846 Resume this tty frame. The client sends this string when it
2828d5f9
KL
847 gets the SIGCONT signal and it is the foreground process on its
848 controlling tty.
849
6afdd335 850`-ignore COMMENT'
909049cb
JB
851 Do nothing, but put the comment in the server log.
852 Useful for debugging.
6afdd335
KL
853
854
855The following commands are accepted by the client:
856
6afdd335
KL
857`-emacs-pid PID'
858 Describes the process id of the Emacs process;
859 used to forward window change signals to it.
860
861`-window-system-unsupported'
c48254fb
JB
862 Signals that the server does not support creating X frames;
863 the client must try again with a tty frame.
6afdd335
KL
864
865`-print STRING'
866 Print STRING on stdout. Used to send values
867 returned by -eval.
868
869`-error DESCRIPTION'
2b7ba565 870 Signal an error and delete process PROC.
6afdd335
KL
871
872`-suspend'
c48254fb
JB
873 Suspend this terminal, i.e., stop the client process.
874 Sent when the user presses C-z."
6afdd335 875 (server-log (concat "Received " string) proc)
337e3c70
JB
876 ;; First things first: let's check the authentication
877 (unless (process-get proc :authenticated)
38b9f0f3 878 (if (and (string-match "-auth \\([!-~]+\\)\n?" string)
974b73e8
KL
879 (equal (match-string 1 string) (process-get proc :auth-key)))
880 (progn
881 (setq string (substring string (match-end 0)))
882 (process-put proc :authenticated t)
883 (server-log "Authentication successful" proc))
337e3c70 884 (server-log "Authentication failed" proc)
974b73e8
KL
885 (server-send-string
886 proc (concat "-error " (server-quote-arg "Authentication failed")))
337e3c70
JB
887 (delete-process proc)
888 ;; We return immediately
889 (return-from server-process-filter)))
3f7ef08e
SM
890 (let ((prev (process-get proc 'previous-string)))
891 (when prev
892 (setq string (concat prev string))
893 (process-put proc 'previous-string nil)))
a9298135 894 (condition-case err
0b0d3e0b 895 (progn
9002956f 896 (server-add-client proc)
13ba3740
SM
897 (if (not (string-match "\n" string))
898 ;; Save for later any partial line that remains.
899 (when (> (length string) 0)
900 (process-put proc 'previous-string string))
c48254fb 901
13ba3740
SM
902 ;; In earlier versions of server.el (where we used an `emacsserver'
903 ;; process), there could be multiple lines. Nowadays this is not
904 ;; supported any more.
905 (assert (eq (match-end 0) (length string)))
0b0d3e0b 906 (let ((request (substring string 0 (match-beginning 0)))
597e2240 907 (coding-system (and (default-value 'enable-multibyte-characters)
0b0d3e0b
KL
908 (or file-name-coding-system
909 default-file-name-coding-system)))
9002956f
KL
910 nowait ; t if emacsclient does not want to wait for us.
911 frame ; The frame that was opened for the client (if any).
59e085e0 912 display ; Open the frame on this display.
0b0d3e0b 913 dontkill ; t if the client should not be killed.
650d0dbc 914 commands
2828d5f9 915 dir
cd9c54eb 916 use-current-frame
650d0dbc
CY
917 tty-name ;nil, `window-system', or the tty name.
918 tty-type ;string.
919 files
920 filepos
bfb74e75
DK
921 command-line-args-left
922 arg)
0b0d3e0b
KL
923 ;; Remove this line from STRING.
924 (setq string (substring string (match-end 0)))
bfb74e75
DK
925 (setq command-line-args-left
926 (mapcar 'server-unquote-arg (split-string request " " t)))
927 (while (setq arg (pop command-line-args-left))
0b0d3e0b 928 (cond
13ba3740 929 ;; -version CLIENT-VERSION: obsolete at birth.
bfb74e75
DK
930 ((and (equal "-version" arg) command-line-args-left)
931 (pop command-line-args-left))
0b0d3e0b 932
9002956f 933 ;; -nowait: Emacsclient won't wait for a result.
0b0d3e0b
KL
934 ((equal "-nowait" arg) (setq nowait t))
935
92071250 936 ;; -current-frame: Don't create frames.
cd9c54eb 937 ((equal "-current-frame" arg) (setq use-current-frame t))
92071250 938
9002956f 939 ;; -display DISPLAY:
59e085e0 940 ;; Open X frames on the given display instead of the default.
bfb74e75 941 ((and (equal "-display" arg) command-line-args-left)
ff91dc79
SM
942 (setq display (pop command-line-args-left))
943 (if (zerop (length display)) (setq display nil)))
0b0d3e0b 944
9002956f 945 ;; -window-system: Open a new X frame.
0b0d3e0b 946 ((equal "-window-system" arg)
13ba3740
SM
947 (setq dontkill t)
948 (setq tty-name 'window-system))
9002956f
KL
949
950 ;; -resume: Resume a suspended tty frame.
0b0d3e0b 951 ((equal "-resume" arg)
448f754f 952 (lexical-let ((terminal (process-get proc 'terminal)))
0b0d3e0b 953 (setq dontkill t)
13ba3740
SM
954 (push (lambda ()
955 (when (eq (terminal-live-p terminal) t)
956 (resume-tty terminal)))
957 commands)))
0b0d3e0b 958
9002956f
KL
959 ;; -suspend: Suspend the client's frame. (In case we
960 ;; get out of sync, and a C-z sends a SIGTSTP to
961 ;; emacsclient.)
0b0d3e0b 962 ((equal "-suspend" arg)
448f754f 963 (lexical-let ((terminal (process-get proc 'terminal)))
0b0d3e0b 964 (setq dontkill t)
13ba3740
SM
965 (push (lambda ()
966 (when (eq (terminal-live-p terminal) t)
967 (suspend-tty terminal)))
968 commands)))
0b0d3e0b 969
9002956f
KL
970 ;; -ignore COMMENT: Noop; useful for debugging emacsclient.
971 ;; (The given comment appears in the server log.)
bfb74e75
DK
972 ((and (equal "-ignore" arg) command-line-args-left
973 (setq dontkill t)
974 (pop command-line-args-left)))
0b0d3e0b 975
9002956f 976 ;; -tty DEVICE-NAME TYPE: Open a new tty frame at the client.
13ba3740 977 ((and (equal "-tty" arg)
bfb74e75
DK
978 (cdr command-line-args-left))
979 (setq tty-name (pop command-line-args-left)
980 tty-type (pop command-line-args-left)
cd9c54eb
CY
981 dontkill (or dontkill
982 (not use-current-frame))))
13ba3740
SM
983
984 ;; -position LINE[:COLUMN]: Set point to the given
985 ;; position in the next file.
986 ((and (equal "-position" arg)
bfb74e75
DK
987 command-line-args-left
988 (string-match "\\+\\([0-9]+\\)\\(?::\\([0-9]+\\)\\)?"
989 (car command-line-args-left)))
990 (setq arg (pop command-line-args-left))
656d4706
SM
991 (setq filepos
992 (cons (string-to-number (match-string 1 arg))
993 (string-to-number (or (match-string 2 arg) "")))))
0b0d3e0b 994
9002956f 995 ;; -file FILENAME: Load the given file.
13ba3740 996 ((and (equal "-file" arg)
bfb74e75
DK
997 command-line-args-left)
998 (let ((file (pop command-line-args-left)))
0b0d3e0b
KL
999 (if coding-system
1000 (setq file (decode-coding-string file coding-system)))
ba528748 1001 (setq file (expand-file-name file dir))
656d4706
SM
1002 (push (cons file filepos) files)
1003 (server-log (format "New file: %s %s"
1004 file (or filepos "")) proc))
1005 (setq filepos nil))
0b0d3e0b 1006
9002956f 1007 ;; -eval EXPR: Evaluate a Lisp expression.
13ba3740 1008 ((and (equal "-eval" arg)
bfb74e75 1009 command-line-args-left)
cd9c54eb
CY
1010 (if use-current-frame
1011 (setq use-current-frame 'always))
bfb74e75 1012 (lexical-let ((expr (pop command-line-args-left)))
0b0d3e0b
KL
1013 (if coding-system
1014 (setq expr (decode-coding-string expr coding-system)))
13ba3740
SM
1015 (push (lambda () (server-eval-and-print expr proc))
1016 commands)
656d4706 1017 (setq filepos nil)))
0b0d3e0b 1018
59e085e0 1019 ;; -env NAME=VALUE: An environment variable.
bfb74e75
DK
1020 ((and (equal "-env" arg) command-line-args-left)
1021 (let ((var (pop command-line-args-left)))
da8e8fc1 1022 ;; XXX Variables should be encoded as in getenv/setenv.
13ba3740
SM
1023 (process-put proc 'env
1024 (cons var (process-get proc 'env)))))
9002956f 1025
2828d5f9 1026 ;; -dir DIRNAME: The cwd of the emacsclient process.
bfb74e75
DK
1027 ((and (equal "-dir" arg) command-line-args-left)
1028 (setq dir (pop command-line-args-left))
2828d5f9
KL
1029 (if coding-system
1030 (setq dir (decode-coding-string dir coding-system)))
1031 (setq dir (command-line-normalize-file-name dir)))
1032
0b0d3e0b 1033 ;; Unknown command.
bfb74e75 1034 (t (error "Unknown command: %s" arg))))
c48254fb 1035
cd9c54eb
CY
1036 (setq frame
1037 (cond
1038 ((and use-current-frame
1039 (or (eq use-current-frame 'always)
1040 ;; We can't use the Emacs daemon's
1041 ;; terminal frame.
d9bf544c 1042 (not (and (daemonp)
97e121cc 1043 (null (cdr (frame-list)))
cd9c54eb
CY
1044 (eq (selected-frame)
1045 terminal-frame)))))
d9bf544c 1046 (setq tty-name nil tty-type nil)
cd9c54eb
CY
1047 (if display (server-select-display display)))
1048 ((eq tty-name 'window-system)
1049 (server-create-window-system-frame display nowait proc))
650d0dbc
CY
1050 ;; When resuming on a tty, tty-name is nil.
1051 (tty-name
1052 (server-create-tty-frame tty-name tty-type proc))))
13ba3740 1053
28cbade4
SM
1054 (process-put
1055 proc 'continuation
1056 (lexical-let ((proc proc)
1057 (files files)
1058 (nowait nowait)
1059 (commands commands)
1060 (dontkill dontkill)
1061 (frame frame)
1062 (dir dir)
1063 (tty-name tty-name))
1064 (lambda ()
1065 (with-current-buffer (get-buffer-create server-buffer)
1066 ;; Use the same cwd as the emacsclient, if possible, so
1067 ;; relative file names work correctly, even in `eval'.
1068 (let ((default-directory
f03ea9d9
JB
1069 (if (and dir (file-directory-p dir))
1070 dir default-directory)))
28cbade4
SM
1071 (server-execute proc files nowait commands
1072 dontkill frame tty-name))))))
13ba3740
SM
1073
1074 (when (or frame files)
1075 (server-goto-toplevel proc))
1076
1077 (server-execute-continuation proc))))
a9298135 1078 ;; condition-case
13ba3740
SM
1079 (error (server-return-error proc err))))
1080
1081(defun server-execute (proc files nowait commands dontkill frame tty-name)
7197f5de
SM
1082 ;; This is run from timers and process-filters, i.e. "asynchronously".
1083 ;; But w.r.t the user, this is not really asynchronous since the timer
1084 ;; is run after 0s and the process-filter is run in response to the
1085 ;; user running `emacsclient'. So it is OK to override the
1086 ;; inhibit-quit flag, which is good since `commands' (as well as
1087 ;; find-file-noselect via the major-mode) can run arbitrary code,
1088 ;; including code that needs to wait.
1089 (with-local-quit
1090 (condition-case err
1091 (let* ((buffers
1092 (when files
1093 (run-hooks 'pre-command-hook)
1094 (prog1 (server-visit-files files proc nowait)
1095 (run-hooks 'post-command-hook)))))
1096
1097 (mapc 'funcall (nreverse commands))
1098
1099 ;; Delete the client if necessary.
1100 (cond
1101 (nowait
1102 ;; Client requested nowait; return immediately.
1103 (server-log "Close nowait client" proc)
1104 (server-delete-client proc))
1105 ((and (not dontkill) (null buffers))
1106 ;; This client is empty; get rid of it immediately.
1107 (server-log "Close empty client" proc)
1108 (server-delete-client proc)))
1109 (cond
1110 ((or isearch-mode (minibufferp))
1111 nil)
1112 ((and frame (null buffers))
13ba3740 1113 (message "%s" (substitute-command-keys
7197f5de
SM
1114 "When done with this frame, type \\[delete-frame]")))
1115 ((not (null buffers))
1116 (server-switch-buffer (car buffers) nil (cdr (car files)))
1117 (run-hooks 'server-switch-hook)
1118 (unless nowait
1119 (message "%s" (substitute-command-keys
1120 "When done with a buffer, type \\[server-edit]")))))
1121 (when (and frame (null tty-name))
1122 (server-unselect-display frame)))
1123 (error (server-return-error proc err)))))
13ba3740
SM
1124
1125(defun server-return-error (proc err)
1126 (ignore-errors
1127 (server-send-string
1128 proc (concat "-error " (server-quote-arg
1129 (error-message-string err))))
1130 (server-log (error-message-string err) proc)
1131 (delete-process proc)))
9ae0f972 1132
656d4706
SM
1133(defun server-goto-line-column (line-col)
1134 "Move point to the position indicated in LINE-COL.
1135LINE-COL should be a pair (LINE . COL)."
1136 (when line-col
e6ce8c42
GM
1137 (goto-char (point-min))
1138 (forward-line (1- (car line-col)))
656d4706
SM
1139 (let ((column-number (cdr line-col)))
1140 (when (> column-number 0)
1141 (move-to-column (1- column-number))))))
6b98185f 1142
448f754f 1143(defun server-visit-files (files proc &optional nowait)
c5b0a355 1144 "Find FILES and return a list of buffers created.
656d4706
SM
1145FILES is an alist whose elements are (FILENAME . FILEPOS)
1146where FILEPOS can be nil or a pair (LINENUMBER . COLUMNNUMBER).
448f754f 1147PROC is the client that requested this operation.
dfa35e6b
RS
1148NOWAIT non-nil means this client is not waiting for the results,
1149so don't mark these buffers specially, just visit them normally."
e82e73c2 1150 ;; Bind last-nonmenu-event to force use of keyboard, not mouse, for queries.
44a56b29 1151 (let ((last-nonmenu-event t) client-record)
3a0ce849
RS
1152 ;; Restore the current buffer afterward, but not using save-excursion,
1153 ;; because we don't want to save point in this buffer
1154 ;; if it happens to be one of those specified by the server.
44a56b29
SM
1155 (save-current-buffer
1156 (dolist (file files)
1157 ;; If there is an existing buffer modified or the file is
1158 ;; modified, revert it. If there is an existing buffer with
1159 ;; deleted file, offer to write it.
cd7320d4 1160 (let* ((minibuffer-auto-raise (or server-raise-frame
974b73e8 1161 minibuffer-auto-raise))
c2d0d432 1162 (filen (car file))
44a56b29 1163 (obuf (get-file-buffer filen)))
c398358a 1164 (add-to-history 'file-name-history filen)
656d4706
SM
1165 (if (null obuf)
1166 (set-buffer (find-file-noselect filen))
1167 (set-buffer obuf)
1168 (cond ((file-exists-p filen)
1169 (when (not (verify-visited-file-modtime obuf))
1170 (revert-buffer t nil)))
1171 (t
1172 (when (y-or-n-p
1173 (concat "File no longer exists: " filen
1174 ", write buffer to file? "))
1175 (write-file filen))))
1176 (unless server-buffer-clients
1177 (setq server-existing-buffer t)))
1178 (server-goto-line-column (cdr file))
1179 (run-hooks 'server-visit-hook))
44a56b29
SM
1180 (unless nowait
1181 ;; When the buffer is killed, inform the clients.
1182 (add-hook 'kill-buffer-hook 'server-kill-buffer nil t)
448f754f 1183 (push proc server-buffer-clients))
c5b0a355
KL
1184 (push (current-buffer) client-record)))
1185 (unless nowait
448f754f
SM
1186 (process-put proc 'buffers
1187 (nconc (process-get proc 'buffers) client-record)))
c5b0a355 1188 client-record))
9ae0f972 1189\f
b392bac9 1190(defun server-buffer-done (buffer &optional for-killing)
9ae0f972 1191 "Mark BUFFER as \"done\" for its client(s).
9184aafb
RS
1192This buries the buffer, then returns a list of the form (NEXT-BUFFER KILLED).
1193NEXT-BUFFER is another server buffer, as a suggestion for what to select next,
8b3e840e
SM
1194or nil. KILLED is t if we killed BUFFER (typically, because it was visiting
1195a temp file).
1196FOR-KILLING if non-nil indicates that we are called from `kill-buffer'."
0c851d78 1197 (let ((next-buffer nil)
9002956f 1198 (killed nil))
448f754f
SM
1199 (dolist (proc server-clients)
1200 (let ((buffers (process-get proc 'buffers)))
8b3e840e 1201 (or next-buffer
9002956f
KL
1202 (setq next-buffer (nth 1 (memq buffer buffers))))
1203 (when buffers ; Ignore bufferless clients.
1204 (setq buffers (delq buffer buffers))
448f754f 1205 ;; Delete all dead buffers from PROC.
9002956f
KL
1206 (dolist (b buffers)
1207 (and (bufferp b)
1208 (not (buffer-live-p b))
1209 (setq buffers (delq b buffers))))
448f754f 1210 (process-put proc 'buffers buffers)
9002956f
KL
1211 ;; If client now has no pending buffers,
1212 ;; tell it that it is done, and forget it entirely.
1213 (unless buffers
448f754f 1214 (server-log "Close" proc)
737e5c83
CY
1215 (if for-killing
1216 ;; `server-delete-client' might delete the client's
1217 ;; frames, which might change the current buffer. We
1218 ;; don't want that (bug#640).
1219 (save-current-buffer
1220 (server-delete-client proc))
1221 (server-delete-client proc))))))
337e3c70
JB
1222 (when (and (bufferp buffer) (buffer-name buffer))
1223 ;; We may or may not kill this buffer;
1224 ;; if we do, do not call server-buffer-done recursively
1225 ;; from kill-buffer-hook.
1226 (let ((server-kill-buffer-running t))
1227 (with-current-buffer buffer
1228 (setq server-buffer-clients nil)
1229 (run-hooks 'server-done-hook))
1230 ;; Notice whether server-done-hook killed the buffer.
1231 (if (null (buffer-name buffer))
1232 (setq killed t)
1233 ;; Don't bother killing or burying the buffer
1234 ;; when we are called from kill-buffer.
1235 (unless for-killing
1236 (when (and (not killed)
1237 server-kill-new-buffers
1238 (with-current-buffer buffer
1239 (not server-existing-buffer)))
599f9a5c 1240 (setq killed t)
337e3c70 1241 (bury-buffer buffer)
2d25aa5a
CY
1242 ;; Prevent kill-buffer from prompting (Bug#3696).
1243 (with-current-buffer buffer
1244 (set-buffer-modified-p nil))
337e3c70
JB
1245 (kill-buffer buffer))
1246 (unless killed
1247 (if (server-temp-file-p buffer)
1248 (progn
2d25aa5a
CY
1249 (with-current-buffer buffer
1250 (set-buffer-modified-p nil))
337e3c70
JB
1251 (kill-buffer buffer)
1252 (setq killed t))
1253 (bury-buffer buffer)))))))
9184aafb 1254 (list next-buffer killed)))
9ae0f972 1255
408784a7 1256(defun server-temp-file-p (&optional buffer)
9ae0f972 1257 "Return non-nil if BUFFER contains a file considered temporary.
1258These are files whose names suggest they are repeatedly
1259reused to pass information to another program.
1260
1261The variable `server-temp-file-regexp' controls which filenames
1262are considered temporary."
1263 (and (buffer-file-name buffer)
a77ad240 1264 (string-match-p server-temp-file-regexp (buffer-file-name buffer))))
9ae0f972 1265
1266(defun server-done ()
cc9875f9 1267 "Offer to save current buffer, mark it as \"done\" for clients.
ed9ae328
RS
1268This kills or buries the buffer, then returns a list
1269of the form (NEXT-BUFFER KILLED). NEXT-BUFFER is another server buffer,
1270as a suggestion for what to select next, or nil.
1271KILLED is t if we killed BUFFER, which happens if it was created
1272specifically for the clients and did not exist before their request for it."
408784a7
SM
1273 (when server-buffer-clients
1274 (if (server-temp-file-p)
1275 ;; For a temp file, save, and do make a non-numeric backup
1276 ;; (unless make-backup-files is nil).
1277 (let ((version-control nil)
1278 (buffer-backed-up nil))
1279 (save-buffer))
337e3c70
JB
1280 (when (and (buffer-modified-p)
1281 buffer-file-name
1282 (y-or-n-p (concat "Save file " buffer-file-name "? ")))
1283 (save-buffer)))
408784a7 1284 (server-buffer-done (current-buffer))))
faf931a8 1285
71207de2
RS
1286;; Ask before killing a server buffer.
1287;; It was suggested to release its client instead,
1288;; but I think that is dangerous--the client would proceed
1289;; using whatever is on disk in that file. -- rms.
03d78665 1290(defun server-kill-buffer-query-function ()
9002956f 1291 "Ask before killing a server buffer."
03d78665 1292 (or (not server-buffer-clients)
114a8b8c
KL
1293 (let ((res t))
1294 (dolist (proc server-buffer-clients res)
448f754f
SM
1295 (when (and (memq proc server-clients)
1296 (eq (process-status proc) 'open))
1297 (setq res nil))))
03d78665
RS
1298 (yes-or-no-p (format "Buffer `%s' still has clients; kill it? "
1299 (buffer-name (current-buffer))))))
1300
03d78665 1301(defun server-kill-emacs-query-function ()
c48254fb 1302 "Ask before exiting Emacs if it has live clients."
9002956f
KL
1303 (or (not server-clients)
1304 (let (live-client)
448f754f
SM
1305 (dolist (proc server-clients live-client)
1306 (when (memq t (mapcar 'buffer-live-p (process-get
1307 proc 'buffers)))
974b73e8 1308 (setq live-client t))))
9002956f 1309 (yes-or-no-p "This Emacs session has clients; exit anyway? ")))
b392bac9 1310
fb873cfc 1311(defvar server-kill-buffer-running nil
599f9a5c 1312 "Non-nil while `server-kill-buffer' or `server-buffer-done' is running.")
fb873cfc 1313
b392bac9 1314(defun server-kill-buffer ()
6d3a46f7
KL
1315 "Remove the current buffer from its clients' buffer list.
1316Designed to be added to `kill-buffer-hook'."
fb873cfc
RS
1317 ;; Prevent infinite recursion if user has made server-done-hook
1318 ;; call kill-buffer.
1319 (or server-kill-buffer-running
599f9a5c
RS
1320 (and server-buffer-clients
1321 (let ((server-kill-buffer-running t))
1322 (when server-process
1323 (server-buffer-done (current-buffer) t))))))
9ae0f972 1324\f
1325(defun server-edit (&optional arg)
1326 "Switch to next server editing buffer; say \"Done\" for current buffer.
1327If a server buffer is current, it is marked \"done\" and optionally saved.
ed9ae328 1328The buffer is also killed if it did not exist before the clients asked for it.
9ae0f972 1329When all of a client's buffers are marked as \"done\", the client is notified.
1330
1331Temporary files such as MH <draft> files are always saved and backed up,
991298c3
RS
1332no questions asked. (The variable `make-backup-files', if nil, still
1333inhibits a backup; you can set it locally in a particular buffer to
1334prevent a backup for it.) The variable `server-temp-file-regexp' controls
9ae0f972 1335which filenames are considered temporary.
1336
64f51134 1337If invoked with a prefix argument, or if there is no server process running,
9ae0f972 1338starts server process and that is all. Invoked by \\[server-edit]."
9ae0f972 1339 (interactive "P")
6b519504 1340 (cond
95eefb35
JB
1341 ((or arg
1342 (not server-process)
1343 (memq (process-status server-process) '(signal exit)))
1344 (server-mode 1))
1345 (server-clients (apply 'server-switch-buffer (server-done)))
1346 (t (message "No server editing buffers exist"))))
9ae0f972 1347
ee0aed46 1348(defun server-switch-buffer (&optional next-buffer killed-one filepos)
9ae0f972 1349 "Switch to another buffer, preferably one that has a client.
6d3a46f7
KL
1350Arg NEXT-BUFFER is a suggestion; if it is a live buffer, use it.
1351
1352KILLED-ONE is t in a recursive call if we have already killed one
1353temp-file server buffer. This means we should avoid the final
1354\"switch to some other buffer\" since we've already effectively
ee0aed46
CY
1355done that.
1356
1357FILEPOS specifies a new buffer position for NEXT-BUFFER, if we
1358visit NEXT-BUFFER in an existing window. If non-nil, it should
1359be a cons cell (LINENUMBER . COLUMNNUMBER)."
ca0c7250 1360 (if (null next-buffer)
9002956f
KL
1361 (progn
1362 (let ((rest server-clients))
1363 (while (and rest (not next-buffer))
448f754f 1364 (let ((proc (car rest)))
a7ce6c7f
AS
1365 ;; Only look at frameless clients, or those in the selected
1366 ;; frame.
1367 (when (or (not (process-get proc 'frame))
1368 (eq (process-get proc 'frame) (selected-frame)))
448f754f 1369 (setq next-buffer (car (process-get proc 'buffers))))
9002956f
KL
1370 (setq rest (cdr rest)))))
1371 (and next-buffer (server-switch-buffer next-buffer killed-one))
1372 (unless (or next-buffer killed-one (window-dedicated-p (selected-window)))
1373 ;; (switch-to-buffer (other-buffer))
90ee5627 1374 (message "No server buffers remain to edit")))
9002956f 1375 (if (not (buffer-live-p next-buffer))
ca0c7250 1376 ;; If NEXT-BUFFER is a dead buffer, remove the server records for it
9ae0f972 1377 ;; and try the next surviving server buffer.
ca0c7250
SM
1378 (apply 'server-switch-buffer (server-buffer-done next-buffer))
1379 ;; OK, we know next-buffer is live, let's display and select it.
408784a7
SM
1380 (if (functionp server-window)
1381 (funcall server-window next-buffer)
1382 (let ((win (get-buffer-window next-buffer 0)))
1383 (if (and win (not server-window))
ee0aed46
CY
1384 ;; The buffer is already displayed: just reuse the
1385 ;; window. If FILEPOS is non-nil, use it to replace the
1386 ;; window's own value of point.
90caccca
JB
1387 (progn
1388 (select-window win)
ee0aed46
CY
1389 (set-buffer next-buffer)
1390 (when filepos
1391 (server-goto-line-column filepos)))
408784a7 1392 ;; Otherwise, let's find an appropriate window.
60b4b298 1393 (cond ((window-live-p server-window)
408784a7
SM
1394 (select-window server-window))
1395 ((framep server-window)
337e3c70
JB
1396 (unless (frame-live-p server-window)
1397 (setq server-window (make-frame)))
408784a7 1398 (select-window (frame-selected-window server-window))))
337e3c70
JB
1399 (when (window-minibuffer-p (selected-window))
1400 (select-window (next-window nil 'nomini 0)))
408784a7
SM
1401 ;; Move to a non-dedicated window, if we have one.
1402 (when (window-dedicated-p (selected-window))
1403 (select-window
1404 (get-window-with-predicate
1405 (lambda (w)
1406 (and (not (window-dedicated-p w))
6ed8eeff
KL
1407 (equal (frame-terminal (window-frame w))
1408 (frame-terminal (selected-frame)))))
408784a7
SM
1409 'nomini 'visible (selected-window))))
1410 (condition-case nil
1411 (switch-to-buffer next-buffer)
1412 ;; After all the above, we might still have ended up with
1413 ;; a minibuffer/dedicated-window (if there's no other).
90caccca
JB
1414 (error (pop-to-buffer next-buffer)))))))
1415 (when server-raise-frame
1416 (select-frame-set-input-focus (window-frame (selected-window))))))
9ae0f972 1417
59e085e0 1418;;;###autoload
ac088d51 1419(defun server-save-buffers-kill-terminal (arg)
c61a4448 1420 ;; Called from save-buffers-kill-terminal in files.el.
ac088d51 1421 "Offer to save each buffer, then kill the current client.
a77ad240 1422With ARG non-nil, silently save all file-visiting buffers, then kill.
7540c1e0
KL
1423
1424If emacsclient was started with a list of filenames to edit, then
1425only these files will be asked to be saved."
ac088d51
CY
1426 (let ((proc (frame-parameter (selected-frame) 'client)))
1427 (cond ((eq proc 'nowait)
1428 ;; Nowait frames have no client buffer list.
1429 (if (cdr (frame-list))
1430 (progn (save-some-buffers arg)
1431 (delete-frame))
1432 ;; If we're the last frame standing, kill Emacs.
1433 (save-buffers-kill-emacs arg)))
1434 ((processp proc)
1435 (let ((buffers (process-get proc 'buffers)))
1436 ;; If client is bufferless, emulate a normal Emacs exit
1437 ;; and offer to save all buffers. Otherwise, offer to
1438 ;; save only the buffers belonging to the client.
1439 (save-some-buffers
1440 arg (if buffers
1441 (lambda () (memq (current-buffer) buffers))
1442 t))
1443 (server-delete-client proc)))
1444 (t (error "Invalid client frame")))))
b4ca0271 1445
772c5eb7 1446(define-key ctl-x-map "#" 'server-edit)
df4e8a11 1447
08446d5e 1448(defun server-unload-function ()
6d3a46f7 1449 "Unload the server library."
2e8457a0 1450 (server-mode -1)
a8e0c053 1451 (substitute-key-definition 'server-edit nil ctl-x-map)
08446d5e
JB
1452 (save-current-buffer
1453 (dolist (buffer (buffer-list))
1454 (set-buffer buffer)
1455 (remove-hook 'kill-buffer-hook 'server-kill-buffer t)))
1456 ;; continue standard unloading
1457 nil)
3bb38bc2 1458
16c15321
RM
1459\f
1460(provide 'server)
c88ab9ce 1461
2e8457a0 1462;; arch-tag: 1f7ecb42-f00a-49f8-906d-61995d84c8d6
c88ab9ce 1463;;; server.el ends here