diff lisp/server.el @ 82988:f82e3a6f5ccb

A few more bugfixes and new features. (Sigh.) I obviously need to remember to separate individual changes to multiple commits. src/emacsclient.c: Improved error handling. (decode_options): Changed frame option (again) from -f to -t. (print_help_and_exit): Ditto. (copy_from_to): Check EINTR after write, not EAGAIN. Removed SIGIO hack. (pty_conversation): Handle errors transmitted through the socket. Handle pty errors by not reading from it anymore. (main): Restore correct errno after socket_status failed. Send -tty on -t, not -pty. lisp/server.el (server-process-filter): Watch -tty, not -pty. Use make-frame-on-tty instead of make-terminal-frame. Don't set newframe to t if make-frame-on-tty failed. Don't delete frames here. Print correct message when there are no files to edit, but a new frame was requested. (server-sentinel): Delete the frame after the process. (server-handle-delete-frame): New function for delete-frame-functions. (server-start): Add server-handle-delete-frame to delete-frame-functions. (server-buffer-done): Don't delete frames here. src/alloc.c (mark_ttys): Add prototype. (Fgarbage_collect): Call mark_ttys. src/emacs.c: (shut_down_emacs): Don't flush stdout before reset_sys_modes(). src/process.c (add_keyboard_wait_descriptor_called_flag): Removed. (add_keyboard_wait_descriptor): Removed stdin hack. src/sysdep.c: Unconditionally include sysselect.h. (old_fcntl_flags): Changed to an array. (init_sigio, reset_sigio): Use it. (narrow_foreground_group, widen_foreground_group): Use setpgid, not setpgrp. (old_fcntl_owner): Changed to an array. (init_sys_modes, reset_sys_modes): Use it. Fix fsync() and reset_sigio() calls. src/term.c (Qframe_tty_name, Qframe_tty_type): New variables. (syms_of_term): Initialize them. (Fframe_tty_name, Fframe_tty_type): New functions. (term_init): Call add_keyboard_wait_descriptor(). (Fdelete_tty): New function. (delete_tty): Call delete_keyboard_wait_descriptor(). (get_current_tty): Removed. (mark_ttys): New function. git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-28
author Karoly Lorentey <lorentey@elte.hu>
date Wed, 31 Dec 2003 05:09:29 +0000
parents 1682917e56b4
children 039bd6989d29
line wrap: on
line diff
--- a/lisp/server.el	Tue Dec 30 19:27:57 2003 +0000
+++ b/lisp/server.el	Wed Dec 31 05:09:29 2003 +0000
@@ -185,9 +185,6 @@
     ;; Remove PROC from the list of clients.
     (when client
       (setq server-clients (delq client server-clients))
-      (let ((frame (assq (car client) server-frames)))
-	(setq server-frames (delq frame server-frames))
-	(when (frame-live-p (cadr frame)) (delete-frame (cadr frame) 'force)))
       (dolist (buf (cdr client))
 	(with-current-buffer buf
 	  ;; Remove PROC from the clients of each buffer.
@@ -197,9 +194,24 @@
 		     (or (and server-kill-new-buffers
 			      (not server-existing-buffer))
 			 (server-temp-file-p)))
-	    (kill-buffer (current-buffer)))))))
+	    (kill-buffer (current-buffer)))))
+      (let ((frame (assq (car client) server-frames)))
+	(when frame
+	  (setq server-frames (delq frame server-frames))
+	  (when (frame-live-p (cadr frame)) (delete-frame (cadr frame) 'force))))))
   (server-log (format "Status changed to %s" (process-status proc)) proc))
 
+(defun server-handle-delete-frame (frame)
+  (dolist (entry server-frames)
+    (let ((proc (nth 0 entry))
+	  (f (nth 1 entry)))
+      (when (eq f frame)
+	(let ((client (assq proc server-clients)))
+	  (if (and (cdr client) (not (yes-or-no-p "Frame has pending buffers; close anyway? ")))
+	      (error "Frame deletion cancelled")
+	    (setq server-frames (delq entry server-frames))
+	    (delete-process (car client))))))))
+
 (defun server-select-display (display)
   ;; If the current frame is on `display' we're all set.
   (unless (equal (frame-parameter (selected-frame) 'display) display)
@@ -276,6 +288,7 @@
     (if server-process
 	(server-log (message "Restarting server")))
     (letf (((default-file-modes) ?\700))
+      (add-to-list 'delete-frame-functions 'server-handle-delete-frame)
       (setq server-process
 	    (make-network-process
 	     :name "server" :family 'local :server t :noquery t
@@ -335,18 +348,18 @@
 		(error (process-send-string proc (nth 1 err))
 		       (setq request "")))))
 	   ;; Open a new frame at the client.  ARG is the name of the pseudo tty.
-	   ((and (equal "-pty" arg) (string-match "\\([^ ]*\\) \\([^ ]*\\) " request))
-	    (setq newframe t)
-	    (let ((pty (server-unquote-arg (match-string 1 request)))
+	   ((and (equal "-tty" arg) (string-match "\\([^ ]*\\) \\([^ ]*\\) " request))
+	    (let ((tty (server-unquote-arg (match-string 1 request)))
 		  (type (server-unquote-arg (match-string 2 request))))
 	      (setq request (substring request (match-end 0)))
 	      (condition-case err
-		  (let ((frame (make-terminal-frame `((tty . ,pty) (tty-type . ,type)))))
+		  (let ((frame (make-frame-on-tty tty type)))
 		    (setq server-frames (cons (list (car client) frame) server-frames))
 		    (sit-for 0)
 		    (process-send-string proc (concat (number-to-string (emacs-pid)) "\n"))
-		    (select-frame frame))
-		(error (process-send-string proc (nth 1 err))
+		    (select-frame frame)
+		    (setq newframe t))
+		(error (ignore-errors (process-send-string proc (concat (nth 1 err) "\n")))
 		       (setq request "")))))
 	   ;; ARG is a line number option.
 	   ((string-match "\\`\\+[0-9]+\\'" arg)
@@ -386,19 +399,19 @@
       (if (and (not newframe) (null (cdr client)))
 	  ;; This client is empty; get rid of it immediately.
 	  (progn
-	    (let ((frame (assq (car client) server-frames)))
-	      (setq server-frames (delq frame server-frames))
-	      (when (frame-live-p (cadr frame)) (delete-frame (cadr frame) 'force)))
 	    (delete-process proc)
 	    (server-log "Close empty client" proc))
 	;; We visited some buffer for this client.
 	(or nowait (push client server-clients))
 	(unless (or isearch-mode (minibufferp))
-	  (server-switch-buffer (nth 1 client))
-	  (run-hooks 'server-switch-hook)
-	  (unless nowait
-	    (message (substitute-command-keys
-		      "When done with a buffer, type \\[server-edit]")))))))
+	  (if (and newframe (null (cdr client)))
+	      (message (substitute-command-keys
+			"When done with this frame, type \\[delete-frame]"))
+	    (server-switch-buffer (nth 1 client))
+	    (run-hooks 'server-switch-hook)
+	    (unless nowait
+	      (message (substitute-command-keys
+			"When done with a buffer, type \\[server-edit]"))))))))
   ;; Save for later any partial line that remains.
   (when (> (length string) 0)
     (process-put proc 'previous-string string)))
@@ -475,9 +488,6 @@
 	;; If client now has no pending buffers,
 	;; tell it that it is done, and forget it entirely.
 	(unless (cdr client)
-	  (let ((frame (assq (car client) server-frames)))
-	    (setq server-frames (delq frame server-frames))
-	    (when (frame-live-p (cadr frame)) (delete-frame (cadr frame) 'force)))
 	  (delete-process (car client))
 	  (server-log "Close" (car client))
 	  (setq server-clients (delq client server-clients))))