Set `default-directory' in *scratch* to the current directory of emacsclient.

* lib-src/emacsclient.c (get_current_dir_name): New function, copied here
  from sysdep.c.
  (main): Use it to send over the current directory.

* lisp/server.el (server-process-filter): Accept `-dir' command.  Set
  `default-directory' of the *scratch* buffer on connect, if applicable.

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

diff --git a/README.multi-tty b/README.multi-tty
index 442c4c92fd2ae6d00464857109f7724ad04074d2..f3061c921d06964819ccb8198299d4a274602320 100644 (file)
--- a/README.multi-tty
+++ b/README.multi-tty
@@ -1487,5 +1487,12 @@ DIARY OF CHANGES
 
    (Done in patch-537.)
 
+-- The `default-directory' variable should somehow be set to the
+   cwd of the emacsclient process when the user runs emacsclient
+   without file arguments.  Perhaps it is OK to just override the
+   directory of the *scratch* buffer.
+
+   (Done in patch-539.)
+
 ;;; arch-tag: 8da1619e-2e79-41a8-9ac9-a0485daad17d
 

diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c
index 42c90934b4bcc0b01265cf0c4fb61fa8c69da8ef..b538b0093afa43e963340f3d7d6f0f04b384db14 100644 (file)
--- a/lib-src/emacsclient.c
+++ b/lib-src/emacsclient.c
@@ -248,6 +248,83 @@ xstrdup (const char *s)
   return result;
 }
 
+/* From sysdep.c */
+#if !defined (HAVE_GET_CURRENT_DIR_NAME) || defined (BROKEN_GET_CURRENT_DIR_NAME)
+
+/* Return the current working directory.  Returns NULL on errors.
+   Any other returned value must be freed with free. This is used
+   only when get_current_dir_name is not defined on the system.  */
+char*
+get_current_dir_name ()
+{
+  char *buf;
+  char *pwd;
+  struct stat dotstat, pwdstat;
+  /* If PWD is accurate, use it instead of calling getwd.  PWD is
+     sometimes a nicer name, and using it may avoid a fatal error if a
+     parent directory is searchable but not readable.  */
+    if ((pwd = getenv ("PWD")) != 0
+      && (IS_DIRECTORY_SEP (*pwd) || (*pwd && IS_DEVICE_SEP (pwd[1])))
+      && stat (pwd, &pwdstat) == 0
+      && stat (".", &dotstat) == 0
+      && dotstat.st_ino == pwdstat.st_ino
+      && dotstat.st_dev == pwdstat.st_dev
+#ifdef MAXPATHLEN
+      && strlen (pwd) < MAXPATHLEN
+#endif
+      )
+    {
+      buf = (char *) malloc (strlen (pwd) + 1);
+      if (!buf)
+        return NULL;
+      strcpy (buf, pwd);
+    }
+#ifdef HAVE_GETCWD
+  else
+    {
+      size_t buf_size = 1024;
+      buf = (char *) malloc (buf_size);
+      if (!buf)
+        return NULL;
+      for (;;)
+        {
+          if (getcwd (buf, buf_size) == buf)
+            break;
+          if (errno != ERANGE)
+            {
+              int tmp_errno = errno;
+              free (buf);
+              errno = tmp_errno;
+              return NULL;
+            }
+          buf_size *= 2;
+          buf = (char *) realloc (buf, buf_size);
+          if (!buf)
+            return NULL;
+        }
+    }
+#else
+  else
+    {
+      /* We need MAXPATHLEN here.  */
+      buf = (char *) malloc (MAXPATHLEN + 1);
+      if (!buf)
+        return NULL;
+      if (getwd (buf) == NULL)
+        {
+          int tmp_errno = errno;
+          free (buf);
+          errno = tmp_errno;
+          return NULL;
+        }
+    }
+#endif
+  return buf;
+}
+#endif
+
+
+\f
 /* 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.
@@ -709,6 +786,20 @@ To start the server in Emacs, type \"M-x server-start\".\n",
         }
     }
 
+  /* Send over our current directory. */
+  if (!current_frame)
+    {
+      char *dir = get_current_dir_name ();
+      if (dir)
+        {
+          fprintf (out, "-dir ");          
+          quote_argument (dir, out);
+          fprintf (out, "/");
+          fprintf (out, " ");
+          free (dir);
+        }
+    }
+
  retry:
   if (nowait)
     fprintf (out, "-nowait ");

diff --git a/lisp/server.el b/lisp/server.el
index 86dd9a8e46950cfd15f2bcef8a5702dbf5183078..015c4c6f1712f9bb9b23c05e8f6fb1723db9af3e 100644 (file)
--- a/lisp/server.el
+++ b/lisp/server.el
@@ -493,6 +493,9 @@ The following commands are accepted by the server:
 `-env NAME=VALUE'
   An environment variable on the client side.
 
+`-dir DIRNAME'
+  The current working directory of the client process.
+
 `-current-frame'
   Forbid the creation of new frames.
 
@@ -520,16 +523,16 @@ The following commands are accepted by the server:
 `-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.
 
+`-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.
+
 `-ignore COMMENT'
   Do nothing, but put the comment in the server
   log.  Useful for debugging.
@@ -581,6 +584,7 @@ The following commands are accepted by the client:
                display              ; Open the frame on this display.
                dontkill       ; t if the client should not be killed.
                env
+               dir
                (files nil)
                (lineno 1)
                (columnno 0))
@@ -650,6 +654,7 @@ The following commands are accepted by the client:
 
                          ;; Display *scratch* by default.
                          (switch-to-buffer (get-buffer-create "*scratch*") 'norecord)
+                         (if dir (setq default-directory dir))
 
                          (setq dontkill t))
                      ;; This emacs does not support X.
@@ -706,6 +711,7 @@ The following commands are accepted by the client:
 
                      ;; Display *scratch* by default.
                      (switch-to-buffer (get-buffer-create "*scratch*") 'norecord)
+                     (if dir (setq default-directory dir))
 
                      ;; Reply with our pid.
                      (server-send-string proc (concat "-emacs-pid " (number-to-string (emacs-pid)) "\n"))
@@ -760,6 +766,14 @@ The following commands are accepted by the client:
                    (setq request (substring request (match-end 0)))
                    (setq env (cons var env))))
 
+                ;; -dir DIRNAME:  The cwd of the emacsclient process.
+                ((and (equal "-dir" arg) (string-match "\\([^ ]+\\) " request))
+                 (setq dir (server-unquote-arg (match-string 1 request)))
+                 (setq request (substring request (match-end 0)))
+                 (if coding-system
+                     (setq dir (decode-coding-string dir coding-system)))
+                 (setq dir (command-line-normalize-file-name dir)))
+
                 ;; Unknown command.
                 (t (error "Unknown command: %s" arg)))))