Mercurial > emacs

diff lisp/server.el @ 83044:52039abab942

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Verify the version of Emacsclient. lib-src/emacsclient.c (main): Send the version number of emacsclient to the Emacs process, and exit with error if Emacs does not accept it. lisp/server.el (server-with-errors-reported): Removed. (server-process-filter): Cleaned up error handling. Compare the version of emacsclient with emacs-version; signal an error if they do not match. git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-84
author Karoly Lorentey <lorentey@elte.hu>
date Fri, 20 Feb 2004 01:22:10 +0000
parents 78a785f205ea
children a871be7b26a5
line wrap: on
line diff
--- a/lisp/server.el	Thu Feb 19 23:55:51 2004 +0000
+++ b/lisp/server.el	Fri Feb 20 01:22:10 2004 +0000
@@ -349,17 +349,6 @@
   ;; nothing if there is one (for multiple Emacs sessions)?
   (server-start (not server-mode)))
 
-(defmacro server-with-errors-reported (&rest forms)
-  "Evaluate FORMS; if an error occurs, report it to the client
-and return nil.  Otherwise, return the result of the last form.
-For use in server-process-filter only."
-  `(condition-case err
-       (progn ,@forms)
-     (error (ignore-errors
-	      (process-send-string
-	       proc (concat "-error " (error-message-string err)))
-	      (setq request "")))))
-
 (defun server-process-filter (proc string)
   "Process a request from the server to edit some files.
 PROC is the server process.  Format of STRING is \"PATH PATH PATH... \\n\"."
@@ -368,121 +357,144 @@
     (when prev
       (setq string (concat prev string))
       (process-put proc 'previous-string nil)))
-  ;; If the input is multiple lines,
-  ;; process each line individually.
-  (while (string-match "\n" string)
-    (let ((request (substring string 0 (match-beginning 0)))
-	  (coding-system (and default-enable-multibyte-characters
-			      (or file-name-coding-system
-				  default-file-name-coding-system)))
-	  client nowait eval newframe display
-	  registered	; t if the client is already added to server-clients.
-	  (files nil)
-	  (lineno 1)
-	  (columnno 0))
-      ;; Remove this line from STRING.
-      (setq string (substring string (match-end 0)))
-      (setq client (cons proc nil))
-      (while (string-match "[^ ]* " request)
-	(let ((arg (substring request (match-beginning 0) (1- (match-end 0)))))
-	  (setq request (substring request (match-end 0)))
-	  (cond
-	   ((equal "-nowait" arg) (setq nowait t))
-	   ((equal "-eval" arg) (setq eval t))
-
-	   ((and (equal "-display" arg) (string-match "\\([^ ]*\\) " request))
-	    (setq display (match-string 1 request)
-		  request (substring request (match-end 0))))
+  (condition-case err
+      ;; If the input is multiple lines,
+      ;; process each line individually.
+      (while (string-match "\n" string)
+	(let ((request (substring string 0 (match-beginning 0)))
+	      (coding-system (and default-enable-multibyte-characters
+				  (or file-name-coding-system
+				      default-file-name-coding-system)))
+	      client nowait eval newframe display version-checked
+	      registered	; t if the client is already added to server-clients.
+	      (files nil)
+	      (lineno 1)
+	      (columnno 0))
+	  ;; Remove this line from STRING.
+	  (setq string (substring string (match-end 0)))
+	  (setq client (cons proc nil))
+	  (while (string-match "[^ ]* " request)
+	    (let ((arg (substring request (match-beginning 0) (1- (match-end 0)))))
+	      (setq request (substring request (match-end 0)))
+	      (cond
+	       ;; Check version numbers.
+	       ((and (equal "-version" arg) (string-match "\\([0-9.]+\\) " request))
+		(let* ((client-version (match-string 1 request))
+		       (truncated-emacs-version (substring emacs-version 0 (length client-version))))
+		  (setq request (substring request (match-end 0)))
+		  (if (equal client-version truncated-emacs-version)
+		      (progn
+			(process-send-string proc "-good-version \n")
+			(setq version-checked t))
+		    (error (concat "Version mismatch: Emacs is " truncated-emacs-version ", emacsclient is " client-version)))))
 
-	   ;; Open a new X frame.
-	   ((equal "-window-system" arg)
-	    (server-with-errors-reported
-	     (let ((frame (make-frame-on-display
-			   (or display
-			       (frame-parameter nil 'display)
-			       (getenv "DISPLAY")
-			       (error "Please specify display")))))
-	       (push (list proc frame) server-frames)
-	       (select-frame frame)
-	       ;; This makes sure that `emacsclient -w -e '(delete-frame)'' works right.
-	       (push client server-clients)
-	       (setq registered t
-		     newframe t))))
+	       ((equal "-nowait" arg) (setq nowait t))
+	       ((equal "-eval" arg) (setq eval t))
+
+	       ((and (equal "-display" arg) (string-match "\\([^ ]*\\) " request))
+		(setq display (match-string 1 request)
+		      request (substring request (match-end 0))))
 
-	   ;; Open a new tty frame at the client.  ARG is the name of the pseudo tty.
-	   ((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)))
-	      (server-with-errors-reported
-	       (let ((frame (make-frame-on-tty tty type)))
-		 (push (list (car client) (frame-tty-name frame)) server-ttys)
-		 (process-send-string proc (concat "-emacs-pid " (number-to-string (emacs-pid)) "\n"))
-		 (select-frame frame)
-		 ;; This makes sure that `emacsclient -t -e '(delete-frame)'' works right.
-		 (push client server-clients)
-		 (setq registered t
-		       newframe t)))))
+	       ;; Open a new X frame.
+	       ((equal "-window-system" arg)
+		(unless version-checked
+		  (error "Protocol error; make sure to use the correct version of emacsclient"))
+		(let ((frame (make-frame-on-display
+			      (or display
+				  (frame-parameter nil 'display)
+				  (getenv "DISPLAY")
+				  (error "Please specify display")))))
+		  (push (list proc frame) server-frames)
+		  (select-frame frame)
+		  ;; This makes sure that `emacsclient -w -e '(delete-frame)'' works right.
+		  (push client server-clients)
+		  (setq registered t
+			newframe t)))
 
