;; 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 `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 (current-time-string)
+ (insert (funcall server-log-time-function)
(cond
- ((null client) " ")
- ((listp client) (format " %s: " (car client)))
- (t (format " %s: " client)))
+ ((null client) " ")
+ ((listp client) (format " %s: " (car client)))
+ (t (format " %s: " client)))
string)
(or (bolp) (newline)))))
(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)))
(tty-name nil) ;nil, `window-system', or the tty name.
tty-type ;string.
(files nil)
- (lineno 1)
- (columnno 0)
+ (filepos nil)
command-line-args-left
arg)
;; Remove this line from STRING.
(string-match "\\+\\([0-9]+\\)\\(?::\\([0-9]+\\)\\)?"
(car command-line-args-left)))
(setq arg (pop command-line-args-left))
- (setq lineno (string-to-number (match-string 1 arg))
- columnno (if (null (match-end 2)) 0
- (string-to-number (match-string 2 arg)))))
+ (setq filepos
+ (cons (string-to-number (match-string 1 arg))
+ (string-to-number (or (match-string 2 arg) "")))))
;; -file FILENAME: Load the given file.
((and (equal "-file" arg)
(if coding-system
(setq file (decode-coding-string file coding-system)))
(setq file (command-line-normalize-file-name file))
- (push (list file lineno columnno) files)
- (server-log (format "New file: %s (%d:%d)"
- file lineno columnno) proc))
- (setq lineno 1
- columnno 0))
+ (push (cons file filepos) files)
+ (server-log (format "New file: %s %s"
+ file (or filepos "")) proc))
+ (setq filepos nil))
;; -eval EXPR: Evaluate a Lisp expression.
((and (equal "-eval" arg)
(setq expr (decode-coding-string expr coding-system)))
(push (lambda () (server-eval-and-print expr proc))
commands)
- (setq lineno 1
- columnno 0)))
+ (setq filepos nil)))
;; -env NAME=VALUE: An environment variable.
((and (equal "-env" arg) command-line-args-left)
(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))
(server-log (error-message-string err) proc)
(delete-process proc)))
-(defun server-goto-line-column (file-line-col)
- "Move point to the position indicated in FILE-LINE-COL.
-FILE-LINE-COL should be a three-element list as described in
-`server-visit-files'."
- (goto-line (nth 1 file-line-col))
- (let ((column-number (nth 2 file-line-col)))
- (when (> column-number 0)
- (move-to-column (1- column-number)))))
+(defun server-goto-line-column (line-col)
+ "Move point to the position indicated in LINE-COL.
+LINE-COL should be a pair (LINE . COL)."
+ (when line-col
+ (goto-line (car line-col))
+ (let ((column-number (cdr line-col)))
+ (when (> column-number 0)
+ (move-to-column (1- column-number))))))
(defun server-visit-files (files proc &optional nowait)
"Find FILES and return a list of buffers created.
-FILES is an alist whose elements are (FILENAME LINENUMBER COLUMNNUMBER).
+FILES is an alist whose elements are (FILENAME . FILEPOS)
+where FILEPOS can be nil or a pair (LINENUMBER . COLUMNNUMBER).
PROC is the client that requested this operation.
NOWAIT non-nil means this client is not waiting for the results,
so don't mark these buffers specially, just visit them normally."
(filen (car file))
(obuf (get-file-buffer filen)))
(add-to-history 'file-name-history filen)
- (if (and obuf (set-buffer obuf))
- (progn
- (cond ((file-exists-p filen)
- (when (not (verify-visited-file-modtime obuf))
- (revert-buffer t nil)))
- (t
- (when (y-or-n-p
- (concat "File no longer exists: " filen
- ", write buffer to file? "))
- (write-file filen))))
- (unless server-buffer-clients
- (setq server-existing-buffer t))
- (server-goto-line-column file))
- (set-buffer (find-file-noselect filen))
- (server-goto-line-column file)
- (run-hooks 'server-visit-hook)))
+ (if (null obuf)
+ (set-buffer (find-file-noselect filen))
+ (set-buffer obuf)
+ (cond ((file-exists-p filen)
+ (when (not (verify-visited-file-modtime obuf))
+ (revert-buffer t nil)))
+ (t
+ (when (y-or-n-p
+ (concat "File no longer exists: " filen
+ ", write buffer to file? "))
+ (write-file filen))))
+ (unless server-buffer-clients
+ (setq server-existing-buffer t)))
+ (server-goto-line-column (cdr file))
+ (run-hooks 'server-visit-hook))
(unless nowait
;; When the buffer is killed, inform the clients.
(add-hook 'kill-buffer-hook 'server-kill-buffer nil t)
(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))