X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/60f8ea53494c5202476162acb984d968041ad1d5..5827e9d4606d749340690d776fd362a114043b3f:/lisp/server.el

diff --git a/lisp/server.el b/lisp/server.el
index 36cad64dde..a0f41e59ff 100644
--- a/lisp/server.el
+++ b/lisp/server.el
@@ -1,6 +1,6 @@
 ;;; server.el --- Lisp code for GNU Emacs running as server process
 
-;; Copyright (C) 1986,87,92,94,95,96,97,98,99,2000,01,02,2003
+;; Copyright (C) 1986,87,92,94,95,96,97,98,99,2000,01,02,03,2004
 ;;	 Free Software Foundation, Inc.
 
 ;; Author: William Sommerfeld <wesommer@athena.mit.edu>
@@ -123,7 +123,7 @@ If it is a frame, use the frame's selected window.
 It is not meaningful to set this to a specific frame or window with Custom.
 Only programs can do so."
   :group 'server
-  :version "21.4"
+  :version "22.1"
   :type '(choice (const :tag "Use selected window"
 			:match (lambda (widget value)
 				 (not (functionp value)))
@@ -159,9 +159,10 @@ 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-socket-name
-  (format "/tmp/emacs%d-%s/server" (user-uid)
-	  (substring (system-name) 0 (string-match "\\." (system-name)))))
+(defvar server-name "server")
+
+(defvar server-socket-dir
+  (format "/tmp/emacs%d" (user-uid)))
 
 (defun server-log (string &optional client)
   "If a *server* buffer exists, write STRING to it for logging purposes."
@@ -247,12 +248,14 @@ Emacs distribution as your standard \"editor\".
 Prefix arg means just kill any existing server communications subprocess."
   (interactive "P")
   ;; Make sure there is a safe directory in which to place the socket.
-  (server-ensure-safe-dir (file-name-directory server-socket-name))
+  (server-ensure-safe-dir server-socket-dir)
   ;; kill it dead!
   (if server-process
       (condition-case () (delete-process server-process) (error nil)))
   ;; Delete the socket files made by previous server invocations.
-  (condition-case () (delete-file server-socket-name) (error nil))
+  (condition-case ()
+      (delete-file (expand-file-name server-name server-socket-dir))
+    (error nil))
   ;; If this Emacs already had a server, clear out associated status.
   (while server-clients
     (let ((buffer (nth 1 (car server-clients))))
@@ -264,7 +267,7 @@ Prefix arg means just kill any existing server communications subprocess."
       (setq server-process
 	    (make-network-process
 	     :name "server" :family 'local :server t :noquery t
-	     :service server-socket-name
+	     :service (expand-file-name server-name server-socket-dir)
 	     :sentinel 'server-sentinel :filter 'server-process-filter
 	     ;; We must receive file names without being decoded.
 	     ;; Those are decoded by server-process-filter according
@@ -279,7 +282,7 @@ Server mode runs a process that accepts commands from the
 `emacsclient' program.  See `server-start' and Info node `Emacs server'."
   :global t
   :group 'server
-  :version "21.4"
+  :version "22.1"
   ;; Fixme: Should this check for an existing server socket and do
   ;; nothing if there is one (for multiple Emacs sessions)?
   (server-start (not server-mode)))
@@ -302,6 +305,7 @@ PROC is the server process.  Format of STRING is \"PATH PATH PATH... \\n\"."
 	  client nowait eval
 	  (files nil)
 	  (lineno 1)
+	  (tmp-frame nil) ; Sometimes used to embody the selected display.
 	  (columnno 0))
       ;; Remove this line from STRING.
       (setq string (substring string (match-end 0)))
@@ -316,7 +320,7 @@ PROC is the server process.  Format of STRING is \"PATH PATH PATH... \\n\"."
 	    (let ((display (server-unquote-arg (match-string 1 request))))
 	      (setq request (substring request (match-end 0)))
 	      (condition-case err
-		  (server-select-display display)
+		  (setq tmp-frame (server-select-display display))
 		(error (process-send-string proc (nth 1 err))
 		       (setq request "")))))
 	   ;; ARG is a line number option.
@@ -339,7 +343,12 @@ PROC is the server process.  Format of STRING is \"PATH PATH PATH... \\n\"."
 		    (with-temp-buffer
 		      (let ((standard-output (current-buffer)))
 			(pp v)
-			(process-send-region proc (point-min) (point-max))))))
+			;; Suppress the error rose when the pipe to PROC is closed.
+			(condition-case err
+			    (process-send-region proc (point-min) (point-max))
+			  (file-error nil)
+			  (error nil))
+			))))
 	      ;; ARG is a file name.
 	      ;; Collapse multiple slashes to single slashes.
 	      (setq arg (command-line-normalize-file-name arg))
@@ -363,7 +372,9 @@ PROC is the server process.  Format of STRING is \"PATH PATH PATH... \\n\"."
 	  (run-hooks 'server-switch-hook)
 	  (unless nowait
 	    (message (substitute-command-keys
-		      "When done with a buffer, type \\[server-edit]")))))))
+		      "When done with a buffer, type \\[server-edit]")))))
+      ;; Avoid preserving the connection after the last real frame is deleted.
+      (if tmp-frame (delete-frame tmp-frame))))
   ;; Save for later any partial line that remains.
   (when (> (length string) 0)
     (process-put proc 'previous-string string)))
@@ -621,7 +632,10 @@ Arg NEXT-BUFFER is a suggestion; if it is a live buffer, use it."
   (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))
+
+(add-hook 'server-unload-hook 'server-unload-hook)
 
 (provide 'server)
 
+;;; arch-tag: 1f7ecb42-f00a-49f8-906d-61995d84c8d6
 ;;; server.el ends here