;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
(defvar server-name "server")
-(defvar server-socket-dir nil
- "The directory in which to place the server socket.
-Initialized by `server-start'.")
+(defvar server-socket-dir (format "/tmp/emacs%d" (user-uid))
+ "The directory in which to place the server socket.")
(defun server-clients-with (property value)
"Return a list of clients with PROPERTY set to VALUE."
(server-log "Deleted" proc))))
(defvar server-log-time-function 'current-time-string
- "Function to generate timestamps for the *server* buffer.")
+ "Function to generate timestamps for `server-buffer'.")
+
+(defconst server-buffer " *server*"
+ "Buffer used internally by Emacs's server.
+One use is to log the I/O for debugging purposes (see `server-log'),
+the other is to provide a current buffer in which the process filter can
+safely let-bind buffer-local variables like `default-directory'.")
+
+(defvar server-log nil
+ "If non-nil, log the server's inputs and outputs in the `server-buffer'.")
(defun server-log (string &optional client)
- "If a *server* buffer exists, write STRING to it for logging purposes.
+ "If `server-log' is non-nil, log STRING to `server-buffer'.
If CLIENT is non-nil, add a description of it to the logged message."
- (when (get-buffer "*server*")
- (with-current-buffer "*server*"
+ (when server-log
+ (with-current-buffer (get-buffer-create server-buffer)
(goto-char (point-max))
(insert (funcall server-log-time-function)
(cond
(not server-clients)
(yes-or-no-p
"The current server still has clients; delete them? "))
- ;; It is safe to get the user id now.
- (setq server-socket-dir (or server-socket-dir
- (format "/tmp/emacs%d" (user-uid))))
(when server-process
;; kill it dead!
(ignore-errors (delete-process server-process)))
:filter 'server-process-filter
;; We must receive file names without being decoded.
;; Those are decoded by server-process-filter according
- ;; to file-name-coding-system.
- :coding 'raw-text
- ;; The rest of the args depends on the kind of socket used.
+ ;; to file-name-coding-system. Also don't get
+ ;; confused by CRs since we don't quote them.
+ :coding 'raw-text-unix
+ ;; The other args depend on the kind of socket used.
(if server-use-tcp
(list :family nil
:service t
(server-log (concat "Received " string) proc)
;; First things first: let's check the authentication
(unless (process-get proc :authenticated)
- (if (and (string-match "-auth \\(.*?\\)\n" string)
+ (if (and (string-match "-auth \\([!-~]+\\)\n?" string)
(equal (match-string 1 string) (process-get proc :auth-key)))
(progn
(setq string (substring string (match-end 0)))
(server-create-window-system-frame display nowait proc))
(t (server-create-tty-frame tty-name tty-type proc))))
- (process-put proc 'continuation
- (lexical-let ((proc proc)
- (files files)
- (nowait nowait)
- (commands commands)
- (dontkill dontkill)
- (frame frame)
- (tty-name tty-name))
- (lambda ()
- (server-execute proc files nowait commands
- dontkill frame tty-name))))
+ (process-put
+ proc 'continuation
+ (lexical-let ((proc proc)
+ (files files)
+ (nowait nowait)
+ (commands commands)
+ (dontkill dontkill)
+ (frame frame)
+ (dir dir)
+ (tty-name tty-name))
+ (lambda ()
+ (with-current-buffer (get-buffer-create server-buffer)
+ ;; Use the same cwd as the emacsclient, if possible, so
+ ;; relative file names work correctly, even in `eval'.
+ (let ((default-directory
+ (if (and dir (file-directory-p dir))
+ dir default-directory)))
+ (server-execute proc files nowait commands
+ dontkill frame tty-name))))))
(when (or frame files)
(server-goto-toplevel proc))
(let ((rest server-clients))
(while (and rest (not next-buffer))
(let ((proc (car rest)))
- ;; Only look at frameless clients.
- (when (not (process-get proc 'frame))
+ ;; Only look at frameless clients, or those in the selected
+ ;; frame.
+ (when (or (not (process-get proc 'frame))
+ (eq (process-get proc 'frame) (selected-frame)))
(setq next-buffer (car (process-get proc 'buffers))))
(setq rest (cdr rest)))))
(and next-buffer (server-switch-buffer next-buffer killed-one))