lisp/server.el

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