;; This program transmits the file names to Emacs through
;; the server subprocess, and Emacs visits them and lets you edit them.
-;; Note that any number of clients may dispatch files to emacs to be edited.
+;; Note that any number of clients may dispatch files to Emacs to be edited.
;; When you finish editing a Server buffer, again call server-edit
;; to mark that buffer as done for the client and switch to the next
It is not meaningful to set this to a specific frame or window with Custom.
Only programs can do so."
:group 'server
- :version "21.4"
+ :version "22.1"
:type '(choice (const :tag "Use selected window"
:match (lambda (widget value)
(not (functionp value)))
(setq server-clients (cons (cons proc nil)
server-clients))))
+;;;###autoload
+(defun server-getenv (variable &optional frame)
+ "Get the value of VARIABLE in the client environment of frame FRAME.
+VARIABLE should be a string. Value is nil if VARIABLE is undefined in
+the environment. Otherwise, value is a string.
+
+If FRAME is an emacsclient frame, then the variable is looked up
+in the environment of the emacsclient process; otherwise the
+function consults the environment of the Emacs process.
+
+If FRAME is nil or missing, then the selected frame is used."
+ (when (not frame) (setq frame (selected-frame)))
+ (let ((client (frame-parameter frame 'client)) env)
+ (if (null client)
+ (getenv variable)
+ (setq env (server-client-get client 'environment))
+ (if (null env)
+ (getenv variable)
+ (cdr (assoc variable env))))))
+
+(defmacro server-with-client-environment (client vars &rest body)
+ "Evaluate BODY with environment variables VARS set to those of CLIENT.
+The environment variables are then restored to their previous values.
+
+VARS should be a list of strings."
+ (declare (indent 2))
+ (let ((oldvalues (make-symbol "oldvalues"))
+ (var (make-symbol "var"))
+ (value (make-symbol "value"))
+ (pair (make-symbol "pair")))
+ `(let (,oldvalues)
+ (dolist (,var (quote ,vars))
+ (let ((,value (cdr (assoc ,var (server-client-get ,client 'environment)))))
+ (setq ,oldvalues (cons (cons ,var (getenv ,var)) ,oldvalues))
+ (setenv ,var ,value)))
+ (unwind-protect
+ (progn ,@body)
+ (dolist (,pair ,oldvalues)
+ (setenv (car ,pair) (cdr ,pair)))))))
+
(defun server-delete-client (client &optional noframe)
"Delete CLIENT, including its buffers, displays and frames.
If NOFRAME is non-nil, let the frames live. (To be used from
(kill-buffer (current-buffer))))))
;; Delete the client's tty.
- (let ((tty (server-client-get client 'tty)))
- (when (and tty (server-tty-live-p tty))
- (delete-tty tty)))
+ (let ((display-id (server-client-get client 'display)))
+ (when (eq (display-live-p display-id) t)
+ (delete-display display-id)))
;; Delete the client's frames.
(unless noframe
(server-log "Deleted" proc))))
(defun server-log (string &optional client)
- "If a *server* buffer exists, write STRING to it for logging purposes."
+ "If a *server* buffer exists, write STRING to it for logging purposes.
+If CLIENT is non-nil, add a description of it to the logged
+message."
(if (get-buffer "*server*")
(with-current-buffer "*server*"
(goto-char (point-max))
string)
(or (bolp) (newline)))))
-(defun server-tty-live-p (tty)
- "Return non-nil if the tty device named TTY has a live frame."
- (let (result)
- (dolist (frame (frame-list) result)
- (when (and (eq (frame-live-p frame) t)
- (equal (frame-tty-name frame) tty))
- (setq result t)))))
-
(defun server-sentinel (proc msg)
"The process sentinel for Emacs server connections."
(server-log (format "Status changed to %s: %s" (process-status proc) msg) proc)
(server-delete-client proc))
-(defun server-handle-delete-tty (tty)
- "Delete the client connection when the emacsclient terminal device is closed."
- (dolist (proc (server-clients-with 'tty tty))
- (server-log (format "server-handle-delete-tty, tty %s" tty) proc)
- (server-delete-client proc)))
-
(defun server-handle-delete-frame (frame)
"Delete the client connection when the emacsclient frame is deleted."
(let ((proc (frame-parameter frame 'client)))
- (when (and proc (window-system frame))
- ;; (Closing a terminal frame must not trigger a delete;
- ;; we must wait for delete-tty-after-functions.)
+ (when (and proc
+ (or (window-system frame)
+ ;; A terminal display must not yet be deleted if
+ ;; there are other frames on it.
+ (< 0 (let ((frame-num 0))
+ (mapc (lambda (f)
+ (when (eq (frame-display f)
+ (frame-display frame))
+ (setq frame-num (1+ frame-num))))
+ (frame-list))
+ frame-num))))
(server-log (format "server-handle-delete-frame, frame %s" frame) proc)
(server-delete-client proc 'noframe)))) ; Let delete-frame delete the frame later.
-(defun server-handle-suspend-tty (tty)
+(defun server-handle-suspend-tty (display)
"Notify the emacsclient process to suspend itself when its tty device is suspended."
- (dolist (proc (server-clients-with 'tty tty))
- (server-log (format "server-handle-suspend-tty, tty %s" tty) proc)
- (process-send-string proc "-suspend \n")))
-
-(defun server-select-display (display)
- ;; If the current frame is on `display' we're all set.
- (unless (equal (frame-parameter (selected-frame) 'display) display)
- ;; Otherwise, look for an existing frame there and select it.
- (dolist (frame (frame-list))
- (when (equal (frame-parameter frame 'display) display)
- (select-frame frame)))
- ;; If there's no frame on that display yet, create a dummy one
- ;; and select it.
- (unless (equal (frame-parameter (selected-frame) 'display) display)
- (select-frame
- (make-frame-on-display display)))))
- ;; This frame is only there in place of an actual "current display"
- ;; setting, so we want it to be as unobtrusive as possible. That's
- ;; what the invisibility is for. The minibuffer setting is so that
- ;; we don't end up displaying a buffer in it (which noone would
- ;; notice).
- ;; XXX I have found this behaviour to be surprising and annoying. -- Lorentey
- ;; '((visibility . nil) (minibuffer . only)))))))
+ (dolist (proc (server-clients-with 'display display))
+ (server-log (format "server-handle-suspend-tty, display %s" display) proc)
+ (condition-case err
+ (server-send-string proc "-suspend \n")
+ (file-error (condition-case nil (server-delete-client proc) (error nil))))))
(defun server-unquote-arg (arg)
- "Remove &-quotation from ARG."
+ "Remove &-quotation from ARG.
+See `server-quote-arg' and `server-process-filter'."
(replace-regexp-in-string
"&." (lambda (s)
(case (aref s 1)
(defun server-quote-arg (arg)
"In ARG, insert a & before each &, each space, each newline, and -.
Change spaces to underscores, too, so that the return value never
-contains a space."
+contains a space.
+
+See `server-unquote-arg' and `server-process-filter'."
(replace-regexp-in-string
"[-&\n ]" (lambda (s)
(case (aref s 0)
(?\s "&_")))
arg t t))
+(defun server-send-string (proc string)
+ "A wrapper around `proc-send-string' for logging."
+ (server-log (concat "Sent " string) proc)
+ (process-send-string proc string))
+
(defun server-ensure-safe-dir (dir)
"Make sure DIR is a directory with no race-condition issues.
Creates the directory if necessary and makes sure:
(defun server-start (&optional leave-dead)
"Allow this Emacs process to be a server for client processes.
This starts a server communications subprocess through which
-client \"editors\" can send your editing commands to this Emacs job.
-To use the server, set up the program `emacsclient' in the
+client \"editors\" can send your editing commands to this Emacs
+job. To use the server, set up the program `emacsclient' in the
Emacs distribution as your standard \"editor\".
-Prefix arg means just kill any existing server communications subprocess."
+Prefix arg LEAVE-DEAD means just kill any existing server
+communications subprocess."
(interactive "P")
(when (or
(not server-clients)
(server-log (message "Restarting server"))
(server-log (message "Starting server")))
(letf (((default-file-modes) ?\700))
- (add-hook 'delete-tty-after-functions 'server-handle-delete-tty)
(add-hook 'suspend-tty-functions 'server-handle-suspend-tty)
(add-hook 'delete-frame-functions 'server-handle-delete-frame)
(add-hook 'kill-buffer-query-functions 'server-kill-buffer-query-function)
`emacsclient' program. See `server-start' and Info node `Emacs server'."
:global t
:group 'server
- :version "21.4"
+ :version "22.1"
;; Fixme: Should this check for an existing server socket and do
;; nothing if there is one (for multiple Emacs sessions)?
(server-start (not server-mode)))
\f
(defun server-process-filter (proc string)
"Process a request from the server to edit some files.
-PROC is the server process. Format of STRING is \"PATH PATH PATH... \\n\"."
- (server-log string proc)
+PROC is the server process. STRING consists of a sequence of
+commands prefixed by a dash. Some commands have arguments; these
+are &-quoted and need to be decoded by `server-unquote-arg'. The
+filter parses and executes these commands.
+
+To illustrate the protocol, here is an example command that
+emacsclient sends to create a new X frame (note that the whole
+sequence is sent on a single line):
+
+ -version 21.3.50 xterm
+ -env HOME /home/lorentey
+ -env DISPLAY :0.0
+ ... lots of other -env commands
+ -display :0.0
+ -window-system
+
+The server normally sends back the single command `-good-version'
+as a response.
+
+The following commands are accepted by the server:
+
+`-version CLIENT-VERSION'
+ Check version numbers between server and client, and signal an
+ error if there is a mismatch. The server replies with
+ `-good-version' to confirm the match.
+
+`-env NAME VALUE'
+ An environment variable on the client side.
+
+`-nowait'
+ Request that the next frame created should not be
+ associated with this client.
+
+`-display DISPLAY'
+ Set the display name to open X frames on.
+
+`-position LINE[:COLUMN]'
+ Go to the given line and column number
+ in the next file opened.
+
+`-file FILENAME'
+ Load the given file in the current frame.
+
+`-eval EXPR'
+ Evaluate EXPR as a Lisp expression and return the
+ result in -print commands.
+
+`-window-system'
+ Open a new X frame.
+
+`-tty DEVICENAME TYPE'
+ Open a new tty frame at the client.
+
+`-resume'
+ Resume this tty frame. The client sends this string when it
+ gets the SIGCONT signal and it is the foreground process on its
+ controlling tty.
+
+`-suspend'
+ Suspend this tty frame. The client sends this string in
+ response to SIGTSTP and SIGTTOU. The server must cease all I/O
+ on this tty until it gets a -resume command.
+
+`-ignore COMMENT'
+ Do nothing, but put the comment in the server
+ log. Useful for debugging.
+
+
+The following commands are accepted by the client:
+
+`-good-version'
+ Signals a version match between the client and the server.
+
+`-emacs-pid PID'
+ Describes the process id of the Emacs process;
+ used to forward window change signals to it.
+
+`-window-system-unsupported'
+ Signals that the server does not
+ support creating X frames; the client must try again with a tty
+ frame.
+
+`-print STRING'
+ Print STRING on stdout. Used to send values
+ returned by -eval.
+
+`-error DESCRIPTION'
+ Signal an error (but continue processing).
+
+`-suspend'
+ Suspend this terminal, i.e., stop the client process. Sent
+ when the user presses C-z."
+ (server-log (concat "Received " string) proc)
(let ((prev (process-get proc 'previous-string)))
(when prev
(setq string (concat prev string))
(setq request (substring request (match-end 0)))
(if (equal client-version truncated-emacs-version)
(progn
- (process-send-string proc "-good-version \n")
+ (server-send-string proc "-good-version \n")
(server-client-set client 'version client-version))
(error (concat "Version mismatch: Emacs is "
truncated-emacs-version
((equal "-window-system" arg)
(unless (server-client-get client 'version)
(error "Protocol error; make sure to use the correct version of emacsclient"))
- (setq frame (make-frame-on-display
- (or display
- (frame-parameter nil 'display)
- (getenv "DISPLAY")
- (error "Please specify display"))
- (list (cons 'client proc))))
- ;; XXX We need to ensure the client parameter is
- ;; really set because Emacs forgets initialization
- ;; parameters for X frames at the moment.
- (modify-frame-parameters frame (list (cons 'client proc)))
- (select-frame frame)
- (server-client-set client 'frame frame)
- (setq dontkill t))
+ (if (fboundp 'x-create-frame)
+ (progn
+ (setq frame (make-frame-on-display
+ (or display
+ (frame-parameter nil 'display)
+ (getenv "DISPLAY")
+ (error "Please specify display"))
+ (list (cons 'client proc))))
+ ;; XXX We need to ensure the client parameter is
+ ;; really set because Emacs forgets initialization
+ ;; parameters for X frames at the moment.
+ (modify-frame-parameters frame (list (cons 'client proc)))
+ (select-frame frame)
+ (server-client-set client 'frame frame)
+ (server-client-set client 'display (frame-display frame))
+ (setq dontkill t))
+ ;; This emacs does not support X.
+ (server-log "Window system unsupported" proc)
+ (server-send-string proc "-window-system-unsupported \n")
+ (setq dontkill t)))
;; -resume: Resume a suspended tty frame.
((equal "-resume" arg)
- (let ((tty (server-client-get client 'tty)))
+ (let ((display-id (server-client-get client 'display)))
(setq dontkill t)
- (when tty (resume-tty tty))))
+ (when (eq (display-live-p display-id) t)
+ (resume-tty display-id))))
;; -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)
- (let ((tty (server-client-get client 'tty)))
+ (let ((display-id (server-client-get client 'display)))
(setq dontkill t)
- (when tty (suspend-tty tty))))
+ (when (eq (display-live-p display-id) t)
+ (suspend-tty display-id))))
;; -ignore COMMENT: Noop; useful for debugging emacsclient.
;; (The given comment appears in the server log.)
(setq request (substring request (match-end 0)))
(unless (server-client-get client 'version)
(error "Protocol error; make sure you use the correct version of emacsclient"))
- (setq frame (make-frame-on-tty tty type (list (cons 'client proc))))
+ ;; Set up client's environment for tgetent(3)
+ ;; according to ncurses(3).
+ (server-with-client-environment proc
+ ("BAUDRATE" "COLUMNS" "ESCDELAY" "HOME" "LINES"
+ "NCURSES_ASSUMED_COLORS" "NCURSES_NO_PADDING"
+ "NCURSES_NO_SETBUF" "TERM" "TERMCAP" "TERMINFO"
+ "TERMINFO_DIRS" "TERMPATH")
+ (setq frame (make-frame-on-tty tty type
+ `((client . ,proc)))))
(select-frame frame)
(server-client-set client 'frame frame)
- (server-client-set client 'tty (frame-tty-name frame))
+ (server-client-set client 'tty (display-name frame))
+ (server-client-set client 'display (frame-display frame))
;; Set up display for the remote locale.
(configure-display-for-locale)
;; Reply with our pid.
- (process-send-string proc (concat "-emacs-pid " (number-to-string (emacs-pid)) "\n"))
+ (server-send-string proc (concat "-emacs-pid " (number-to-string (emacs-pid)) "\n"))
(setq dontkill t)))
;; -position LINE: Go to the given line in the next file.
;; -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 request (substring request (match-end 0))
- lineno (string-to-int (match-string 1 request))
- columnno (string-to-int (match-string 2 request))))
+ (setq lineno (string-to-int (match-string 1 request))
+ columnno (string-to-int (match-string 2 request))
+ request (substring request (match-end 0))))
;; -file FILENAME: Load the given file.
((and (equal "-file" arg) (string-match "\\([^ ]+\\) " request))
(with-temp-buffer
(let ((standard-output (current-buffer)))
(pp v)
- (process-send-string proc "-print ")
- (process-send-string
- proc (server-quote-arg
- (buffer-substring-no-properties (point-min)
- (point-max))))
- (process-send-string proc "\n")))))
+ (server-send-string
+ proc (format "-print %s\n"
+ (server-quote-arg
+ (buffer-substring-no-properties (point-min)
+ (point-max)))))))))
(setq lineno 1
columnno 0)))
;; Unknown command.
(t (error "Unknown command: %s" arg)))))
- (when files
- (run-hooks 'pre-command-hook)
- (server-visit-files files client nowait)
- (run-hooks 'post-command-hook))
-
- ;; 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 (server-client-get client 'buffers)))
- ;; This client is empty; get rid of it immediately.
- (server-log "Close empty client" proc)
- (server-delete-client proc))
- (t
- (let ((buffers (server-client-get client 'buffers)))
- (when buffers
- ;; We visited some buffer for this client.
- (cond
- ((or isearch-mode (minibufferp))
- nil)
- ((and frame (null buffers))
- (message (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 (substitute-command-keys
- "When done with a buffer, type \\[server-edit]")))))))))))
+ (let (buffers)
+ (when files
+ (run-hooks 'pre-command-hook)
+ (setq buffers (server-visit-files files client nowait))
+ (run-hooks 'post-command-hook))
+
+ ;; 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 (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 (substitute-command-keys
+ "When done with a buffer, type \\[server-edit]"))))))))
;; Save for later any partial line that remains.
(when (> (length string) 0)
(process-put proc 'previous-string string)))
;; condition-case
(error (ignore-errors
- (process-send-string
+ (server-send-string
proc (concat "-error " (server-quote-arg (error-message-string err))))
(setq string "")
(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)))
(if (> column-number 0)
(move-to-column (1- column-number)))))
(defun server-visit-files (files client &optional nowait)
- "Find FILES and return the list CLIENT with the buffers nconc'd.
+ "Find FILES and return a list of buffers created.
FILES is an alist whose elements are (FILENAME LINENUMBER COLUMNNUMBER).
+CLIENT 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."
;; Bind last-nonmenu-event to force use of keyboard, not mouse, for queries.
(add-hook 'kill-buffer-hook 'server-kill-buffer nil t)
(push (car client) server-buffer-clients))
(push (current-buffer) client-record)))
- (server-client-set
- client 'buffers
- (nconc (server-client-get client 'buffers) client-record))))
+ (unless nowait
+ (server-client-set
+ client 'buffers
+ (nconc (server-client-get client 'buffers) client-record)))
+ client-record))
\f
(defun server-buffer-done (buffer &optional for-killing)
"Mark BUFFER as \"done\" for its client(s).
(buffer-name (current-buffer))))))
(defun server-kill-emacs-query-function ()
- "Ask before exiting Emacs it has are live clients."
+ "Ask before exiting Emacs it has live clients."
(or (not server-clients)
(let (live-client)
(dolist (client server-clients live-client)
"Non-nil while `server-kill-buffer' or `server-buffer-done' is running.")
(defun server-kill-buffer ()
+ "Remove the current buffer from its clients' buffer list.
+Designed to be added to `kill-buffer-hook'."
;; Prevent infinite recursion if user has made server-done-hook
;; call kill-buffer.
(or server-kill-buffer-running
(defun server-switch-buffer (&optional next-buffer killed-one)
"Switch to another buffer, preferably one that has a client.
-Arg NEXT-BUFFER is a suggestion; if it is a live buffer, use it."
- ;; KILLED-ONE is t in a recursive call
- ;; if we have already killed one temp-file server buffer.
- ;; This means we should avoid the final "switch to some other buffer"
- ;; since we've already effectively done that.
+Arg NEXT-BUFFER is a suggestion; if it is a live buffer, use it.
+
+KILLED-ONE is t in a recursive call if we have already killed one
+temp-file server buffer. This means we should avoid the final
+\"switch to some other buffer\" since we've already effectively
+done that."
(if (null next-buffer)
(progn
(let ((rest server-clients))
;; a minibuffer/dedicated-window (if there's no other).
(error (pop-to-buffer next-buffer)))))))))
-(global-set-key "\C-x#" 'server-edit)
+(defun server-save-buffers-kill-display (&optional arg)
+ "Offer to save each buffer, then kill the current connection.
+If the current frame has no client, kill Emacs itself.
-;;;###autoload
-(defun server-getenv (variable &optional frame)
- "Get the value of VARIABLE in the client environment of frame FRAME.
-VARIABLE should be a string. Value is nil if VARIABLE is undefined in
-the environment. Otherwise, value is a string.
+With prefix arg, silently save all file-visiting buffers, then kill.
-If FRAME is an emacsclient frame, then the variable is looked up
-in the environment of the emacsclient process; otherwise the
-function consults the environment of the Emacs process.
+If emacsclient was started with a list of filenames to edit, then
+only these files will be asked to be saved."
+ (interactive "P")
+ (let ((proc (frame-parameter (selected-frame) 'client)))
+ (if proc
+ (let ((buffers (server-client-get proc 'buffers)))
+ ;; If client is bufferless, emulate a normal Emacs session
+ ;; exit and offer to save all buffers. Otherwise, offer to
+ ;; save only the buffers belonging to the client.
+ (save-some-buffers arg
+ (if buffers
+ (lambda () (memq (current-buffer) buffers))
+ t))
+ (server-delete-client proc))
+ (save-buffers-kill-emacs))))
-If FRAME is nil or missing, then the selected frame is used."
- (when (not frame) (setq frame (selected-frame)))
- (let ((client (frame-parameter frame 'client)) env)
- (if (null client)
- (getenv variable)
- (setq env (server-client-get client 'environment))
- (if (null env)
- (getenv variable)
- (cdr (assoc variable env))))))
+(global-set-key "\C-x#" 'server-edit)
(defun server-unload-hook ()
+ "Unload the server library."
(server-start t)
- (remove-hook 'delete-tty-after-functions 'server-handle-delete-tty)
(remove-hook 'suspend-tty-functions 'server-handle-suspend-tty)
(remove-hook 'delete-frame-functions 'server-handle-delete-frame)
(remove-hook 'kill-buffer-query-functions 'server-kill-buffer-query-function)
(remove-hook 'kill-emacs-query-functions 'server-kill-emacs-query-function)
(remove-hook 'kill-buffer-hook 'server-kill-buffer))
+
+(add-hook 'server-unload-hook 'server-unload-hook)
\f
(provide 'server)
HCoop / bpt / emacs.git / blobdiff