that can be given to the server process to identify a client.
When a buffer is marked as \"done\", it is removed from this list.")
+(defvar server-ttys nil
+ "List of current terminal devices used by the server.
+Each element is (CLIENTID TTY) where CLIENTID is a string
+that can be given to the server process to identify a client.
+TTY is the name of the tty device.
+When all the buffers of the client are marked as \"done\",
+the frame is deleted.")
+
(defvar server-buffer-clients nil
"List of client ids for clients requesting editing of current buffer.")
(make-variable-buffer-local 'server-buffer-clients)
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)
(let ((client (assq proc server-clients)))
;; Remove PROC from the list of clients.
(or (and server-kill-new-buffers
(not server-existing-buffer))
(server-temp-file-p)))
- (kill-buffer (current-buffer)))))))
+ (kill-buffer (current-buffer)))))
+ (let ((tty (assq (car client) server-ttys)))
+ (when tty
+ (setq server-ttys (delq tty server-ttys))
+ (when (server-tty-live-p (cadr tty))
+ (delete-tty (cadr tty)))))))
(server-log (format "Status changed to %s" (process-status proc)) proc))
+(defun server-handle-delete-tty (tty)
+ "Delete the client connection when the emacsclient frame is deleted."
+ (dolist (entry server-ttys)
+ (let ((proc (nth 0 entry))
+ (term (nth 1 entry)))
+ (when (equal term tty)
+ (let ((client (assq proc server-clients)))
+ (setq server-ttys (delq entry server-ttys))
+ (delete-process (car client))
+ (when (assq proc server-clients)
+ ;; This seems to be necessary to handle
+ ;; `emacsclient -t -e '(delete-frame)'' correctly.
+ (setq server-clients (delq client server-clients))))))))
+
(defun server-select-display (display)
;; If the current frame is on `display' we're all set.
(unless (equal (frame-parameter (selected-frame) 'display) display)
(while server-clients
(let ((buffer (nth 1 (car server-clients))))
(server-buffer-done buffer)))
+ ;; Delete any remaining opened frames of the previous server.
+ (while server-ttys
+ (let ((tty (cadar server-ttys)))
+ (setq server-ttys (cdr server-ttys))
+ (when (server-tty-live-p tty) (delete-tty tty))))
(unless leave-dead
(if server-process
(server-log (message "Restarting server")))
(letf (((default-file-modes) ?\700))
+ (add-to-list 'delete-tty-after-functions 'server-handle-delete-tty)
(setq server-process
(make-network-process
:name "server" :family 'local :server t :noquery t
(coding-system (and default-enable-multibyte-characters
(or file-name-coding-system
default-file-name-coding-system)))
- client nowait eval
+ client nowait eval newframe
+ registered ; t if the client is already added to server-clients.
(files nil)
(lineno 1)
(columnno 0))
(server-select-display display)
(error (process-send-string proc (nth 1 err))
(setq request "")))))
+ ;; Open a new frame at the client. ARG is the name of the pseudo tty.
+ ((and (equal "-tty" arg) (string-match "\\([^ ]*\\) \\([^ ]*\\) " request))
+ (let ((tty (server-unquote-arg (match-string 1 request)))
+ (type (server-unquote-arg (match-string 2 request))))
+ (setq request (substring request (match-end 0)))
+ (condition-case err
+ (let ((frame (make-frame-on-tty tty type)))
+ (setq server-ttys (cons (list (car client) (frame-tty-name frame)) server-ttys))
+ (process-send-string proc (concat "emacs-pid " (number-to-string (emacs-pid)) "\n"))
+ (select-frame frame)
+ ;; This makes sure that `emacsclient -t -e '(delete-frame)'' works right.
+ (push client server-clients)
+ (setq registered t
+ newframe t))
+ (error (process-send-string proc (concat (nth 1 err) "\n"))
+ (setq request "")))))
;; ARG is a line number option.
((string-match "\\`\\+[0-9]+\\'" arg)
(setq lineno (string-to-int (substring arg 1))))
(if coding-system
(setq arg (decode-coding-string arg coding-system)))
(if eval
- (let ((v (eval (car (read-from-string arg)))))
- (when v
- (with-temp-buffer
- (let ((standard-output (current-buffer)))
- (pp v)
- (process-send-region proc (point-min) (point-max))))))
+ (condition-case err
+ (let ((v (eval (car (read-from-string arg)))))
+ (when (and (not newframe) v)
+ (with-temp-buffer
+ (let ((standard-output (current-buffer)))
+ (pp v)
+ (process-send-region proc (point-min) (point-max))))))
+ (error
+ (ignore-errors
+ (process-send-string
+ proc (concat "*Error* " (error-message-string err))))))
+
;; ARG is a file name.
;; Collapse multiple slashes to single slashes.
(setq arg (command-line-normalize-file-name arg))
(server-visit-files files client nowait)
(run-hooks 'post-command-hook))
;; CLIENT is now a list (CLIENTNUM BUFFERS...)
- (if (null (cdr client))
+ (if (and (not newframe) (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))
+ (or nowait registered (push client server-clients))
(unless (or isearch-mode (minibufferp))
- (server-switch-buffer (nth 1 client))
- (run-hooks 'server-switch-hook)
- (unless nowait
- (message (substitute-command-keys
- "When done with a buffer, type \\[server-edit]")))))))
+ (if (and newframe (null (cdr client)))
+ (message (substitute-command-keys
+ "When done with this frame, type \\[delete-frame]"))
+ (server-switch-buffer (nth 1 client))
+ (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)))
;; If client now has no pending buffers,
;; tell it that it is done, and forget it entirely.
(unless (cdr client)
- (delete-process (car client))
- (server-log "Close" (car client))
- (setq server-clients (delq client server-clients))))
+ (let ((tty (assq (car client) server-ttys)))
+ (if tty
+ ;; Be careful, if we delete the process before the
+ ;; tty, then the terminal modes will not be restored
+ ;; correctly.
+ (delete-tty (cadr tty))
+ (delete-process (car client))
+ (server-log "Close" (car client))
+ (setq server-clients (delq client server-clients))))))
(setq old-clients (cdr old-clients)))
(if (and (bufferp buffer) (buffer-name buffer))
;; We may or may not kill this buffer;
;; using whatever is on disk in that file. -- rms.
(defun server-kill-buffer-query-function ()
(or (not server-buffer-clients)
+ (let ((res t))
+ (dolist (proc server-buffer-clients res)
+ (setq proc (assq proc server-clients))
+ (when (and proc (eq (process-status (car proc)) 'open))
+ (setq res nil))))
(yes-or-no-p (format "Buffer `%s' still has clients; kill it? "
(buffer-name (current-buffer))))))
;; since we've already effectively done that.
(if (null next-buffer)
(if server-clients
- (server-switch-buffer (nth 1 (car server-clients)) killed-one)
+ (let ((buffer (nth 1 (car server-clients))))
+ (and buffer (server-switch-buffer buffer killed-one)))
(unless (or killed-one (window-dedicated-p (selected-window)))
(switch-to-buffer (other-buffer))
(message "No server buffers remain to edit")))