Mercurial > emacs

changeset 83103:efc0b56b83d9

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Another server.el overhaul. lib-src/emacsclient.c (xstrdup): New function. (quote_argument): Use xmalloc, not malloc. (main): Send environment variable values. lisp/server.el (server-clients): Documentation update. (server-ttys, server-frames): Removed. (server-client, server-client-get, server-client-set) (server-clients-with, server-add-client) (server-delete-client): New functions. (server-sentinel, server-handle-suspend-tty) (server-handle-delete-tty, server-handle-delete-frame) (server-start, server-process-filter, server-visit-files) (server-buffer-done, server-kill-buffer-query-function) (server-kill-emacs-query-function, server-switch-buffer): Use them. (server-log): Handle both kinds of client references. (server-start): Set up all hooks here. (server-process-filter): Cleanup. Store version in client. Handle -env commands for passing environment variable values. (server-buffer-done): Don't close clients that were created bufferless. (server-switch-buffer): Only look at frameless clients. Don't switch away from current buffer if there is no next-buffer. (server-unload-hook): Remove frame/tty hooks, too. lisp/server.el (server-quote-arg, server-unquote-arg) (server-process-filter, server-kill-buffer-query-function) (server-kill-emacs-query-function): Doc update. (server-buffer-done, server-switch-buffer): Use buffer-live-p, not buffer-name. git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-143
author Karoly Lorentey <lorentey@elte.hu>
date Sun, 18 Apr 2004 01:34:11 +0000
parents a330cf2446ad
children 625059157bad
files README.multi-tty lib-src/emacsclient.c lisp/server.el
diffstat 3 files changed, 307 insertions(+), 232 deletions(-) [+]
line wrap: on
line diff
--- a/README.multi-tty	Sun Apr 18 01:08:46 2004 +0000
+++ b/README.multi-tty	Sun Apr 18 01:34:11 2004 +0000
@@ -174,6 +174,7 @@
 Mark Plaksin <happy at mcplaksin dot org>
 Francisco Borges <borges at let dot rug dot nl>
 Frank Ruell <stoerte at dreamwarrior dot net>
+and many others.
 
 Richard Stallman was kind enough to review an earlier version of my
 patches.
--- a/lib-src/emacsclient.c	Sun Apr 18 01:08:46 2004 +0000
+++ b/lib-src/emacsclient.c	Sun Apr 18 01:34:11 2004 +0000
@@ -212,6 +212,35 @@
   exit (0);
 }
 
+/* Like malloc but get fatal error if memory is exhausted.  */
+
+long *
+xmalloc (size)
+     unsigned int size;
+{
+  long *result = (long *) malloc (size);
+  if (result == NULL)
+    {
+      perror ("malloc");
+      exit (1);
+    }
+  return result;
+}
+
+/* Like strdup but get a fatal error if memory is exhausted. */
+
+char *
+xstrdup (const char *s)
+{
+  char *result = strdup (s);
+  if (result == NULL)
+    {
+      perror ("strdup");
+      exit (1);
+    }
+  return result;
+}
+
 /* In STR, insert a & before each &, each space, each newline, and
    any initial -.  Change spaces to underscores, too, so that the
    return value never contains a space.
@@ -223,7 +252,7 @@
      char *str;
      FILE *stream;
 {
-  char *copy = (char *) malloc (strlen (str) * 2 + 1);
+  char *copy = (char *) xmalloc (strlen (str) * 2 + 1);
   char *p, *q;
 
   p = str;
@@ -291,20 +320,6 @@
   return str;
 }
 
-/* Like malloc but get fatal error if memory is exhausted.  */
-
-long *
-xmalloc (size)
-     unsigned int size;
-{
-  long *result = (long *) malloc (size);
-  if (result == NULL)
-  {
-    perror ("malloc");
-    exit (1);
-  }
-  return result;
-}
 
 /*
   Try to run a different command, or --if no alternate editor is
@@ -610,11 +625,11 @@
 	 /* `stat' failed */
 	 if (saved_errno == ENOENT)
 	   fprintf (stderr,
-		    "%s: Can't find socket; have you started the server?\n\
+		    "%s: can't find socket; have you started the server?\n\
 To start the server in Emacs, type \"M-x server-start\".\n",
 		    argv[0]);
 	 else
