Commit 8b3e840e authored by Stefan Monnier's avatar Stefan Monnier
Browse files

(server-log): Add `client' arg.

(server-start): Don't bother canceling the sentinel.
(server-process-filter): Use replace-regexp-in-string and
handle the new &n quoting.  Use push.  Use server-log's new arg.
Don't output the C-x # message if `nowait'.
(server-buffer-done): Use server-log's new arg.
parent 3cf8c6aa
...@@ -75,7 +75,9 @@ ...@@ -75,7 +75,9 @@
;; and which files are yet to be edited for each. ;; and which files are yet to be edited for each.
;;; Code: ;;; Code:
(eval-when-compile (require 'cl))
(defgroup server nil (defgroup server nil
"Emacs running as a server process." "Emacs running as a server process."
:group 'external) :group 'external)
...@@ -153,12 +155,13 @@ where it is set.") ...@@ -153,12 +155,13 @@ where it is set.")
;; If a *server* buffer exists, ;; If a *server* buffer exists,
;; write STRING to it for logging purposes. ;; write STRING to it for logging purposes.
(defun server-log (string) (defun server-log (string &optional client)
(if (get-buffer "*server*") (if (get-buffer "*server*")
(save-excursion (with-current-buffer "*server*"
(set-buffer "*server*")
(goto-char (point-max)) (goto-char (point-max))
(insert (current-time-string) " " string) (insert (current-time-string)
(if client (format " <%s>: " client) " ")
string)
(or (bolp) (newline))))) (or (bolp) (newline)))))
(defun server-sentinel (proc msg) (defun server-sentinel (proc msg)
...@@ -178,10 +181,7 @@ Emacs distribution as your standard \"editor\". ...@@ -178,10 +181,7 @@ Emacs distribution as your standard \"editor\".
Prefix arg means just kill any existing server communications subprocess." Prefix arg means just kill any existing server communications subprocess."
(interactive "P") (interactive "P")
;; kill it dead! ;; kill it dead!
(if server-process (condition-case () (delete-process server-process) (error nil))
(progn
(set-process-sentinel server-process nil)
(condition-case () (delete-process server-process) (error nil))))
;; Delete the socket files made by previous server invocations. ;; Delete the socket files made by previous server invocations.
(let* ((sysname (system-name)) (let* ((sysname (system-name))
(dot-index (string-match "\\." sysname))) (dot-index (string-match "\\." sysname)))
...@@ -205,8 +205,7 @@ Prefix arg means just kill any existing server communications subprocess." ...@@ -205,8 +205,7 @@ Prefix arg means just kill any existing server communications subprocess."
(while server-clients (while server-clients
(let ((buffer (nth 1 (car server-clients)))) (let ((buffer (nth 1 (car server-clients))))
(server-buffer-done buffer))) (server-buffer-done buffer)))
(if leave-dead (unless leave-dead
nil
(if server-process (if server-process
(server-log (message "Restarting server"))) (server-log (message "Restarting server")))
;; Using a pty is wasteful, and the separate session causes ;; Using a pty is wasteful, and the separate session causes
...@@ -257,7 +256,7 @@ Prefix arg means just kill any existing server communications subprocess." ...@@ -257,7 +256,7 @@ Prefix arg means just kill any existing server communications subprocess."
;; ARG is a line number option. ;; ARG is a line number option.
((string-match "\\`\\+[0-9]+\\'" arg) ((string-match "\\`\\+[0-9]+\\'" arg)
(setq lineno (string-to-int (substring arg 1)))) (setq lineno (string-to-int (substring arg 1))))
;; ARG is line number:column option. ;; ARG is line number:column option.
((string-match "\\`+\\([0-9]+\\):\\([0-9]+\\)\\'" arg) ((string-match "\\`+\\([0-9]+\\):\\([0-9]+\\)\\'" arg)
(setq lineno (string-to-int (match-string 1 arg)) (setq lineno (string-to-int (match-string 1 arg))
columnno (string-to-int (match-string 2 arg)))) columnno (string-to-int (match-string 2 arg))))
...@@ -267,40 +266,39 @@ Prefix arg means just kill any existing server communications subprocess." ...@@ -267,40 +266,39 @@ Prefix arg means just kill any existing server communications subprocess."
(setq arg (command-line-normalize-file-name arg)) (setq arg (command-line-normalize-file-name arg))
;; Undo the quoting that emacsclient does ;; Undo the quoting that emacsclient does
;; for certain special characters. ;; for certain special characters.
(while (string-match "&." arg pos) (setq arg
(setq pos (1+ (match-beginning 0))) (replace-regexp-in-string
(let ((nextchar (aref arg pos))) "&." (lambda (s)
(cond ((= nextchar ?&) (case (aref s 1)
(setq arg (replace-match "&" t t arg))) (?& "&")
((= nextchar ?-) (?- "-")
(setq arg (replace-match "-" t t arg))) (?n "\n")
(t (t " ")))
(setq arg (replace-match " " t t arg)))))) arg t t))
;; Now decode the file name if necessary. ;; Now decode the file name if necessary.
(if coding-system (if coding-system
(setq arg (decode-coding-string arg coding-system))) (setq arg (decode-coding-string arg coding-system)))
(setq files (push (list arg lineno columnno) files)
(cons (list arg lineno columnno)
files))
(setq lineno 1) (setq lineno 1)
(setq columnno 0))))) (setq columnno 0)))))
(run-hooks 'pre-command-hook) (when files
(server-visit-files files client nowait) (run-hooks 'pre-command-hook)
(run-hooks 'post-command-hook) (server-visit-files files client nowait)
(run-hooks 'post-command-hook))
;; CLIENT is now a list (CLIENTNUM BUFFERS...) ;; CLIENT is now a list (CLIENTNUM BUFFERS...)
(if (null (cdr client)) (if (null (cdr client))
;; This client is empty; get rid of it immediately. ;; This client is empty; get rid of it immediately.
(progn (progn
(send-string server-process (send-string server-process
(format "Close: %s Done\n" (car client))) (format "Close: %s Done\n" (car client)))
(server-log (format "Close empty client: %s Done\n" (car client)))) (server-log "Close empty client" (car client)))
;; We visited some buffer for this client. ;; We visited some buffer for this client.
(or nowait (or nowait (push client server-clients))
(setq server-clients (cons client server-clients)))
(server-switch-buffer (nth 1 client)) (server-switch-buffer (nth 1 client))
(run-hooks 'server-switch-hook) (run-hooks 'server-switch-hook)
(message (substitute-command-keys (unless nowait
"When done with a buffer, type \\[server-edit]")))))))) (message (substitute-command-keys
"When done with a buffer, type \\[server-edit]")))))))))
;; Save for later any partial line that remains. ;; Save for later any partial line that remains.
(setq server-previous-string string)) (setq server-previous-string string))
...@@ -356,8 +354,9 @@ so don't mark these buffers specially, just visit them normally." ...@@ -356,8 +354,9 @@ so don't mark these buffers specially, just visit them normally."
"Mark BUFFER as \"done\" for its client(s). "Mark BUFFER as \"done\" for its client(s).
This buries the buffer, then returns a list of the form (NEXT-BUFFER KILLED). This buries the buffer, then returns a list of the form (NEXT-BUFFER KILLED).
NEXT-BUFFER is another server buffer, as a suggestion for what to select next, NEXT-BUFFER is another server buffer, as a suggestion for what to select next,
or nil. KILLED is t if we killed BUFFER or nil. KILLED is t if we killed BUFFER (typically, because it was visiting
\(typically, because it was visiting a temp file)." a temp file).
FOR-KILLING if non-nil indicates that we are called from `kill-buffer'."
(let ((running (eq (process-status server-process) 'run)) (let ((running (eq (process-status server-process) 'run))
(next-buffer nil) (next-buffer nil)
(killed nil) (killed nil)
...@@ -365,7 +364,7 @@ or nil. KILLED is t if we killed BUFFER ...@@ -365,7 +364,7 @@ or nil. KILLED is t if we killed BUFFER
(old-clients server-clients)) (old-clients server-clients))
(while old-clients (while old-clients
(let ((client (car old-clients))) (let ((client (car old-clients)))
(or next-buffer (or next-buffer
(setq next-buffer (nth 1 (memq buffer client)))) (setq next-buffer (nth 1 (memq buffer client))))
(delq buffer client) (delq buffer client)
;; Delete all dead buffers from CLIENT. ;; Delete all dead buffers from CLIENT.
...@@ -384,9 +383,9 @@ or nil. KILLED is t if we killed BUFFER ...@@ -384,9 +383,9 @@ or nil. KILLED is t if we killed BUFFER
;; It cannot handle that. ;; It cannot handle that.
(or first (sit-for 1)) (or first (sit-for 1))
(setq first nil) (setq first nil)
(send-string server-process (send-string server-process
(format "Close: %s Done\n" (car client))) (format "Close: %s Done\n" (car client)))
(server-log (format "Close: %s Done\n" (car client))))) (server-log "Close" (car client))))
(setq server-clients (delq client server-clients)))) (setq server-clients (delq client server-clients))))
(setq old-clients (cdr old-clients))) (setq old-clients (cdr old-clients)))
(if (and (bufferp buffer) (buffer-name buffer)) (if (and (bufferp buffer) (buffer-name buffer))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment