Added -w option to emacsclient for opening a new X frame.

lib-src/emacsclient.c (window_system): New variable.
(frame): Renamed to tty for consistency with the option name.
(longopts, print_help_and_exit): Added -w option. (Suggested by Ami
Fischman <ami at fischman dot org>.
(decode_options): Initialize display to $DISPLAY.  Handle -w option.
(main): Implement the -w option.  Changed to a more elaborate protocol
between Emacs and emacsclient, in preparation to suspend support.

lisp/server.el (server-frames): New variable.
(server-handle-delete-frame): New function.
(server-start): Add it to delete-frame-functions.
(server-select-display): Don't make the new frame invisible.
(server-with-errors-reported): New macro for brevity.
(server-process-filter): Implement the "-window-system" command.
Use server-with-errors-reported.  Fixed regexp for +line:column syntax.
Use the new protocol.

git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-83

2 files changed, 138 insertions, 71 deletions

diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c
index 771eeac05e6..90224fe51ee 100644
--- a/lib-src/emacsclient.c
+++ b/lib-src/emacsclient.c
@@ -70,11 +70,14 @@ int nowait = 0;
 /* Nonzero means args are expressions to be evaluated.  --eval.  */
 int eval = 0;
 
+/* Nonzero means open a new graphical frame. */
+int window_system = 0;
+
 /* The display on which Emacs should work.  --display.  */
 char *display = NULL;
 
 /* Nonzero means open a new Emacs frame on the current terminal. */
-int frame = 0;
+int tty = 0;
 
 /* If non-NULL, the name of an editor to fallback to if the server
    is not running.  --alternate-editor.   */
@@ -92,6 +95,7 @@ struct option longopts[] =
   { "help",     no_argument,       NULL, 'H' },
   { "version",  no_argument,       NULL, 'V' },
   { "tty",      no_argument,       NULL, 't' },
+  { "window-system", no_argument,  NULL, 'w' },
   { "alternate-editor", required_argument, NULL, 'a' },
   { "socket-name",      required_argument, NULL, 's' },
   { "display",  required_argument, NULL, 'd' },
@@ -107,11 +111,12 @@ decode_options (argc, argv)
      char **argv;
 {
   alternate_editor = getenv ("ALTERNATE_EDITOR");
+  display = getenv ("DISPLAY");
 
   while (1)
     {
       int opt = getopt_long (argc, argv,
-                             "VHnea:s:d:t", longopts, 0);
+                             "VHnea:s:d:tw", longopts, 0);
 
       if (opt == EOF)
         break;
@@ -149,7 +154,13 @@ decode_options (argc, argv)
           break;
 
         case 't':
-          frame = 1;
+          tty = 1;
+          window_system = 0;
+          break;
+
+        case 'w':
+          window_system = 1;
+          tty = 0;
           break;
           
         case 'H':
@@ -163,11 +174,10 @@ decode_options (argc, argv)
         }
     }
 
-  if (frame) {
+  if (tty) {
     nowait = 0;
     display = 0;
   }
-  
 }
 
 void
@@ -182,6 +192,7 @@ The following OPTIONS are accepted:\n\
 -V, --version           Just print a version info and return\n\
 -H, --help              Print this usage information message\n\
 -t, --tty               Open a new Emacs frame on the current terminal\n\
+-w, --window-system     Open a new graphical Emacs frame\n\
 -n, --no-wait           Don't wait for the server to return\n\
 -e, --eval              Evaluate the FILE arguments as ELisp expressions\n\
 -d, --display=DISPLAY   Visit the file in the given display\n\
@@ -272,16 +283,6 @@ fail (void)
 
 int emacs_pid;
 
-#ifdef nec_ews_svr4
-extern char *_sobuf ;
-#else
-#if defined (USG) || defined (DGUX)
-unsigned char _sobuf[BUFSIZ+8];
-#else
-char _sobuf[BUFSIZ];
-#endif
-#endif
-
 /* A signal handler that passes the signal to the Emacs process.
    Useful for SIGWINCH.  */
 
@@ -395,7 +396,7 @@ main (argc, argv)
   /* Process options.  */
   decode_options (argc, argv);
 
