From mboxrd@z Thu Jan 1 00:00:00 1970 Path: main.gmane.org!not-for-mail From: "Stefan Monnier" Newsgroups: gmane.emacs.devel Subject: Emacs server without emacsserver. Date: Tue, 17 Sep 2002 16:10:15 -0400 Sender: emacs-devel-admin@gnu.org Message-ID: <200209172010.g8HKAG312061@rum.cs.yale.edu> NNTP-Posting-Host: localhost.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=us-ascii X-Trace: main.gmane.org 1032293554 13426 127.0.0.1 (17 Sep 2002 20:12:34 GMT) X-Complaints-To: usenet@main.gmane.org NNTP-Posting-Date: Tue, 17 Sep 2002 20:12:34 +0000 (UTC) Return-path: Original-Received: from quimby.gnus.org ([80.91.224.244]) by main.gmane.org with esmtp (Exim 3.35 #1 (Debian)) id 17rOi1-0003UQ-00 for ; Tue, 17 Sep 2002 22:12:33 +0200 Original-Received: from monty-python.gnu.org ([199.232.76.173]) by quimby.gnus.org with esmtp (Exim 3.12 #1 (Debian)) id 17rPLz-0003bV-00 for ; Tue, 17 Sep 2002 22:53:51 +0200 Original-Received: from localhost ([127.0.0.1] helo=monty-python.gnu.org) by monty-python.gnu.org with esmtp (Exim 4.10) id 17rOiI-0001L5-00; Tue, 17 Sep 2002 16:12:50 -0400 Original-Received: from list by monty-python.gnu.org with tmda-scanned (Exim 4.10) id 17rOfr-0001FQ-00 for emacs-devel@gnu.org; Tue, 17 Sep 2002 16:10:19 -0400 Original-Received: from mail by monty-python.gnu.org with spam-scanned (Exim 4.10) id 17rOfo-0001Ex-00 for emacs-devel@gnu.org; Tue, 17 Sep 2002 16:10:18 -0400 Original-Received: from rum.cs.yale.edu ([128.36.229.169]) by monty-python.gnu.org with esmtp (Exim 4.10) id 17rOfo-0001EX-00 for emacs-devel@gnu.org; Tue, 17 Sep 2002 16:10:16 -0400 Original-Received: (from monnier@localhost) by rum.cs.yale.edu (8.11.6/8.11.6) id g8HKAG312061; Tue, 17 Sep 2002 16:10:16 -0400 X-Mailer: exmh version 2.4 06/23/2000 with nmh-1.0.4 Original-To: emacs-devel@gnu.org Errors-To: emacs-devel-admin@gnu.org X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.0.11 Precedence: bulk List-Help: List-Post: List-Subscribe: , List-Id: Emacs development discussions. List-Unsubscribe: , List-Archive: Xref: main.gmane.org gmane.emacs.devel:7976 X-Report-Spam: http://spam.gmane.org/gmane.emacs.devel:7976 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: +(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))))) ;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))