-	   ;; ARG is a line number option.
-	   ((string-match "\\`\\+[0-9]+\\'" arg)
-	    (setq lineno (string-to-int (substring arg 1))))
-
-	   ;; ARG is line number:column option.
-	   ((string-match "\\`\\+\\([0-9]+\\):\\([0-9]+\\)\\'" arg)
-	    (setq lineno (string-to-int (match-string 1 arg))
-		  columnno (string-to-int (match-string 2 arg))))
-
-	   ;; ARG is a filename or a Lisp expression.
-	   (t
+	       ;; Open a new tty frame at the client.  ARG is the name of the pseudo tty.
+	       ((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)))
+		  (unless version-checked
+		    (error "Protocol error; make sure to use the correct version of emacsclient"))
+		  (let ((frame (make-frame-on-tty tty type)))
+		    (push (list (car client) (frame-tty-name frame)) server-ttys)
+		    (process-send-string proc (concat "-emacs-pid " (number-to-string (emacs-pid)) "\n"))
+		    (select-frame frame)
+		    ;; This makes sure that `emacsclient -t -e '(delete-frame)'' works right.
+		    (push client server-clients)
+		    (setq registered t
+			  newframe t))))
 
-	    ;; Undo the quoting that emacsclient does
-	    ;; for certain special characters.
-	    (setq arg (server-unquote-arg arg))
-	    ;; Now decode the file name if necessary.
-	    (if coding-system
-		(setq arg (decode-coding-string arg coding-system)))
-	    (if eval
-		(server-with-errors-reported
-		 (let ((v (eval (car (read-from-string arg)))))
-		   (when (and (not newframe) v)
-		     (with-temp-buffer
-		       (let ((standard-output (current-buffer)))
-			 (pp v)
-			 (process-send-string proc "-print ")
-			 (process-send-region proc (point-min) (point-max)))))))
+	       ;; ARG is a line number option.
+	       ((string-match "\\`\\+[0-9]+\\'" arg)
+		(setq lineno (string-to-int (substring arg 1))))
+
+	       ;; ARG is line number:column option.
+	       ((string-match "\\`\\+\\([0-9]+\\):\\([0-9]+\\)\\'" arg)
+		(setq lineno (string-to-int (match-string 1 arg))
+		      columnno (string-to-int (match-string 2 arg))))
 
-	      ;; ARG is a file name.
-	      ;; Collapse multiple slashes to single slashes.
-	      (setq arg (command-line-normalize-file-name arg))
-	      (push (list arg lineno columnno) files))
-	    (setq lineno 1)
-	    (setq columnno 0)))))
+	       ;; ARG is a filename or a Lisp expression.
+	       (t
+		;; Undo the quoting that emacsclient does
+		;; for certain special characters.
+		(setq arg (server-unquote-arg arg))
+		;; Now decode the file name if necessary.
+		(if coding-system
+		    (setq arg (decode-coding-string arg coding-system)))
+		(unless version-checked
+		  (error "Protocol error; make sure to use the correct version of emacsclient"))
+		(if eval
+		    ;; ARG is a Lisp expression.
+		    (let ((v (eval (car (read-from-string arg)))))
+		      (when (and (not newframe) v)
+			(with-temp-buffer
+			  (let ((standard-output (current-buffer)))
+			    (pp v)
+			    (process-send-string proc "-print ")
+			    (process-send-region proc (point-min) (point-max))))))
+		  ;; ARG is a file name.
+		  ;; Collapse multiple slashes to single slashes.
+		  (setq arg (command-line-normalize-file-name arg))
+		  (push (list arg lineno columnno) files))
+		(setq lineno 1)
+		(setq columnno 0)))))
 
-      (when files
-	(run-hooks 'pre-command-hook)
-	(server-visit-files files client nowait)
-	(run-hooks 'post-command-hook))
-      ;; CLIENT is now a list (CLIENTNUM BUFFERS...)
-      (if (and (not newframe) (null (cdr client)))
-	  ;; This client is empty; get rid of it immediately.
-	  (progn
-	    (delete-process proc)
-	    (server-log "Close empty client" proc))
-	;; We visited some buffer for this client.
-	(or nowait registered (push client server-clients))
-	(unless (or isearch-mode (minibufferp))
-	  (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)))
+	  (if (not version-checked)
+	      (error "Protocol error; make sure to use the correct version of emacsclient")
+	    (when files
+	      (run-hooks 'pre-command-hook)
+	      (server-visit-files files client nowait)
+	      (run-hooks 'post-command-hook))
+	    ;; CLIENT is now a list (CLIENTNUM BUFFERS...)
+	    (if (and (not newframe) (null (cdr client)))
+		;; This client is empty; get rid of it immediately.
+		(progn
+		  (delete-process proc)
+		  (server-log "Close empty client" proc))
+	      ;; We visited some buffer for this client.
+	      (or nowait registered (push client server-clients))
+	      (unless (or isearch-mode (minibufferp))
+		(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)))
+    ;; condition-case
+    (error (ignore-errors
+	     (process-send-string
+	      proc (concat "-error " (error-message-string err)))
+	     (setq string "")
+	     (server-log (error-message-string err) proc)
+	     (delete-process proc)))))
 
 (defun server-goto-line-column (file-line-col)
   (goto-line (nth 1 file-line-col))