Merge from emacs--devo--0

[gnu-emacs] / lisp / server.el

diff --git a/lisp/server.el b/lisp/server.el
index 7a4179e85f61b02bcf7cffb79ee0b6a3833c9deb..a9907f9d3a34e6e61cfa367a3e10760a7fad9b4c 100644 (file)
--- a/lisp/server.el
+++ b/lisp/server.el
@@ -1,7 +1,7 @@
 ;;; server.el --- Lisp code for GNU Emacs running as server process
 
 ;; Copyright (C) 1986, 1987, 1992, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
-;;   2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
+;;   2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
 
 ;; Author: William Sommerfeld <wesommer@athena.mit.edu>
 ;; Maintainer: FSF
@@ -14,7 +14,7 @@
 
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
 ;; any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
@@ -106,7 +106,7 @@ If set, the server accepts remote connections; otherwise it is local."
   :version "22.1")
 (put 'server-host 'risky-local-variable t)
 
-(defcustom server-auth-dir "~/.emacs.d/server/"
+(defcustom server-auth-dir (concat user-emacs-directory "server/")
   "Directory for server authentication files."
   :group 'server
   :type 'directory
@@ -268,19 +268,21 @@ The environment variables are then restored to their previous values.
 VARS should be a list of strings.
 ENV should be in the same format as `process-environment'."
   (declare (indent 2))
-  (let ((oldvalues (make-symbol "oldvalues"))
+  (let ((old-env (make-symbol "old-env"))
        (var (make-symbol "var"))
        (value (make-symbol "value"))
        (pair (make-symbol "pair")))
-    `(let (,oldvalues)
+    `(let ((,old-env process-environment))
        (dolist (,var ,vars)
         (let ((,value (server-getenv-from ,env ,var)))
-          (setq ,oldvalues (cons (cons ,var (getenv ,var)) ,oldvalues))
-          (setenv ,var ,value)))
+          (setq process-environment
+                (cons (if (null ,value)
+                          ,var
+                        (concat ,var "=" ,value))
+                      process-environment))))
        (unwind-protect
           (progn ,@body)
-        (dolist (,pair ,oldvalues)
-          (setenv (car ,pair) (cdr ,pair)))))))
+        (setq process-environment ,old-env)))))
 
 (defun server-delete-client (client &optional noframe)
   "Delete CLIENT, including its buffers, terminals and frames.
@@ -435,7 +437,7 @@ Creates the directory if necessary and makes sure:
       (letf (((default-file-modes) ?\700)) (make-directory dir t))
       (setq attrs (file-attributes dir)))
     ;; Check that it's safe for use.
-    (unless (and (eq t (car attrs)) (eq (nth 2 attrs) (user-uid))
+    (unless (and (eq t (car attrs)) (eql (nth 2 attrs) (user-uid))
                  (or (eq system-type 'windows-nt)
                      (zerop (logand ?\077 (file-modes dir)))))
       (error "The directory %s is unsafe" dir))))
@@ -448,8 +450,8 @@ client \"editors\" can send your editing commands to this Emacs
 job.  To use the server, set up the program `emacsclient' in the
 Emacs distribution as your standard \"editor\".
 
-Prefix arg LEAVE-DEAD means just kill any existing server
-communications subprocess."
+Optional argument LEAVE-DEAD (interactively, a prefix arg) means just
+kill any existing server communications subprocess."
   (interactive "P")
   (when (or
         (not server-clients)
@@ -562,7 +564,7 @@ The following commands are accepted by the server:
 
 `-auth AUTH-STRING'
   Authenticate the client using the secret authentication string
-  AUTH_STRING.
+  AUTH-STRING.
 
 `-version CLIENT-VERSION'
   Check version numbers between server and client, and signal an
@@ -666,6 +668,16 @@ The following commands are accepted by the client:
     (run-with-timer 0 nil (lexical-let ((proc proc))
                            (lambda () (server-process-filter proc ""))))
     (top-level))
+  (condition-case nil
+      ;; If we're running isearch, we must abort it to allow Emacs to
+      ;; display the buffer and switch to it.
+      (mapc #'(lambda (buffer)
+               (with-current-buffer buffer
+                 (when (bound-and-true-p isearch-mode)
+                   (isearch-cancel))))
+           (buffer-list))
+    ;; Signaled by isearch-cancel
+    (quit (message nil)))
   (let ((prev (process-get proc 'previous-string)))
     (when prev
       (setq string (concat prev string))
@@ -751,13 +763,16 @@ The following commands are accepted by the client:
                          ;; initialization parameters for X frames at
                          ;; the moment.
                          (modify-frame-parameters frame params)
+                         (set-frame-parameter frame 'display-environment-variable 
+                                              (server-getenv-from env "DISPLAY"))
+                         (set-frame-parameter frame 'term-environment-variable 
+                                              (server-getenv-from env "TERM"))
                          (select-frame frame)
                          (server-client-set client 'frame frame)
                          (server-client-set client 'terminal (frame-terminal frame))
 
                          ;; 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.
@@ -801,12 +816,19 @@ The following commands are accepted by the client:
                            "BAUDRATE" "COLUMNS" "ESCDELAY" "HOME" "LINES"
                            "NCURSES_ASSUMED_COLORS" "NCURSES_NO_PADDING"
                            "NCURSES_NO_SETBUF" "TERM" "TERMCAP" "TERMINFO"
-                           "TERMINFO_DIRS" "TERMPATH")
+                           "TERMINFO_DIRS" "TERMPATH" 
+                           ;; rxvt wants these
+                           "COLORFGBG" "COLORTERM")
                        (setq frame (make-frame-on-tty tty type
                                                       ;; Ignore nowait here; we always need to clean
                                                       ;; up opened ttys when the client dies.
                                                       `((client . ,proc)
                                                         (environment . ,env)))))
+             
+                     (set-frame-parameter frame 'display-environment-variable 
+                                          (server-getenv-from env "DISPLAY"))
+                     (set-frame-parameter frame 'term-environment-variable 
+                                          (server-getenv-from env "TERM"))
                      (select-frame frame)
                      (server-client-set client 'frame frame)
                      (server-client-set client 'tty (terminal-name frame))
@@ -814,7 +836,6 @@ 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"))
@@ -1173,8 +1194,7 @@ done that."
                 (select-window win)
                 (set-buffer next-buffer))
            ;; Otherwise, let's find an appropriate window.
-           (cond ((and (windowp server-window)
-                       (window-live-p server-window))
+           (cond ((window-live-p server-window)
                   (select-window server-window))
                  ((framep server-window)
                   (unless (frame-live-p server-window)