-	   fprintf (stderr, "%s: Can't stat %s: %s\n",
+	   fprintf (stderr, "%s: can't stat %s: %s\n",
 		    argv[0], server.sun_path, strerror (saved_errno));
 	 fail ();
 	 break;
@@ -629,7 +644,7 @@
       fail ();
     }
 
-  /* We use the stream OUT to send our command to the server.  */
+  /* We use the stream OUT to send our commands to the server.  */
   if ((out = fdopen (s, "r+")) == NULL)
     {
       fprintf (stderr, "%s: ", argv[0]);
@@ -637,7 +652,7 @@
       fail ();
     }
 
-  /* We use the stream IN to read the response.
+  /* We use the stream IN to read the responses.
      We used to use just one stream for both output and input
      on the socket, but reversing direction works nonportably:
      on some systems, the output appears as the first input;
@@ -660,7 +675,7 @@
 
 #ifdef HAVE_GETCWD
       fprintf (stderr, "%s: %s (%s)\n", argv[0],
-	       "Cannot get current working directory", strerror (errno));
+	       "cannot get current working directory", strerror (errno));
 #else
       fprintf (stderr, "%s: %s (%s)\n", argv[0], string, strerror (errno));
 #endif
@@ -670,6 +685,28 @@
   /* First of all, send our version number for verification. */
   fprintf (out, "-version %s ", VERSION);
 
+  /* Send over our environment. */
+  {
+    extern char **environ;
+    int i;
+    for (i = 0; environ[i]; i++)
+      {
+        char *name = xstrdup (environ[i]);
+        char *value = strchr (name, '=');
+        if (value && strlen (value) > 1)
+          {
+            *value++ = 0;
+            fprintf (out, "-env ");
+            quote_argument (name, out);
+            fprintf (out, " ");
+            quote_argument (value, out);
+            fprintf (out, " ");
+            fflush (out);
+          }
+        free (name);
+      }
+  }
+
   if (nowait)
     fprintf (out, "-nowait ");
 
