comparison lisp/server.el @ 83403:51eb0aa362f3

Store client's environment in terminal parameters, not server parameters. * lisp/loadup.el: Don't load server. * lisp/ldefs-boot.el: Update. * lib-src/emacsclient.c (main): Send environment only when a new display is created. * lisp/server.el (server-save-buffers-kill-display): Add autoload cookie. Move stuff not specific to server into `save-buffers-kill-display'. * lisp/files.el (save-buffers-kill-display): New function. (ctl-x-map): Bind it to C-x C-c. * lisp/frame.el (terminal-getenv): New function. * lisp/international/mule-cmds.el (set-locale-environment): Use it. * lisp/frame.el (with-terminal-environment): New macro. * lisp/server.el (server-getenv, server-with-client-environment): Remove. (server-getenv-from, server-with-environment): New functions. (server-process-filter): Change syntax of environment variables. Put environment into terminal parameters, not client parameters. * lisp/term/rxvt.el: Don't require server. (rxvt-set-background-mode): Use terminal-getenv, not server-getenv. * lisp/term/x-win.el (x-initialize-window-system): Ditto. * lisp/term/xterm.el (terminal-init-xterm): Ditto. git-archimport-id: [e-mail]--2004/emacs--multi-tty--0--patch-443

83402:606eab743857

New clients have no properties."
  (unless (server-client proc)
    (setq server-clients (cons (cons proc nil)
			       server-clients))))

;;;###autoload
(defun server-getenv (variable &optional frame)
  "Get the value of VARIABLE in the client environment of frame FRAME.
VARIABLE should be a string.  Value is nil if VARIABLE is undefined in
the environment.  Otherwise, value is a string.

If FRAME is an emacsclient frame, then the variable is looked up
in the environment of the emacsclient process; otherwise the
function consults the environment of the Emacs process.

If FRAME is nil or missing, then the selected frame is used."
  (when (not frame) (setq frame (selected-frame)))
  (let ((client (frame-parameter frame 'client)) env)
    (if (null client)
	(getenv variable)
      (setq env (server-client-get client 'environment))
      (if (null env)
	  (getenv variable)
	(cdr (assoc variable env))))))

(defmacro server-with-client-environment (client vars &rest body)
  "Evaluate BODY with environment variables VARS set to those of CLIENT.
The environment variables are then restored to their previous values.

VARS should be a list of strings."
  (declare (indent 2))
  (let ((oldvalues (make-symbol "oldvalues"))
	(var (make-symbol "var"))
	(value (make-symbol "value"))
	(pair (make-symbol "pair")))
    `(let (,oldvalues)
       (dolist (,var (quote ,vars))
	 (let ((,value (cdr (assoc ,var (server-client-get ,client 'environment)))))
	   (setq ,oldvalues (cons (cons ,var (getenv ,var)) ,oldvalues))
	   (setenv ,var ,value)))
       (unwind-protect
	   (progn ,@body)
	 (dolist (,pair ,oldvalues)

`-version CLIENT-VERSION'
  Check version numbers between server and client, and signal an
  error if there is a mismatch.  The server replies with
  `-good-version' to confirm the match.

`-env NAME VALUE'
  An environment variable on the client side.

`-current-frame'
  Forbid the creation of new frames.

					default-file-name-coding-system)))
		(client (server-client proc))
		current-frame
		nowait ; t if emacsclient does not want to wait for us.
		frame ; The frame that was opened for the client (if any).
		display ; Open the frame on this display.
		dontkill       ; t if the client should not be killed.
		(files nil)
		(lineno 1)
		(columnno 0))
	    ;; Remove this line from STRING.
	    (setq string (substring string (match-end 0)))

		 ;; -current-frame:  Don't create frames.
		 ((equal "-current-frame" arg) (setq current-frame t))

		 ;; -display DISPLAY:
		 ;; Open X frames on the given instead of the default.
		 ((and (equal "-display" arg) (string-match "\\([^ ]*\\) " request))
		  (setq display (match-string 1 request)
			request (substring request (match-end 0))))

		 ;; -window-system:  Open a new X frame.

			  ;; the moment.
			  (modify-frame-parameters frame params)
			  (select-frame frame)
			  (server-client-set client 'frame frame)
			  (server-client-set client 'device (frame-display frame))
			  (setq dontkill t))
		      ;; This emacs does not support X.
		      (server-log "Window system unsupported" proc)
		      (server-send-string proc "-window-system-unsupported \n")
		      (setq dontkill t))))

			(type (server-unquote-arg (match-string 2 request))))
		    (setq request (substring request (match-end 0)))
		    (unless (server-client-get client 'version)
		      (error "Protocol error; make sure you use the correct version of emacsclient"))
		    (unless current-frame
		      (server-with-client-environment proc
			  ("LANG" "LC_CTYPE" "LC_ALL"
			   ;; For tgetent(3); list according to ncurses(3).
			   "BAUDRATE" "COLUMNS" "ESCDELAY" "HOME" "LINES"
			   "NCURSES_ASSUMED_COLORS" "NCURSES_NO_PADDING"
			   "NCURSES_NO_SETBUF" "TERM" "TERMCAP" "TERMINFO"
			   "TERMINFO_DIRS" "TERMPATH")
			(setq frame (make-frame-on-tty tty type
						       ;; Ignore nowait here; we always need to clean
						       ;; up opened ttys when the client dies.
						       `((client . ,proc)))))
		      (select-frame frame)
		      (server-client-set client 'frame frame)
		      (server-client-set client 'tty (display-name frame))
		      (server-client-set client 'device (frame-display frame))

		      ;; Reply with our pid.
		      (server-send-string proc (concat "-emacs-pid " (number-to-string (emacs-pid)) "\n"))
		      (setq dontkill t))))

					   (buffer-substring-no-properties (point-min)
									   (point-max)))))))))
		    (setq lineno 1
			  columnno 0)))

		 ;; -env NAME VALUE:  An environment variable.
		 ((and (equal "-env" arg) (string-match "\\([^ ]+\\) \\([^ ]+\\) " request))
		  (let ((name (server-unquote-arg (match-string 1 request)))
			(value (server-unquote-arg (match-string 2 request))))
		    (when coding-system
			(setq name (decode-coding-string name coding-system))
			(setq value (decode-coding-string value coding-system)))
		    (setq request (substring request (match-end 0)))
		    (server-client-set
		     client 'environment
		     (cons (cons name value)
			   (server-client-get client 'environment)))))

		 ;; Unknown command.
		 (t (error "Unknown command: %s" arg)))))

	    (let (buffers)

		(switch-to-buffer next-buffer)
	      ;; After all the above, we might still have ended up with
	      ;; a minibuffer/dedicated-window (if there's no other).
	      (error (pop-to-buffer next-buffer)))))))))

(defun server-save-buffers-kill-display (&optional arg)
  "Offer to save each buffer, then kill the current connection.
If the current frame has no client, kill Emacs itself.

With prefix arg, silently save all file-visiting buffers, then kill.

If emacsclient was started with a list of filenames to edit, then
only these files will be asked to be saved."
  (interactive "P")
  (let ((proc (frame-parameter (selected-frame) 'client))
	(frame (selected-frame)))
    (if proc
	(let ((buffers (server-client-get proc 'buffers)))
	  ;; If client is bufferless, emulate a normal Emacs session
	  ;; exit and offer to save all buffers.  Otherwise, offer to
	  ;; save only the buffers belonging to the client.
	  (save-some-buffers arg
			     (if buffers
				 (lambda () (memq (current-buffer) buffers))
			       t))
	  (server-delete-client proc)
	  (when (frame-live-p frame)
	    (delete-frame frame)))
      (save-buffers-kill-emacs))))

(define-key ctl-x-map "#" 'server-edit)

(defun server-unload-hook ()
  "Unload the server library."

83403:51eb0aa362f3

New clients have no properties."
  (unless (server-client proc)
    (setq server-clients (cons (cons proc nil)
			       server-clients))))

(defun server-getenv-from (env variable)
  "Get the value of VARIABLE in ENV.
VARIABLE should be a string.  Value is nil if VARIABLE is
undefined in ENV.  Otherwise, value is a string.

ENV should be in the same format as `process-environment'."
  (let (entry result)
    (while (and env (null result))
      (setq entry (car env)
	    env (cdr env))
      (if (and (> (length entry) (length variable))
	       (eq ?= (aref entry (length variable)))
	       (equal variable (substring entry 0 (length variable))))
	  (setq result (substring entry (+ (length variable) 1)))))
    result))

(defmacro server-with-environment (env vars &rest body)
  "Evaluate BODY with environment variables VARS set to those in ENV.
The environment variables are then restored to their previous values.

VARS should be a list of strings.
ENV should be in the same format as `process-environment'."
  (declare (indent 2))
  (let ((oldvalues (make-symbol "oldvalues"))
	(var (make-symbol "var"))
	(value (make-symbol "value"))
	(pair (make-symbol "pair")))
    `(let (,oldvalues)
       (dolist (,var ,vars)
	 (let ((,value (server-getenv-from ,env ,var)))
	   (setq ,oldvalues (cons (cons ,var (getenv ,var)) ,oldvalues))
	   (setenv ,var ,value)))
       (unwind-protect
	   (progn ,@body)
	 (dolist (,pair ,oldvalues)

`-version CLIENT-VERSION'
  Check version numbers between server and client, and signal an
  error if there is a mismatch.  The server replies with
  `-good-version' to confirm the match.

`-env NAME=VALUE'
  An environment variable on the client side.

`-current-frame'
  Forbid the creation of new frames.

					default-file-name-coding-system)))
		(client (server-client proc))
		current-frame
		nowait ; t if emacsclient does not want to wait for us.
		frame ; The frame that was opened for the client (if any).
		display		     ; Open the frame on this display.
		dontkill       ; t if the client should not be killed.
		env
		(files nil)
		(lineno 1)
		(columnno 0))
	    ;; Remove this line from STRING.
	    (setq string (substring string (match-end 0)))

		 ;; -current-frame:  Don't create frames.
		 ((equal "-current-frame" arg) (setq current-frame t))

		 ;; -display DISPLAY:
		 ;; Open X frames on the given display instead of the default.
		 ((and (equal "-display" arg) (string-match "\\([^ ]*\\) " request))
		  (setq display (match-string 1 request)
			request (substring request (match-end 0))))

		 ;; -window-system:  Open a new X frame.

			  ;; the moment.
			  (modify-frame-parameters frame params)
			  (select-frame frame)
			  (server-client-set client 'frame frame)
			  (server-client-set client 'device (frame-display frame))
			  (set-terminal-parameter frame 'environment env)
			  (setq dontkill t))
		      ;; This emacs does not support X.
		      (server-log "Window system unsupported" proc)
		      (server-send-string proc "-window-system-unsupported \n")
		      (setq dontkill t))))

			(type (server-unquote-arg (match-string 2 request))))
		    (setq request (substring request (match-end 0)))
		    (unless (server-client-get client 'version)
		      (error "Protocol error; make sure you use the correct version of emacsclient"))
		    (unless current-frame
		      (server-with-environment env
			  '("LANG" "LC_CTYPE" "LC_ALL"
			    ;; For tgetent(3); list according to ncurses(3).
			    "BAUDRATE" "COLUMNS" "ESCDELAY" "HOME" "LINES"
			    "NCURSES_ASSUMED_COLORS" "NCURSES_NO_PADDING"
			    "NCURSES_NO_SETBUF" "TERM" "TERMCAP" "TERMINFO"
			    "TERMINFO_DIRS" "TERMPATH")
			(setq frame (make-frame-on-tty tty type
						       ;; Ignore nowait here; we always need to clean
						       ;; up opened ttys when the client dies.
						       `((client . ,proc)))))
		      (select-frame frame)
		      (server-client-set client 'frame frame)
		      (server-client-set client 'tty (display-name frame))
		      (server-client-set client 'device (frame-display frame))
		      (set-terminal-parameter frame 'environment env)

		      ;; Reply with our pid.
		      (server-send-string proc (concat "-emacs-pid " (number-to-string (emacs-pid)) "\n"))
		      (setq dontkill t))))

					   (buffer-substring-no-properties (point-min)
									   (point-max)))))))))
		    (setq lineno 1
			  columnno 0)))

		 ;; -env NAME=VALUE:  An environment variable.
		 ((and (equal "-env" arg) (string-match "\\([^ ]+\\) " request))
		  (let ((var (server-unquote-arg (match-string 1 request))))
		    (when coding-system
		      (setq var (decode-coding-string var coding-system)))
		    (setq request (substring request (match-end 0)))
		    (setq env (cons var env))))

		 ;; Unknown command.
		 (t (error "Unknown command: %s" arg)))))

	    (let (buffers)

		(switch-to-buffer next-buffer)
	      ;; After all the above, we might still have ended up with
	      ;; a minibuffer/dedicated-window (if there's no other).
	      (error (pop-to-buffer next-buffer)))))))))

;;;###autoload
(defun server-save-buffers-kill-display (proc &optional arg)
  "Offer to save each buffer, then kill PROC.

With prefix arg, silently save all file-visiting buffers, then kill.

If emacsclient was started with a list of filenames to edit, then
only these files will be asked to be saved."
  (let ((buffers (server-client-get proc 'buffers)))
    ;; If client is bufferless, emulate a normal Emacs session
    ;; exit and offer to save all buffers.  Otherwise, offer to
    ;; save only the buffers belonging to the client.
    (save-some-buffers arg
		       (if buffers
			   (lambda () (memq (current-buffer) buffers))
			 t))
    (server-delete-client proc)))

(define-key ctl-x-map "#" 'server-edit)

(defun server-unload-hook ()
  "Unload the server library."