- (process-put proc :previous-string nil)))
- (when (> (recursion-depth) 0)
- ;; We're inside a minibuffer already, so if the emacs-client is trying
- ;; to open a frame on a new display, we might end up with an unusable
- ;; frame because input from that display will be blocked (until exiting
- ;; the minibuffer). Better exit this minibuffer right away.
- ;; Similarly with recursive-edits such as the splash screen.
- (process-put proc :previous-string string)
- (run-with-timer 0 nil (lexical-let ((proc proc))
- (lambda () (server-process-filter proc ""))))
- (top-level))
- (condition-case nil
- ;; If we're running isearch, we must abort it to allow Emacs to
- ;; display the buffer and switch to it.
- (mapc #'(lambda (buffer)
- (with-current-buffer buffer
- (when (bound-and-true-p isearch-mode)
- (isearch-cancel))))
- (buffer-list))
- ;; Signaled by isearch-cancel
- (quit (message nil)))
- ;; If the input is multiple lines,
- ;; process each line individually.
- (while (string-match "\n" string)
- (let ((request (substring string 0 (match-beginning 0)))
- (coding-system (and default-enable-multibyte-characters
- (or file-name-coding-system
- default-file-name-coding-system)))
- client nowait eval
- (files nil)
- (lineno 1)
- (tmp-frame nil) ;; Sometimes used to embody the selected display.
- (columnno 0))
- ;; Remove this line from STRING.
- (setq string (substring string (match-end 0)))
- (setq client (cons proc nil))
- (while (string-match "[^ ]* " request)
- (let ((arg (substring request (match-beginning 0) (1- (match-end 0)))))
- (setq request (substring request (match-end 0)))
- (cond
- ((equal "-nowait" arg) (setq nowait t))
- ((equal "-eval" arg) (setq eval t))
- ((and (equal "-display" arg) (string-match "\\([^ ]*\\) " request))
- (let ((display (server-unquote-arg (match-string 1 request))))
- (setq request (substring request (match-end 0)))
- (condition-case err
- (setq tmp-frame (server-select-display display))
- (error (process-send-string proc (nth 1 err))
- (setq request "")))))
- ;; ARG is a line number option.
- ((string-match "\\`\\+[0-9]+\\'" arg)
- (setq lineno (string-to-number (substring arg 1))))
- ;; ARG is line number:column option.
- ((string-match "\\`+\\([0-9]+\\):\\([0-9]+\\)\\'" arg)
- (setq lineno (string-to-number (match-string 1 arg))
- columnno (string-to-number (match-string 2 arg))))
- (t
- ;; Undo the quoting that emacsclient does
- ;; for certain special characters.
- (setq arg (server-unquote-arg arg))
- ;; Now decode the file name if necessary.
- (when coding-system
- (setq arg (decode-coding-string arg coding-system)))
- (if eval
- (let* (errorp
- (v (condition-case errobj
- (eval (car (read-from-string arg)))
- (error (setq errorp t) errobj))))
- (when v
- (with-temp-buffer
- (let ((standard-output (current-buffer)))
- (when errorp (princ "error: "))
- (pp v)
- (ignore-errors
- (process-send-region proc (point-min) (point-max)))
- ))))
- ;; ARG is a file name.
- ;; Collapse multiple slashes to single slashes.
- (setq arg (command-line-normalize-file-name arg))
- (push (list arg lineno columnno) files))
- (setq lineno 1)
- (setq columnno 0)))))
- (when files
- (run-hooks 'pre-command-hook)
- (server-visit-files files client nowait)
- (run-hooks 'post-command-hook))
- ;; CLIENT is now a list (CLIENTNUM BUFFERS...)
- (if (null (cdr client))
- ;; This client is empty; get rid of it immediately.
- (progn
- (delete-process proc)
- (server-log "Close empty client" proc))
- ;; We visited some buffer for this client.
- (or nowait (push client server-clients))
- (unless (or isearch-mode (minibufferp))
- (server-switch-buffer (nth 1 client))
- (run-hooks 'server-switch-hook)
- (unless nowait
- (message "%s" (substitute-command-keys
+ (process-put proc 'previous-string nil)))
+ (condition-case err
+ (progn
+ (server-add-client proc)
+ (if (not (string-match "\n" string))
+ ;; Save for later any partial line that remains.
+ (when (> (length string) 0)
+ (process-put proc 'previous-string string))
+
+ ;; In earlier versions of server.el (where we used an `emacsserver'
+ ;; process), there could be multiple lines. Nowadays this is not
+ ;; supported any more.
+ (assert (eq (match-end 0) (length string)))
+ (let ((request (substring string 0 (match-beginning 0)))
+ (coding-system (and default-enable-multibyte-characters
+ (or file-name-coding-system
+ default-file-name-coding-system)))
+ nowait ; t if emacsclient does not want to wait for us.
+ frame ; The frame that was opened for the client (if any).
+ display ; Open the frame on this display.
+ dontkill ; t if the client should not be killed.
+ (commands ())
+ dir
+ (tty-name nil) ;nil, `window-system', or the tty name.
+ tty-type ;string.
+ (files nil)
+ (lineno 1)
+ (columnno 0))
+ ;; Remove this line from STRING.
+ (setq string (substring string (match-end 0)))
+ (while (string-match " *[^ ]* " request)
+ (let ((arg (substring request (match-beginning 0)
+ (1- (match-end 0)))))
+ (setq request (substring request (match-end 0)))
+ (cond
+ ;; -version CLIENT-VERSION: obsolete at birth.
+ ((and (equal "-version" arg) (string-match "[^ ]+ " request))
+ (setq request (substring request (match-end 0))))
+
+ ;; -nowait: Emacsclient won't wait for a result.
+ ((equal "-nowait" arg) (setq nowait t))
+
+ ;; -current-frame: Don't create frames.
+ ((equal "-current-frame" arg) (setq tty-name nil))
+
+ ;; -display DISPLAY:
+ ;; Open X frames on the given display instead of the default.
+ ((and (equal "-display" arg)
+ (string-match "\\([^ ]*\\) " request))
+ (setq display (match-string 1 request))
+ (setq request (substring request (match-end 0))))
+
+ ;; -window-system: Open a new X frame.
+ ((equal "-window-system" arg)
+ (setq dontkill t)
+ (setq tty-name 'window-system))
+
+ ;; -resume: Resume a suspended tty frame.
+ ((equal "-resume" arg)
+ (lexical-let ((terminal (process-get proc 'terminal)))
+ (setq dontkill t)
+ (push (lambda ()
+ (when (eq (terminal-live-p terminal) t)
+ (resume-tty terminal)))
+ commands)))
+
+ ;; -suspend: Suspend the client's frame. (In case we
+ ;; get out of sync, and a C-z sends a SIGTSTP to
+ ;; emacsclient.)
+ ((equal "-suspend" arg)
+ (lexical-let ((terminal (process-get proc 'terminal)))
+ (setq dontkill t)
+ (push (lambda ()
+ (when (eq (terminal-live-p terminal) t)
+ (suspend-tty terminal)))
+ commands)))
+
+ ;; -ignore COMMENT: Noop; useful for debugging emacsclient.
+ ;; (The given comment appears in the server log.)
+ ((and (equal "-ignore" arg) (string-match "[^ ]* " request))
+ (setq dontkill t
+ request (substring request (match-end 0))))
+
+ ;; -tty DEVICE-NAME TYPE: Open a new tty frame at the client.
+ ((and (equal "-tty" arg)
+ (string-match "\\([^ ]*\\) \\([^ ]*\\) " request))
+ (setq tty-name (match-string 1 request))
+ (setq tty-type (match-string 2 request))
+ (setq dontkill t)
+ (setq request (substring request (match-end 0))))
+
+ ;; -position LINE[:COLUMN]: Set point to the given
+ ;; position in the next file.
+ ((and (equal "-position" arg)
+ (string-match "\\+\\([0-9]+\\)\\(?::\\([0-9]+\\)\\)? "
+ request))
+ (setq lineno (string-to-number (match-string 1 request))
+ columnno (if (null (match-end 2)) 0
+ (string-to-number (match-string 2 request)))
+ request (substring request (match-end 0))))
+
+ ;; -file FILENAME: Load the given file.
+ ((and (equal "-file" arg)
+ (string-match "\\([^ ]+\\) " request))
+ (let ((file (server-unquote-arg (match-string 1 request))))
+ (setq request (substring request (match-end 0)))
+ (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))
+
+ ;; -eval EXPR: Evaluate a Lisp expression.
+ ((and (equal "-eval" arg)
+ (string-match "\\([^ ]+\\) " request))
+ (lexical-let ((expr (server-unquote-arg
+ (match-string 1 request))))
+ (setq request (substring request (match-end 0)))
+ (if coding-system
+ (setq expr (decode-coding-string expr coding-system)))
+ (push (lambda () (server-eval-and-print expr proc))
+ commands)
+ (setq lineno 1
+ columnno 0)))
+
+ ;; -env NAME=VALUE: An environment variable.
+ ((and (equal "-env" arg) (string-match "\\([^ ]+\\) " request))
+ (let ((var (server-unquote-arg (match-string 1 request))))
+ ;; XXX Variables should be encoded as in getenv/setenv.
+ (setq request (substring request (match-end 0)))
+ (process-put proc 'env
+ (cons var (process-get proc 'env)))))
+
+ ;; -dir DIRNAME: The cwd of the emacsclient process.
+ ((and (equal "-dir" arg) (string-match "\\([^ ]+\\) " request))
+ (setq dir (server-unquote-arg (match-string 1 request)))
+ (setq request (substring request (match-end 0)))
+ (if coding-system
+ (setq dir (decode-coding-string dir coding-system)))
+ (setq dir (command-line-normalize-file-name dir)))
+
+ ;; Unknown command.
+ (t (error "Unknown command: %s" arg)))))
+
+ (setq frame
+ (case tty-name
+ ((nil) (if display (server-select-display display)))
+ ((window-system)
+ (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))))
+
+ (when (or frame files)
+ (server-goto-toplevel proc))
+
+ (server-execute-continuation proc))))
+ ;; condition-case
+ (error (server-return-error proc err))))
+
+(defun server-execute (proc files nowait commands dontkill frame tty-name)
+ (condition-case err
+ (let* ((buffers
+ (when files
+ (run-hooks 'pre-command-hook)
+ (prog1 (server-visit-files files proc nowait)
+ (run-hooks 'post-command-hook)))))
+
+ (mapc 'funcall (nreverse commands))
+
+ ;; Delete the client if necessary.
+ (cond
+ (nowait
+ ;; Client requested nowait; return immediately.
+ (server-log "Close nowait client" proc)
+ (server-delete-client proc))
+ ((and (not dontkill) (null buffers))
+ ;; This client is empty; get rid of it immediately.
+ (server-log "Close empty client" proc)
+ (server-delete-client proc)))
+ (cond
+ ((or isearch-mode (minibufferp))
+ nil)
+ ((and frame (null buffers))
+ (message "%s" (substitute-command-keys
+ "When done with this frame, type \\[delete-frame]")))
+ ((not (null buffers))
+ (server-switch-buffer (car buffers))
+ (run-hooks 'server-switch-hook)
+ (unless nowait
+ (message "%s" (substitute-command-keys