--- a/lisp/server.el	Sun Apr 18 01:08:46 2004 +0000
+++ b/lisp/server.el	Sun Apr 18 01:34:11 2004 +0000
@@ -102,27 +102,8 @@
 
 (defvar server-clients nil
   "List of current server clients.
-Each element is (CLIENTID BUFFERS...) where CLIENTID is a string
-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 frames on the device are deleted, the server quits the
-connection to the client, and vice versa.")
-
-(defvar server-frames nil
-  "List of current window-system frames used by the server.
-Each element is (CLIENTID FRAME) where CLIENTID is a string
-that can be given to the server process to identify a client.
-FRAME is the frame that was opened by the client.
-
-When the frame is deleted, the server closes the connection to
-the client, and vice versa.")
+Each element is (PROC PROPERTIES...) where PROC is a process object,
+and PROPERTIES is an association list of client properties.")
 
 (defvar server-buffer-clients nil
   "List of client ids for clients requesting editing of current buffer.")
@@ -182,13 +163,97 @@
 (defvar server-socket-dir
   (format "/tmp/emacs%d" (user-uid)))
 
+(defun server-client (proc)
+  "Return the Emacs client corresponding to PROC.
+PROC must be a process object.
+The car of the result is PROC; the cdr is an association list.
+See `server-client-get' and `server-client-set'."
+  (assq proc server-clients))
+
+(defun server-client-get (client property)
+  "Get the value of PROPERTY in CLIENT.
+CLIENT may be a process object, or a client returned by `server-client'.
+Return nil if CLIENT has no such property."
+  (or (listp client) (setq client (server-client client)))
+  (cdr (assq property (cdr client))))
+
+(defun server-client-set (client property value)
+  "Set the PROPERTY to VALUE in CLIENT, and return VALUE.
+CLIENT may be a process object, or a client returned by `server-client'."
+  (let (p proc)
+    (if (listp client)
+	(setq proc (car client))
+      (setq proc client
+	    client (server-client client)))
+    (setq p (assq property client))
+    (cond
+     (p (setcdr p value))
+     (client (setcdr client (cons (cons property value) (cdr client))))
+     (t (setq server-clients
+	      `((,proc (,property . ,value)) . ,server-clients))))
+    value))
+
+(defun server-clients-with (property value)
+  "Return a list of clients with PROPERTY set to VALUE."
+  (let (result)
+    (dolist (client server-clients result)
+      (when (equal value (server-client-get client property))
+	(setq result (cons (car client) result))))))
+
+(defun server-add-client (proc)
+  "Create a client for process PROC, if it doesn't already have one.
+New clients have no properties."
+  (unless (server-client proc)
+    (setq server-clients (cons (cons proc nil)
+			       server-clients))))
+
+(defun server-delete-client (client)
+  "Delete CLIENT, including its buffers, displays and frames."
+  ;; Force a new lookup of client (prevents infinite recursion).
+  (setq client (server-client
+		(if (listp client) (car client) client)))
+  (let ((proc (car client))
+	(buffers (server-client-get client 'buffers)))
+    (when client
+      (setq server-clients (delq client server-clients))
+
+      (dolist (buf buffers)
+	(with-current-buffer buf
+	  ;; Remove PROC from the clients of each buffer.
+	  (setq server-buffer-clients (delq proc server-buffer-clients))
+	  ;; Kill the buffer if necessary.
+	  (when (and (null server-buffer-clients)
+		     (or (and server-kill-new-buffers
+			      (not server-existing-buffer))
+			 (server-temp-file-p)))
+	    (kill-buffer (current-buffer)))))
+
+      ;; Delete the client's tty.
+      (let ((tty (server-client-get client 'tty)))
+	(when tty (delete-tty tty)))
+
+      ;; Delete the client's frames.
+      (dolist (frame (frame-list))
+	(if (and (frame-live-p frame)
+		 (equal (car client) (frame-parameter frame 'client)))
+	    (delete-frame frame)))
+
+      ;; Delete the client's process.
+      (if (eq (process-status (car client)) 'open)
+	  (delete-process (car client)))
+
+      (server-log "Deleted" proc))))
+
 (defun server-log (string &optional client)
   "If a *server* buffer exists, write STRING to it for logging purposes."
   (if (get-buffer "*server*")
       (with-current-buffer "*server*"
 	(goto-char (point-max))
 	(insert (current-time-string)
-		(if client (format " %s: " client) " ")
+		(cond
+		 ((null client) " ")
+		 ((listp client) (format " %s: " (car client)))
+		 (t (format " %s: " client)))
 		string)
 	(or (bolp) (newline)))))
 
@@ -201,66 +266,28 @@
 	(setq result t)))))
 
 (defun server-sentinel (proc msg)
-  (let ((client (assq proc server-clients)))
-    ;; Remove PROC from the list of clients.
-    (when client
-      (setq server-clients (delq client server-clients))
-      (dolist (buf (cdr client))
-	(with-current-buffer buf
-	  ;; Remove PROC from the clients of each buffer.
-	  (setq server-buffer-clients (delq proc server-buffer-clients))
-	  ;; Kill the buffer if necessary.
-	  (when (and (null server-buffer-clients)
-		     (or (and server-kill-new-buffers
-			      (not server-existing-buffer))
-			 (server-temp-file-p)))
-	    (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))
+  "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 (entry server-ttys)
-    (let ((proc (nth 0 entry))
-	  (term (nth 1 entry)))
-      (when (equal term tty)
-	(let ((client (assq proc server-clients)))
-	  (server-log (format "server-handle-delete-tty, tty %s" tty) (car client))
-	  (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))))))))
+  (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 proc
+      (server-log (format "server-handle-delete-frame, frame %s" frame) proc)
+      (server-delete-client proc))))
 
 (defun server-handle-suspend-tty (tty)
   "Notify the emacsclient process to suspend itself when its tty device is suspended."
-  (dolist (entry server-ttys)
-    (let ((proc (nth 0 entry))
-	  (term (nth 1 entry)))
-      (when (equal term tty)
-	(let ((process (car (assq proc server-clients))))
-	  (server-log (format "server-handle-suspend-tty, tty %s" tty) process)
-	  (process-send-string process "-suspend \n"))))))
-
-(defun server-handle-delete-frame (frame)
-  "Delete the client connection when the emacsclient frame is deleted."
-  (dolist (entry server-frames)
-    (let ((proc (nth 0 entry))
-	  (f (nth 1 entry)))
-      (when (equal frame f)
-	(let ((client (assq proc server-clients)))
-	  (server-log (format "server-handle-delete-frame, frame %s" frame) (car client))
-	  (setq server-frames (delq entry server-frames))
-	  (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))))))))
+  (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.
@@ -283,6 +310,7 @@
 	;; '((visibility . nil) (minibuffer . only)))))))
 
 (defun server-unquote-arg (arg)
+  "Remove &-quotation from ARG."
   (replace-regexp-in-string
    "&." (lambda (s)
 	  (case (aref s 1)
@@ -293,7 +321,7 @@
    arg t t))
 
 (defun server-quote-arg (arg)
-  "In NAME, insert a & before each &, each space, each newline, and -.
+  "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."
   (replace-regexp-in-string
@@ -342,20 +370,16 @@
     (error nil))
   ;; If this Emacs already had a server, clear out associated status.
   (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))))
+    (server-delete-client (car server-clients)))
   (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)
-      (add-to-list 'suspend-tty-functions 'server-handle-suspend-tty)
-      (add-to-list 'delete-frame-functions 'server-handle-delete-frame)
+      (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)
+      (add-hook 'kill-emacs-query-functions 'server-kill-emacs-query-function)
       (setq server-process
 	    (make-network-process
 	     :name "server" :family 'local :server t :noquery t
@@ -389,6 +413,7 @@
       (process-put proc 'previous-string nil)))
   (condition-case err
       (progn
+	(server-add-client proc)
 	;; If the input is multiple lines,
 	;; process each line individually.
 	(while (string-match "\n" string)
@@ -396,100 +421,106 @@
 		(coding-system (and default-enable-multibyte-characters
 				    (or file-name-coding-system
 					default-file-name-coding-system)))
-		client nowait newframe display version-checked
+		(client (server-client proc))
+		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.
-		registered ; t if the client is already added to server-clients.
 		(files nil)
 		(lineno 1)
 		(columnno 0))
 	    ;; Remove this line from STRING.
 	    (setq string (substring string (match-end 0)))
-	    (setq client (cons proc nil))
-	    (while (string-match "[^ ]* " request)
+	    (while (string-match " *[^ ]* " request)
 	      (let ((arg (substring request (match-beginning 0) (1- (match-end 0)))))
 		(setq request (substring request (match-end 0)))
 		(cond
-		 ;; Check version numbers.
-		 ((and (equal "-version" arg) (string-match "\\([0-9.]+\\) " request))
+		 ;; -version CLIENT-VERSION:
+		 ;; Check version numbers, signal an error if there is a mismatch.
+		 ((and (equal "-version" arg)
+		       (string-match "\\([0-9.]+\\) " request))
 		  (let* ((client-version (match-string 1 request))
-			 (truncated-emacs-version (substring emacs-version 0 (length client-version))))
+			 (truncated-emacs-version
+			  (substring emacs-version 0 (length client-version))))
 		    (setq request (substring request (match-end 0)))
 		    (if (equal client-version truncated-emacs-version)
 			(progn
 			  (process-send-string proc "-good-version \n")
-			  (setq version-checked t))
-		      (error (concat "Version mismatch: Emacs is " truncated-emacs-version ", emacsclient is " client-version)))))
+			  (server-client-set client 'version client-version))
+		      (error (concat "Version mismatch: Emacs is "
+				     truncated-emacs-version
+				     ", emacsclient is " client-version)))))
 
+		 ;; -nowait:  Emacsclient won't wait for a result.
 		 ((equal "-nowait" arg) (setq nowait t))
 
+		 ;; -display DISPLAY:
+		 ;; Open X frames on the given instead of the default.
 		 ((and (equal "-display" arg) (string-match "\\([^ ]*\\) " request))
 		  (setq display (match-string 1 request)
 			request (substring request (match-end 0))))
 
-		 ;; Open a new X frame.
+		 ;; -window-system:  Open a new X frame.
 		 ((equal "-window-system" arg)
-		  (unless version-checked
+		  (unless (server-client-get client 'version)
 		    (error "Protocol error; make sure to use the correct version of emacsclient"))
-		  (let ((frame (make-frame-on-display
-				(or display
-				    (frame-parameter nil 'display)
-				    (getenv "DISPLAY")
-				    (error "Please specify display")))))
-		    (push (list proc frame) server-frames)
-		    (select-frame frame)
-		    ;; This makes sure that `emacsclient -w -e '(delete-frame)'' works right.
-		    (push client server-clients)
-		    (setq registered t
-			  newframe t
-			  dontkill t)))
+		  (setq frame (make-frame-on-display
+			       (or display
+				   (frame-parameter nil 'display)
+				   (getenv "DISPLAY")
+				   (error "Please specify display"))
+			       (list (cons 'client proc))))
+		  (select-frame frame)
+		  (server-client-set client 'frame frame)
+		  (setq dontkill t))
 
-		 ;; Resume a suspended tty frame.
+		 ;; -resume:  Resume a suspended tty frame.
 		 ((equal "-resume" arg)
-		  (let ((tty (cadr (assq (car client) server-ttys))))
+		  (let ((tty (server-client-get client 'tty)))
 		    (setq dontkill t)
 		    (when tty (resume-tty tty))))
 
-		 ;; Suspend the client's frame.  (In case we get out of
-		 ;; sync, and a C-z sends a SIGTSTP to emacsclient.)
+		 ;; -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 (cadr (assq (car client) server-ttys))))
+		  (let ((tty (server-client-get client 'tty)))
 		    (setq dontkill t)
 		    (when tty (suspend-tty tty))))
 
-		 ;; Noop; useful for debugging emacsclient.
+		 ;; -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))))
 
-		 ;; Open a new tty frame at the client.  ARG is the name of the pseudo tty.
+		 ;; -tty DEVICE-NAME TYPE:  Open a new tty frame at the client.
 		 ((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)))
-		    (unless version-checked
-		      (error "Protocol error; make sure to use the correct version of emacsclient"))
-		    (let ((frame (make-frame-on-tty tty type)))
-		      (push (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
-			    dontkill t
-			    newframe t))))
+		    (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))))
+		    (select-frame frame)
+		    (server-client-set client 'frame frame)
+		    (server-client-set client 'tty (frame-tty-name frame))
+		    ;; Reply with our pid.
+		    (process-send-string proc (concat "-emacs-pid " (number-to-string (emacs-pid)) "\n"))
+		    (setq dontkill t)))
 
-		 ;; ARG is a line number option.
+		 ;; -position LINE:  Go to the given line in the next file.
 		 ((and (equal "-position" arg) (string-match "\\(\\+[0-9]+\\) " request))
 		  (setq request (substring request (match-end 0))
 			lineno (string-to-int (substring (match-string 1 request) 1))))
 
-		 ;; ARG is line number:column option.
+		 ;; -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))))
 
