* server.el (server-process-filter): Use expand-file-name rather than
[bpt/emacs.git] / lisp / server.el
index 6dc84be..10b08ad 100644 (file)
@@ -200,8 +200,16 @@ This means that the server should not kill the buffer when you say you
 are done with it in the server.")
 (make-variable-buffer-local 'server-existing-buffer)
 
-(defvar server-name "server")
+(defcustom server-name "server"
+  "The name of the Emacs server, if this Emacs process creates one.
+The command `server-start' makes use of this.  It should not be
+changed while a server is running."
+  :group 'server
+  :type 'string
+  :version "23.1")
 
+;; We do not use `temporary-file-directory' here, because emacsclient
+;; does not read the init file.
 (defvar server-socket-dir
   (and (featurep 'make-network-process '(:family local))
        (format "%s/emacs%d" (or (getenv "TMPDIR") "/tmp") (user-uid)))
@@ -232,9 +240,9 @@ ENV should be in the same format as `process-environment'."
     `(let ((process-environment process-environment))
        (dolist (,var ,vars)
          (let ((,value (getenv-internal ,var ,env)))
-           (push (if (null ,value)
-                     ,var
-                   (concat ,var "=" ,value))
+           (push (if (stringp ,value)
+                     (concat ,var "=" ,value)
+                   ,var)
                  process-environment)))
        (progn ,@body))))
 
@@ -465,10 +473,16 @@ If a server is already running, the server is not started.
 To force-start a server, do \\[server-force-delete] and then
 \\[server-start]."
   (interactive "P")
-  (when (or
-        (not server-clients)
-        (yes-or-no-p
-         "The current server still has clients; delete them? "))
+  (when (or (not server-clients)
+           ;; Ask the user before deleting existing clients---except
+           ;; when we can't get user input, which may happen when
+           ;; doing emacsclient --eval "(kill-emacs)" in daemon mode.
+           (if (and (daemonp)
+                    (null (cdr (frame-list)))
+                    (eq (selected-frame) terminal-frame))
+               leave-dead
+             (yes-or-no-p
+              "The current server still has clients; delete them? ")))
     (let* ((server-dir (if server-use-tcp server-auth-dir server-socket-dir))
           (server-file (expand-file-name server-name server-dir)))
       (when server-process
@@ -479,9 +493,14 @@ To force-start a server, do \\[server-force-delete] and then
          ;; Remove any leftover socket or authentication file
          (ignore-errors (delete-file server-file))
        (setq server-mode nil) ;; already set by the minor mode code
-       (display-warning 'server
-                        (format "Emacs server named %S already running" server-name)
-                        :warning)
+       (display-warning
+        'server
+        (concat "Unable to start the Emacs server.\n"
+                (format "There is an existing Emacs server, named %S.\n"
+                        server-name)
+                "To start the server in this Emacs process, stop the existing
+server or call `M-x server-force-delete' to forcibly disconnect it.")
+        :warning)
        (setq leave-dead t))
       ;; If this Emacs already had a server, clear out associated status.
       (while server-clients
@@ -576,7 +595,7 @@ Return values:
            (insert-file-contents-literally (expand-file-name name server-auth-dir))
            (or (and (looking-at "127\\.0\\.0\\.1:[0-9]+ \\([0-9]+\\)")
                     (assq 'comm
-                          (system-process-attributes
+                          (process-attributes
                            (string-to-number (match-string 1))))
                     t)
                :other))
@@ -614,6 +633,10 @@ Server mode runs a process that accepts commands from the
                           (server-quote-arg text)))))))))
 
 (defun server-create-tty-frame (tty type proc)
+  (unless tty
+    (error "Invalid terminal device"))
+  (unless type
+    (error "Invalid terminal type"))
   (add-to-list 'frame-inherited-parameters 'client)
   (let ((frame
          (server-with-environment (process-get proc 'env)
@@ -625,21 +648,23 @@ Server mode runs a process that accepts commands from the
                "TERMINFO_DIRS" "TERMPATH"
                ;; rxvt wants these
                "COLORFGBG" "COLORTERM")
-           (make-frame-on-tty tty type
-                              ;; Ignore nowait here; we always need to
-                              ;; clean up opened ttys when the client dies.
-                              `((client . ,proc)
-                                ;; This is a leftover from an earlier
-                                ;; attempt at making it possible for process
-                                ;; run in the server process to use the
-                                ;; environment of the client process.
-                                ;; It has no effect now and to make it work
-                                ;; we'd need to decide how to make
-                                ;; process-environment interact with client
-                                ;; envvars, and then to change the
-                                ;; C functions `child_setup' and
-                                ;; `getenv_internal' accordingly.
-                                (environment . ,(process-get proc 'env)))))))
+            (make-frame `((window-system . nil)
+                          (tty . ,tty)
+                          (tty-type . ,type)
+                          ;; Ignore nowait here; we always need to
+                          ;; clean up opened ttys when the client dies.
+                          (client . ,proc)
+                          ;; This is a leftover from an earlier
+                          ;; attempt at making it possible for process
+                          ;; run in the server process to use the
+                          ;; environment of the client process.
+                          ;; It has no effect now and to make it work
+                          ;; we'd need to decide how to make
+                          ;; process-environment interact with client
+                          ;; envvars, and then to change the
+                          ;; C functions `child_setup' and
+                          ;; `getenv_internal' accordingly.
+                          (environment . ,(process-get proc 'env)))))))
 
     ;; ttys don't use the `display' parameter, but callproc.c does to set
     ;; the DISPLAY environment on subprocesses.
@@ -937,7 +962,7 @@ The following commands are accepted by the client:
                  (let ((file (pop command-line-args-left)))
                    (if coding-system
                        (setq file (decode-coding-string file coding-system)))
-                   (setq file (command-line-normalize-file-name file))
+                    (setq file (expand-file-name file dir))
                    (push (cons file filepos) files)
                    (server-log (format "New file: %s %s"
                                         file (or filepos "")) proc))
@@ -979,7 +1004,7 @@ The following commands are accepted by the client:
                             ;; We can't use the Emacs daemon's
                             ;; terminal frame.
                             (not (and (daemonp)
-                                      (= (length (frame-list)) 1)
+                                      (null (cdr (frame-list)))
                                       (eq (selected-frame)
                                           terminal-frame)))))
                    (setq tty-name nil tty-type nil)
@@ -1018,40 +1043,48 @@ The following commands are accepted by the client:
     (error (server-return-error proc err))))
 
 (defun server-execute (proc files nowait commands dontkill frame tty-name)
-  (condition-case err
-      (let* ((buffers
-              (when files
-                (run-hooks 'pre-command-hook)
-                (prog1 (server-visit-files files proc nowait)
-                  (run-hooks 'post-command-hook)))))
-
-        (mapc 'funcall (nreverse commands))
-
-        ;; Delete the client if necessary.
-        (cond
-         (nowait
-          ;; Client requested nowait; return immediately.
-          (server-log "Close nowait client" proc)
-          (server-delete-client proc))
-         ((and (not dontkill) (null buffers))
-          ;; This client is empty; get rid of it immediately.
-          (server-log "Close empty client" proc)
-          (server-delete-client proc)))
-        (cond
-         ((or isearch-mode (minibufferp))
-          nil)
-         ((and frame (null buffers))
-          (message "%s" (substitute-command-keys
-                         "When done with this frame, type \\[delete-frame]")))
-         ((not (null buffers))
-          (server-switch-buffer (car buffers) nil (cdr (car files)))
-          (run-hooks 'server-switch-hook)
-          (unless nowait
+  ;; This is run from timers and process-filters, i.e. "asynchronously".
+  ;; But w.r.t the user, this is not really asynchronous since the timer
+  ;; is run after 0s and the process-filter is run in response to the
+  ;; user running `emacsclient'.  So it is OK to override the
+  ;; inhibit-quit flag, which is good since `commands' (as well as
+  ;; find-file-noselect via the major-mode) can run arbitrary code,
+  ;; including code that needs to wait.
+  (with-local-quit
+    (condition-case err
+        (let* ((buffers
+                (when files
+                  (run-hooks 'pre-command-hook)
+                  (prog1 (server-visit-files files proc nowait)
+                    (run-hooks 'post-command-hook)))))
+
+          (mapc 'funcall (nreverse commands))
+
+          ;; Delete the client if necessary.
+          (cond
+           (nowait
+            ;; Client requested nowait; return immediately.
+            (server-log "Close nowait client" proc)
+            (server-delete-client proc))
+           ((and (not dontkill) (null buffers))
+            ;; This client is empty; get rid of it immediately.
+            (server-log "Close empty client" proc)
+            (server-delete-client proc)))
+          (cond
+           ((or isearch-mode (minibufferp))
+            nil)
+           ((and frame (null buffers))
             (message "%s" (substitute-command-keys
-                           "When done with a buffer, type \\[server-edit]")))))
-        (when (and frame (null tty-name))
-          (server-unselect-display frame)))
-    (error (server-return-error proc err))))
+                           "When done with this frame, type \\[delete-frame]")))
+           ((not (null buffers))
+            (server-switch-buffer (car buffers) nil (cdr (car files)))
+            (run-hooks 'server-switch-hook)
+            (unless nowait
+              (message "%s" (substitute-command-keys
+                             "When done with a buffer, type \\[server-edit]")))))
+          (when (and frame (null tty-name))
+            (server-unselect-display frame)))
+      (error (server-return-error proc err)))))
 
 (defun server-return-error (proc err)
   (ignore-errors
@@ -1341,26 +1374,32 @@ be a cons cell (LINENUMBER . COLUMNNUMBER)."
       (select-frame-set-input-focus (window-frame (selected-window))))))
 
 ;;;###autoload
-(defun server-save-buffers-kill-terminal (proc &optional arg)
+(defun server-save-buffers-kill-terminal (arg)
   ;; Called from save-buffers-kill-terminal in files.el.
-  "Offer to save each buffer, then kill PROC.
-
+  "Offer to save each buffer, then kill the current client.
 With ARG non-nil, silently save all file-visiting buffers, then kill.
 
 If emacsclient was started with a list of filenames to edit, then
 only these files will be asked to be saved."
-  ;; save-buffers-kill-terminal occasionally calls us with proc set
-  ;; to `nowait' (comes from the value of the `client' frame parameter).
-  (when (processp proc)
-    (let ((buffers (process-get proc 'buffers)))
-      ;; If client is bufferless, emulate a normal Emacs session
-      ;; exit and offer to save all buffers.  Otherwise, offer to
-      ;; save only the buffers belonging to the client.
-      (save-some-buffers arg
-                         (if buffers
-                             (lambda () (memq (current-buffer) buffers))
-                           t))
-      (server-delete-client proc))))
+  (let ((proc (frame-parameter (selected-frame) 'client)))
+    (cond ((eq proc 'nowait)
+          ;; Nowait frames have no client buffer list.
+          (if (cdr (frame-list))
+              (progn (save-some-buffers arg)
+                     (delete-frame))
+            ;; If we're the last frame standing, kill Emacs.
+            (save-buffers-kill-emacs arg)))
+         ((processp proc)
+          (let ((buffers (process-get proc 'buffers)))
+            ;; If client is bufferless, emulate a normal Emacs exit
+            ;; and offer to save all buffers.  Otherwise, offer to
+            ;; save only the buffers belonging to the client.
+            (save-some-buffers
+             arg (if buffers
+                     (lambda () (memq (current-buffer) buffers))
+                   t))
+            (server-delete-client proc)))
+         (t (error "Invalid client frame")))))
 
 (define-key ctl-x-map "#" 'server-edit)