comparison lisp/server.el @ 83044:52039abab942

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: [e-mail]--2004/emacs--multi-tty--0--patch-84

83043:78a785f205ea

  :version "21.4"
  ;; 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)))

(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\"."
  (server-log string proc)
  (let ((prev (process-get proc 'previous-string)))
    (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))))

	   ;; 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))))

	   ;; 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)))))

	   ;; 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

	    ;; 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 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)))

(defun server-goto-line-column (file-line-col)
  (goto-line (nth 1 file-line-col))
  (let ((column-number (nth 2 file-line-col)))
    (if (> column-number 0)

83044:52039abab942

  :version "21.4"
  ;; 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)))

(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\"."
  (server-log string proc)
  (let ((prev (process-get proc 'previous-string)))
    (when prev
      (setq string (concat prev string))
      (process-put proc 'previous-string nil)))
  (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)))))

	       ((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 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)))

	       ;; 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))))

	       ;; 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
		;; 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)))))

	  (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))
  (let ((column-number (nth 2 file-line-col)))
    (if (> column-number 0)