unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
* Emacs server without emacsserver.
@ 2002-09-17 20:10 Stefan Monnier
       [not found] ` <E17s34A-0006oU-00@fencepost.gnu.org>
  2002-10-16 21:50 ` Sam Steingold
  0 siblings, 2 replies; 13+ messages in thread
From: Stefan Monnier @ 2002-09-17 20:10 UTC (permalink / raw)



If someone wants to play with it, here is a first cut at it.
I wish we could attach arbitrary properties to processes as we
can to symbols, frames, overlays, ...


	Stefan


--- server.el.~1.79.~	Mon Aug 19 13:45:36 2002
+++ server.el	Tue Sep 17 16:06:40 2002
@@ -76,15 +76,12 @@
 
 ;;; Code:
 \f
+(eval-when-compile (require 'cl))
+
 (defgroup server nil
   "Emacs running as a server process."
   :group 'external)
 
-(defcustom server-program (expand-file-name "emacsserver" exec-directory)
-  "*The program to use as the edit server."
-  :group 'server
-  :type 'string)
-
 (defcustom server-visit-hook nil
   "*List of hooks to call when visiting a file for the Emacs server."
   :group 'server
@@ -103,7 +100,7 @@
 (defvar server-process nil 
   "The current server process")
 
-(defvar server-previous-string "")
+(defvar server-previous-strings nil)
 
 (defvar server-clients nil
   "List of current server clients.
@@ -151,21 +148,32 @@
 where it is set.")
 (make-variable-buffer-local 'server-existing-buffer)
 
+(defvar server-socket-name
+  (if (or (not (file-writable-p "~/"))
+	  (and (file-writable-p "/tmp/")
+	       (not (zerop (logand (file-modes "/tmp/") 512)))))
+      (format "/tmp/esrv%d-%s" (user-uid) (system-name))
+    (format "~/.emacs-server-%s" (system-name))))
+
 ;; If a *server* buffer exists,
 ;; write STRING to it for logging purposes.
 (defun server-log (string)
   (if (get-buffer "*server*")
-      (save-excursion
-	(set-buffer "*server*")
+      (with-current-buffer "*server*"
 	(goto-char (point-max))
 	(insert (current-time-string) " " string)
 	(or (bolp) (newline)))))
 
 (defun server-sentinel (proc msg)
-  (cond ((eq (process-status proc) 'exit)
-	 (server-log (message "Server subprocess exited")))
-	((eq (process-status proc) 'signal)
-	 (server-log (message "Server subprocess killed")))))
+  (let ((ps (assq proc server-previous-strings)))
+    (if ps (setq server-previous-strings
+		 (delq ps server-previous-strings))))
+  (case (process-status proc)
+    (exit (server-log (message "Server subprocess exited")))
+    (signal (server-log (message "Server subprocess killed")))
+    (closed (server-log (message "Server connection closed")))
+    (t (server-log (message "Server status changed to %s (%s)"
+			    (process-status proc) msg)))))
 
 ;;;###autoload
 (defun server-start (&optional leave-dead)
@@ -183,24 +191,7 @@
 	(set-process-sentinel server-process nil)
 	(condition-case () (delete-process server-process) (error nil))))
   ;; Delete the socket files made by previous server invocations.
-  (let* ((sysname (system-name))
-	 (dot-index (string-match "\\." sysname)))
-    (condition-case ()
-	(delete-file (format "~/.emacs-server-%s" sysname))
-      (error nil))
-    (condition-case ()
-	(delete-file (format "/tmp/esrv%d-%s" (user-uid) sysname))
-      (error nil))
-    ;; In case the server file name was made with a domainless hostname,
-    ;; try deleting that name too.
-    (if dot-index
-	(let ((shortname (substring sysname 0 dot-index)))
-	  (condition-case ()
-	      (delete-file (format "~/.emacs-server-%s" shortname))
-	    (error nil))
-	  (condition-case ()
-	      (delete-file (format "/tmp/esrv%d-%s" (user-uid) shortname))
-	    (error nil)))))
+  (condition-case () (delete-file server-socket-name) (error nil))
   ;; If this Emacs already had a server, clear out associated status.
   (while server-clients
     (let ((buffer (nth 1 (car server-clients))))
@@ -211,21 +202,29 @@
 	(server-log (message "Restarting server")))
     ;; Using a pty is wasteful, and the separate session causes
     ;; annoyance sometimes (some systems kill idle sessions).
-    (let ((process-connection-type nil))
-      (setq server-process (start-process "server" nil server-program)))
-    (set-process-sentinel server-process 'server-sentinel)
-    (set-process-filter server-process 'server-process-filter)
-    ;; We must receive file names without being decoded.  Those are
-    ;; decoded by server-process-filter accoding to
-    ;; file-name-coding-system.
-    (set-process-coding-system server-process 'raw-text 'raw-text)
-    (process-kill-without-query server-process)))
+    (let ((umask (default-file-modes)))
+      (unwind-protect
+	  (progn
+	    (set-default-file-modes ?\700)
+	    (setq server-process
+		  (make-network-process
+		   :name "server" :family 'local :server t :noquery t
+		   :service server-socket-name
+		   :sentinel 'server-sentinel :filter 'server-process-filter
+		   ;; We must receive file names without being decoded.
+		   ;; Those are decoded by server-process-filter according
+		   ;; to file-name-coding-system.
+		   :coding 'raw-text)))
+	(set-default-file-modes umask)))))
 \f
 ;Process a request from the server to edit some files.
 ;Format of STRING is "Client: CLIENTID PATH PATH PATH... \n"
 (defun server-process-filter (proc string)
   (server-log string)
-  (setq string (concat server-previous-string string))
+  (let ((ps (assq proc server-previous-strings)))
+    (when (cdr ps)
+      (setq string (concat (cdr ps) string))
+      (setcdr ps nil)))
   ;; If the input is multiple lines,
   ;; process each line individually.
   (while (string-match "\n" string)
@@ -239,13 +238,7 @@
 	  (columnno 0))
       ;; Remove this line from STRING.
       (setq string (substring string (match-end 0)))	  
-      (if (string-match "^Error: " request)
-	  (message "Server error: %s" (substring request (match-end 0)))
-	(if (string-match "^Client: " request)
-	    (progn
-	      (setq request (substring request (match-end 0)))
-	      (setq client (list (substring request 0 (string-match " " request))))
-	      (setq request (substring request (match-end 0)))
+      (setq client (cons proc nil))
 	      (while (string-match "[^ ]+ " request)
 		(let ((arg
 		       (substring request (match-beginning 0) (1- (match-end 0))))
@@ -300,9 +293,12 @@
 		(server-switch-buffer (nth 1 client))
 		(run-hooks 'server-switch-hook)
 		(message (substitute-command-keys
-			  "When done with a buffer, type \\[server-edit]"))))))))
+		  "When done with a buffer, type \\[server-edit]")))))
   ;; Save for later any partial line that remains.
-  (setq server-previous-string string))
+  (when (> (length string) 0)
+    (let ((ps (assq proc server-previous-strings)))
+      (if ps (setcdr ps string)
+	(push (cons proc string) server-previous-strings)))))
 
 (defun server-goto-line-column (file-line-col)
   (goto-line (nth 1 file-line-col))
@@ -356,12 +352,11 @@
   "Mark BUFFER as \"done\" for its client(s).
 This buries the buffer, then returns a list of the form (NEXT-BUFFER KILLED).
 NEXT-BUFFER is another server buffer, as a suggestion for what to select next,
-or nil.  KILLED is t if we killed BUFFER
-\(typically, because it was visiting a temp file)."
-  (let ((running (eq (process-status server-process) 'run))
-	(next-buffer nil)
+or nil.  KILLED is t if we killed BUFFER (typically, because it was visiting
+a temp file).
+FOR-KILLING if non-nil indicates that we are called from `kill-buffer'."
+  (let ((next-buffer nil)
 	(killed nil)
-	(first t)
 	(old-clients server-clients))
     (while old-clients
       (let ((client (car old-clients)))
@@ -377,16 +372,9 @@
 	    (setq tail (cdr tail))))
 	;; If client now has no pending buffers,
 	;; tell it that it is done, and forget it entirely.
-	(if (cdr client) nil
-	  (if running
-	      (progn
-		;; Don't send emacsserver two commands in close succession.
-		;; It cannot handle that.
-		(or first (sit-for 1))
-		(setq first nil)
-		(send-string server-process 
-			     (format "Close: %s Done\n" (car client)))
-		(server-log (format "Close: %s Done\n" (car client)))))
+	(unless (cdr client)
+	  (delete-process (car client))
+	  (server-log (format "Close: %s Done\n" (car client)))
 	  (setq server-clients (delq client server-clients))))
       (setq old-clients (cdr old-clients)))
     (if (and (bufferp buffer) (buffer-name buffer))

^ permalink raw reply	[flat|nested] 13+ messages in thread
end of thread, other threads:[~2002-12-27 19:10 UTC | newest]

Thread overview: 13+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2002-09-17 20:10 Emacs server without emacsserver Stefan Monnier
     [not found] ` <E17s34A-0006oU-00@fencepost.gnu.org>
     [not found]   ` <200209191632.g8JGWV408480@rum.cs.yale.edu>
     [not found]     ` <E17sEim-00081r-00@fencepost.gnu.org>
2002-09-20 18:41       ` Stefan Monnier
2002-09-21  0:58         ` Kim F. Storm
2002-09-21 19:39           ` Richard Stallman
2002-09-22 22:30             ` Stefan Monnier
2002-09-23 15:59               ` Richard Stallman
2002-10-16 21:50 ` Sam Steingold
2002-10-20  5:34   ` Richard Stallman
2002-10-20 19:57   ` Stefan Monnier
2002-10-20 22:51     ` Sam Steingold
2002-10-21 12:55       ` Stefan Monnier
2002-10-21 14:11         ` Sam Steingold
2002-12-27 19:10         ` Richard Stallman

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).