-		 ;; ARG is a file to load.
+		 ;; -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)))
@@ -500,14 +531,14 @@
 		  (setq lineno 1
 			columnno 0))
 
-		 ;; ARG is a Lisp expression.
+		 ;; -eval EXPR:  Evaluate a Lisp expression.
 		 ((and (equal "-eval" arg) (string-match "\\([^ ]+\\) " request))
 		  (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)))
 		    (let ((v (eval (car (read-from-string expr)))))
-		      (when (and (not newframe) v)
+		      (when (and (not frame) v)
 			(with-temp-buffer
 			  (let ((standard-output (current-buffer)))
 			    (pp v)
@@ -520,6 +551,19 @@
 		    (setq lineno 1
 			  columnno 0)))
 
+		 ;; -env NAME VALUE:  An environment variable.
+		 ((and (equal "-env" arg) (string-match "\\([^ ]+\\) \\([^ ]+\\) " request))
+		  (let ((name (server-unquote-arg (match-string 1 request)))
+			(value (server-unquote-arg (match-string 2 request))))
+		    (when coding-system
+			(setq name (decode-coding-string name coding-system))
+			(setq value (decode-coding-string value coding-system)))
+		    (setq request (substring request (match-end 0)))
+		    (server-client-set
+		     client 'environment
+		     (cons (cons name value)
+			   (server-client-get client 'environment)))))
+
 		 ;; Unknown command.
 		 (t (error "Unknown command: %s" arg)))))
 
@@ -528,34 +572,33 @@
 	      (server-visit-files files client nowait)
 	      (run-hooks 'post-command-hook))
 
-	    ;; CLIENT is now a list (CLIENTNUM BUFFERS...)
-
 	    ;; Delete the client if necessary.
 	    (cond
-	     ;; Client requested nowait; return immediately.
 	     (nowait
-	      (delete-process proc)
-	      (server-log "Close nowait client" proc))
-	     ;; This client is empty; get rid of it immediately.
-	     ((and (not dontkill) (null (cdr client)))
-	      (delete-process proc)
-	      (server-log "Close empty client" proc))
-	     ((not registered)
-	      (push client server-clients)))
-
-	    ;; We visited some buffer for this client.
-	    (cond
-	     ((or isearch-mode (minibufferp))
-	      nil)
-	     ((and newframe (null (cdr client)))
-	      (message (substitute-command-keys
-			"When done with this frame, type \\[delete-frame]")))
-	     ((not (null (cdr client)))
-	      (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]")))))))
+	      ;; 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]")))))))))))
 
 	;; Save for later any partial line that remains.
 	(when (> (length string) 0)
@@ -599,8 +642,7 @@
 			   (revert-buffer t nil)))
 		      (t
 		       (if (y-or-n-p
-			    (concat "File no longer exists: "
-				    filen
+			    (concat "File no longer exists: " filen
 				    ", write buffer to file? "))
 			   (write-file filen))))
 		(setq server-existing-buffer t)
@@ -613,7 +655,9 @@
 	  (add-hook 'kill-buffer-hook 'server-kill-buffer nil t)
 	  (push (car client) server-buffer-clients))
 	(push (current-buffer) client-record)))
-    (nconc client client-record)))
+    (server-client-set
+     client 'buffers
+     (nconc (server-client-get client 'buffers) client-record))))
 
 (defun server-buffer-done (buffer &optional for-killing)
   "Mark BUFFER as \"done\" for its client(s).
@@ -623,35 +667,24 @@
 a temp file).
 FOR-KILLING if non-nil indicates that we are called from `kill-buffer'."
   (let ((next-buffer nil)
-	(killed nil)
-	(old-clients server-clients))
-    (while old-clients
-      (let ((client (car old-clients)))
+	(killed nil))
+    (dolist (client server-clients)
+      (let ((buffers (server-client-get client 'buffers)))
 	(or next-buffer
-	    (setq next-buffer (nth 1 (memq buffer client))))
-	(delq buffer client)
-	;; Delete all dead buffers from CLIENT.
-	(let ((tail client))
-	  (while tail
-	    (and (bufferp (car tail))
-		 (null (buffer-name (car tail)))
-		 (delq (car tail) client))
-	    (setq tail (cdr tail))))
-	;; If client now has no pending buffers,
-	;; tell it that it is done, and forget it entirely.
-	(unless (cdr client)
-	  (let ((tty (cadr (assq (car client) server-ttys)))
-		(frame (cadr (assq (car client) server-frames))))
-	    (cond
-	     ;; Be careful, if we delete the process before the
-	     ;; tty, then the terminal modes will not be restored
-	     ;; correctly.
-	     (tty (delete-tty tty))
-	     (frame (delete-frame frame))
-	     (t (delete-process (car client))
-		(server-log "Close" (car client))
-		(setq server-clients (delq client server-clients)))))))
-      (setq old-clients (cdr old-clients)))
+	    (setq next-buffer (nth 1 (memq buffer buffers))))
+	(when buffers			; Ignore bufferless clients.
+	  (setq buffers (delq buffer buffers))
+	  ;; Delete all dead buffers from CLIENT.
+	  (dolist (b buffers)
+	    (and (bufferp b)
+		 (not (buffer-live-p b))
+		 (setq buffers (delq b buffers))))
+	  (server-client-set client 'buffers buffers)
+	  ;; If client now has no pending buffers,
+	  ;; tell it that it is done, and forget it entirely.
+	  (unless buffers
+	    (server-log "Close" client)
+	    (server-delete-client client)))))
     (if (and (bufferp buffer) (buffer-name buffer))
 	;; We may or may not kill this buffer;
 	;; if we do, do not call server-buffer-done recursively
@@ -716,30 +749,25 @@
 ;; but I think that is dangerous--the client would proceed
 ;; using whatever is on disk in that file. -- rms.
 (defun server-kill-buffer-query-function ()
+  "Ask before killing a server buffer."
   (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))))
+	  (let ((client (server-client proc)))
+	    (when (and client (eq (process-status proc) 'open))
+	      (setq res nil)))))
       (yes-or-no-p (format "Buffer `%s' still has clients; kill it? "
 			   (buffer-name (current-buffer))))))
 
