Function: server--process-filter-1
server--process-filter-1 is a byte-compiled function defined in
server.el.gz.
Signature
(server--process-filter-1 PROC STRING)
Source Code
;; Defined in /usr/src/emacs/lisp/server.el.gz
(cl-defun server--process-filter-1 (proc string)
(server-log (concat "Received " string) proc)
;; First things first: let's check the authentication.
;; It is important that we strip the trailing space or newline
;; character in order that it does not appear, to the code below,
;; that there is a zero-length argument there (bug#79889).
(unless (process-get proc :authenticated)
(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)))
(process-put proc :authenticated t)
(server-log "Authentication successful" proc))
(server-log "Authentication failed" proc)
;; Display the error as a message and give the user time to see
;; it, in case the error written by emacsclient to stderr is not
;; visible for some reason.
(server--message-sit-for 2 "Authentication failed")
(server-send-string
proc (concat "-error " (server-quote-arg "Authentication failed")))
(unless (eq system-type 'windows-nt)
(let ((terminal (process-get proc 'terminal)))
;; Only delete the terminal if it is non-nil.
(when (and terminal (eq (terminal-live-p terminal) t))
(delete-terminal terminal))))
;; Before calling `delete-process', give emacsclient time to
;; receive the error string and shut down on its own.
;; FIXME: Why do we wait 1s here but 5s in the other one?
(run-with-timer 1 nil #'delete-process proc)
;; We return immediately.
(cl-return-from server--process-filter-1)))
(let ((prev (process-get proc 'previous-string)))
(when prev
(setq string (concat prev string))
(process-put proc 'previous-string nil)))
(condition-case-unless-debug err
(progn
(server-add-client proc)
;; Send our pid
(server-send-string proc (concat "-emacs-pid "
(number-to-string (emacs-pid)) "\n"))
(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.
(cl-assert (eq (match-end 0) (length string)))
(let ((request (substring string 0 (match-beginning 0)))
(coding-system (or file-name-coding-system
default-file-name-coding-system))
nowait ; t if emacsclient does not want to wait for us.
frame ; Frame opened for the client (if any).
display ; Open frame on this display.
parent-id ; Window ID for XEmbed
dontkill ; t if client should not be killed.
commands
evalexprs
dir
use-current-frame
frame-parameters ;parameters for newly created frame
tty-name ; nil, `window-system', or the tty name.
tty-type ; string.
files
filepos
args-left)
;; Remove this line from STRING.
(setq string (substring string (match-end 0)))
(cl-assert (equal (substring request -1) " ")
nil "emacsclient request did not end in SPC: %S" request)
(setq args-left (mapcar #'server-unquote-arg
(nbutlast (split-string request " "))))
(while args-left
(pcase (pop args-left)
;; -version CLIENT-VERSION: obsolete at birth.
("-version" (pop args-left))
;; -nowait: Emacsclient won't wait for a result.
("-nowait" (setq nowait t))
;; -current-frame: Don't create frames.
("-current-frame" (setq use-current-frame t))
;; -frame-parameters: Set frame parameters
("-frame-parameters"
(let ((alist (pop args-left)))
(if coding-system
(setq alist (decode-coding-string alist coding-system)))
(setq frame-parameters (car (read-from-string alist)))))
;; -display DISPLAY:
;; Open X frames on the given display instead of the default.
("-display"
(setq display (pop args-left))
(if (zerop (length display)) (setq display nil)))
;; -parent-id ID:
;; Open X frame within window ID, via XEmbed.
("-parent-id"
(setq parent-id (pop args-left))
(if (zerop (length parent-id)) (setq parent-id nil)))
;; -window-system: Open a new X frame.
("-window-system"
(if (fboundp 'x-create-frame)
(setq dontkill t
tty-name 'window-system)))
;; -resume: Resume a suspended tty frame.
("-resume"
(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.)
("-suspend"
(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.)
("-ignore"
(setq dontkill t)
(pop args-left))
;; -tty DEVICE-NAME TYPE: Open a new tty frame.
;; (But if we see -window-system later, use that.)
("-tty"
(setq tty-name (pop args-left)
tty-type (pop args-left)
dontkill (or dontkill
(not use-current-frame)))
;; On Windows, emacsclient always asks for a tty
;; frame. If running a GUI server, force the frame
;; type to GUI. (Cygwin is perfectly happy with
;; multi-tty support, so don't override the user's
;; choice there.) In daemon mode on Windows, we can't
;; make tty frames, so force the frame type to GUI
;; there too.
(when (or (and (eq system-type 'windows-nt)
(or (daemonp)
(eq window-system 'w32)))
;; Client runs on Windows, but the server
;; runs on a Posix host.
(equal tty-name "CONOUT$"))
(push "-window-system" args-left)))
;; -position +LINE[:COLUMN]: Set point to the given
;; position in the next file.
("-position"
(if (not (string-match "\\+\\([0-9]+\\)\\(?::\\([0-9]+\\)\\)?"
(car args-left)))
(error "Invalid -position command in client args"))
(let ((arg (pop args-left)))
(setq filepos
(cons (string-to-number (match-string 1 arg))
(string-to-number (or (match-string 2 arg)
""))))))
;; -file FILENAME: Load the given file.
("-file"
(let ((file (pop args-left)))
(if coding-system
(setq file (decode-coding-string file coding-system)))
;; Allow Cygwin's emacsclient to be used as a file
;; handler on MS-Windows, in which case FILENAME
;; might start with a drive letter.
(when (and (fboundp 'cygwin-convert-file-name-from-windows)
(string-match "\\`[A-Za-z]:" file))
(setq file (cygwin-convert-file-name-from-windows file)))
(setq file (expand-file-name file dir))
(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.
("-eval"
(if use-current-frame
(setq use-current-frame 'always))
(let ((expr (pop args-left)))
(if coding-system
(setq expr (decode-coding-string expr coding-system)))
(push expr evalexprs)
(setq filepos nil)))
;; -env NAME=VALUE: An environment variable.
("-env"
(let ((var (pop args-left)))
;; XXX Variables should be encoded as in getenv/setenv.
(process-put proc 'env
(cons var (process-get proc 'env)))))
;; -dir DIRNAME: The cwd of the emacsclient process.
("-dir"
(setq dir (pop args-left))
(if coding-system
(setq dir (decode-coding-string dir coding-system)))
(setq dir (command-line-normalize-file-name dir))
(process-put proc 'server-client-directory dir))
;; Unknown command.
(arg (error "Unknown command: %s" arg))))
;; If both -no-wait and -tty are given with file or sexp
;; arguments, use an existing frame.
(and nowait
(not (eq tty-name 'window-system))
(or files commands evalexprs)
(setq use-current-frame t))
(setq frame
(cond
((and use-current-frame
(or (eq use-current-frame 'always)
;; We can't use the Emacs daemon's
;; terminal frame.
(not (and (daemonp)
(null (cdr (frame-list)))
(eq (selected-frame)
terminal-frame)))))
(setq tty-name nil tty-type nil)
(if display (server-select-display display)))
((equal tty-type "dumb")
(server-create-dumb-terminal-frame nowait proc
frame-parameters))
((or (and (eq system-type 'windows-nt)
(daemonp)
(setq display "w32"))
(eq tty-name 'window-system))
(server-create-window-system-frame display nowait proc
parent-id
frame-parameters))
;; When resuming on a tty, tty-name is nil.
(tty-name
(server-create-tty-frame tty-name tty-type proc
frame-parameters))
;; If there won't be a current frame to use, fall
;; back to trying to create a new one.
((and use-current-frame
(daemonp)
(null (cdr (frame-list)))
(eq (selected-frame) terminal-frame)
display)
(setq tty-name nil tty-type nil)
(server-select-display display))))
(process-put
proc 'continuation
(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 evalexprs
dontkill frame tty-name)))))
(when (or frame files)
(server-goto-toplevel proc))
(server-execute-continuation proc))))
;; condition-case
(t (server-return-error proc err))))