-  if ((argc - optind < 1) && !eval && !frame)
+  if ((argc - optind < 1) && !eval && !tty && !window_system)
     {
       fprintf (stderr, "%s: file name or argument required\n", progname);
       fprintf (stderr, "Try `%s --help' for more information\n", progname);
@@ -574,7 +575,7 @@ To start the server in Emacs, type \"M-x server-start\".\n",
       fprintf (out, " ");
     }
 
-  if (frame)
+  if (tty)
     {
       char *tty_name = ttyname (fileno (stdin));
       if (! tty_name)
@@ -588,6 +589,9 @@ To start the server in Emacs, type \"M-x server-start\".\n",
       quote_file_name (getenv("TERM"), out);
       fprintf (out, " ");
     }
+
+  if (window_system)
+    fprintf (out, "-window-system ");
   
   if ((argc - optind > 0))
     {
@@ -617,7 +621,7 @@ To start the server in Emacs, type \"M-x server-start\".\n",
     }
   else
     {
-      if (!frame)
+      if (!tty && !window_system)
         {
           while ((str = fgets (string, BUFSIZ, stdin)))
             {
@@ -636,7 +640,7 @@ To start the server in Emacs, type \"M-x server-start\".\n",
       return 0;
     }
 
-  if (!eval && !frame)
+  if (!eval && !tty)
     {
       printf ("Waiting for Emacs...");
       needlf = 2;
@@ -646,18 +650,29 @@ To start the server in Emacs, type \"M-x server-start\".\n",
   /* Now, wait for an answer and print any messages.  */
   while ((str = fgets (string, BUFSIZ, in)))
     {
-      if (frame)
+      if (strprefix ("-emacs-pid ", str))
         {
-          if (strprefix ("emacs-pid ", str))
-            {
-              emacs_pid = strtol (string + strlen ("emacs-pid"), NULL, 10);
-            }
+          emacs_pid = strtol (string + strlen ("-emacs-pid"), NULL, 10);
+        }
+      else if (strprefix ("-print ", str))
+        {
+          if (needlf == 2)
+            printf ("\n");
+          printf ("%s", str + strlen ("-print "));
+          needlf = str[0] == '\0' ? needlf : str[strlen (str) - 1] != '\n';         
+        }
+      else if (strprefix ("-error ", str))
+        {
+          if (needlf == 2)
+            printf ("\n");
+          printf ("*ERROR*: %s", str + strlen ("-print "));
+          needlf = str[0] == '\0' ? needlf : str[strlen (str) - 1] != '\n';         
         }
       else
         {
           if (needlf == 2)
             printf ("\n");
-          printf ("%s", str);
+          printf ("*ERROR*: Unknown message: %s", str);
           needlf = str[0] == '\0' ? needlf : str[strlen (str) - 1] != '\n';
         }
     }
diff --git a/lisp/server.el b/lisp/server.el
index 6d59b0d69c7..82f4ec26606 100644
--- a/lisp/server.el
+++ b/lisp/server.el
@@ -111,8 +111,18 @@ When a buffer is marked as \"done\", it is removed from this list.")
 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.")
+
+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.")
 
 (defvar server-buffer-clients nil
   "List of client ids for clients requesting editing of current buffer.")
@@ -211,7 +221,7 @@ are done with it in the server.")
   (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."
+  "Delete the client connection when the emacsclient terminal device is closed."
   (dolist (entry server-ttys)
     (let ((proc (nth 0 entry))
           (term (nth 1 entry)))
@@ -224,6 +234,20 @@ are done with it in the server.")
             ;; `emacsclient -t -e '(delete-frame)'' correctly.
             (setq server-clients (delq client server-clients))))))))
 
+(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)))
+          (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))))))))
+
 (defun server-select-display (display)
   ;; If the current frame is on `display' we're all set.
   (unless (equal (frame-parameter (selected-frame) 'display) display)
@@ -235,14 +259,14 @@ are done with it in the server.")
     ;; and select it.
     (unless (equal (frame-parameter (selected-frame) 'display) display)
       (select-frame
-       (make-frame-on-display
-        display
+       (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).
-        '((visibility . nil) (minibuffer . only)))))))
+        ;; XXX I have found this behaviour to be surprising and annoying. -- Lorentey
+        ;; '((visibility . nil) (minibuffer . only)))))))
 
 (defun server-unquote-arg (arg)
   (replace-regexp-in-string
@@ -301,6 +325,7 @@ Prefix arg means just kill any existing server communications subprocess."
         (server-log (message "Restarting server")))
     (letf (((default-file-modes) ?\700))
       (add-to-list 'delete-tty-after-functions 'server-handle-delete-tty)
+      (add-to-list 'delete-frame-functions 'server-handle-delete-frame)
       (setq server-process
             (make-network-process
              :name "server" :family 'local :server t :noquery t
@@ -324,6 +349,17 @@ Server mode runs a process that accepts commands from the
   ;; nothing if there is one (for multiple Emacs sessions)?
   (server-start (not server-mode)))
 
+(defmacro server-with-errors-reported (&rest forms)
+  "Evaluate FORMS; if an error occurs, report it to the client
+and return nil.  Otherwise, return the result of the last form.
+For use in server-process-filter only."
+  `(condition-case err
+       (progn ,@forms)
+     (error (ignore-errors
+              (process-send-string
+               proc (concat "-error " (error-message-string err)))
+              (setq request "")))))
+
 (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\"."
@@ -339,7 +375,7 @@ PROC is the server process.  Format of STRING is \"PATH PATH PATH... \\n\"."
           (coding-system (and default-enable-multibyte-characters
                               (or file-name-coding-system
                                   default-file-name-coding-system)))
-          client nowait eval newframe
+          client nowait eval newframe display
           registered    ; t if the client is already added to server-clients.
           (files nil)
           (lineno 1)
@@ -353,37 +389,53 @@ PROC is the server process.  Format of STRING is \"PATH PATH PATH... \\n\"."
           (cond
            ((equal "-nowait" arg) (setq nowait t))
            ((equal "-eval" arg) (setq eval t))
+
            ((and (equal "-display" arg) (string-match "\\([^ ]*\\) " request))
-            (let ((display (server-unquote-arg (match-string 1 request))))
-              (setq request (substring request (match-end 0)))
-              (condition-case err
-                  (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.
+            (setq display (match-string 1 request)
+                  request (substring request (match-end 0))))
+
+           ;; Open a new X frame.
+           ((equal "-window-system" arg)
+            (server-with-errors-reported
+             (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))))
+
+           ;; Open a new tty 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 "")))))
+              (server-with-errors-reported
+               (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
+                       newframe t)))))
+
            ;; ARG is a line number option.
            ((string-match "\\`\\+[0-9]+\\'" arg)
             (setq lineno (string-to-int (substring arg 1))))
+
            ;; 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))
                   columnno (string-to-int (match-string 2 arg))))
+
+           ;; ARG is a filename or a Lisp expression.
            (t
+
             ;; Undo the quoting that emacsclient does
             ;; for certain special characters.
             (setq arg (server-unquote-arg arg))
@@ -391,17 +443,14 @@ PROC is the server process.  Format of STRING is \"PATH PATH PATH... \\n\"."
             (if coding-system
                 (setq arg (decode-coding-string arg coding-system)))
             (if eval
-                (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))))))
+                (server-with-errors-reported
+                 (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-string proc "-print ")
+                         (process-send-region proc (point-min) (point-max)))))))
 
               ;; ARG is a file name.
               ;; Collapse multiple slashes to single slashes.
@@ -409,6 +458,7 @@ PROC is the server process.  Format of STRING is \"PATH PATH PATH... \\n\"."
               (push (list arg lineno columnno) files))
             (setq lineno 1)
             (setq columnno 0)))))
+
       (when files
         (run-hooks 'pre-command-hook)
         (server-visit-files files client nowait)
@@ -506,15 +556,17 @@ FOR-KILLING if non-nil indicates that we are called from `kill-buffer'."
         ;; If client now has no pending buffers,
         ;; tell it that it is done, and forget it entirely.
         (unless (cdr client)
-          (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))))))
+          (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)))
     (if (and (bufferp buffer) (buffer-name buffer))
         ;; We may or may not kill this buffer;