-(add-hook 'kill-buffer-query-functions
- 	  'server-kill-buffer-query-function)
-
 (defun server-kill-emacs-query-function ()
-  (let (live-client
-	(tail server-clients))
-    ;; See if any clients have any buffers that are still alive.
-    (while tail
-      (if (memq t (mapcar 'stringp (mapcar 'buffer-name (cdr (car tail)))))
-	  (setq live-client t))
-      (setq tail (cdr tail)))
-    (or (not live-client)
-	(yes-or-no-p "Server buffers still have clients; exit anyway? "))))
-
-(add-hook 'kill-emacs-query-functions 'server-kill-emacs-query-function)
+  "Ask before exiting Emacs it has are live clients."
+  (or (not server-clients)
+      (let (live-client)
+	(dolist (client server-clients live-client)
+	  (if (memq t (mapcar 'buffer-live-p (server-client-get
+					      client 'buffers)))
+	      (setq live-client t))))
+      (yes-or-no-p "This Emacs session has clients; exit anyway? ")))
 
 (defvar server-kill-buffer-running nil
   "Non-nil while `server-kill-buffer' or `server-buffer-done' is running.")
@@ -782,13 +810,19 @@
   ;; This means we should avoid the final "switch to some other buffer"
   ;; since we've already effectively done that.
   (if (null next-buffer)
-      (if server-clients
-	  (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))
+      (progn
+	(let ((rest server-clients))
+	  (while (and rest (not next-buffer))
+	    (let ((client (car rest)))
+	      ;; Only look at frameless clients.
+	      (when (not (server-client-get client 'frame))
+		(setq next-buffer (car (server-client-get client 'buffers))))
+	      (setq rest (cdr rest)))))
+	(and next-buffer (server-switch-buffer next-buffer killed-one))
+	(unless (or next-buffer killed-one (window-dedicated-p (selected-window)))
+	  ;; (switch-to-buffer (other-buffer))
 	  (message "No server buffers remain to edit")))
-    (if (not (buffer-name next-buffer))
+    (if (not (buffer-live-p next-buffer))
 	;; If NEXT-BUFFER is a dead buffer, remove the server records for it
 	;; and try the next surviving server buffer.
 	(apply 'server-switch-buffer (server-buffer-done next-buffer))
@@ -832,6 +866,9 @@
 
 (defun server-unload-hook ()
   (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))