Commit 59e085e0 authored by Karoly Lorentey's avatar Karoly Lorentey

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: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-443
parent e3362ceb
......@@ -695,26 +695,19 @@ To start the server in Emacs, type \"M-x server-start\".\n",
fprintf (out, "-version %s ", VERSION);
/* Send over our environment. */
{
extern char **environ;
int i;
for (i = 0; environ[i]; i++)
{
char *name = xstrdup (environ[i]);
char *value = strchr (name, '=');
if (value && strlen (value) > 1)
{
*value++ = 0;
fprintf (out, "-env ");
quote_argument (name, out);
fprintf (out, " ");
quote_argument (value, out);
fprintf (out, " ");
fflush (out);
}
free (name);
}
}
if (!current_frame)
{
extern char **environ;
int i;
for (i = 0; environ[i]; i++)
{
char *name = xstrdup (environ[i]);
char *value = strchr (name, '=');
fprintf (out, "-env ");
quote_argument (environ[i], out);
fprintf (out, " ");
}
}
retry:
if (nowait)
......
......@@ -4875,6 +4875,22 @@ With prefix arg, silently save all file-visiting buffers, then kill."
(or (null confirm-kill-emacs)
(funcall confirm-kill-emacs "Really exit Emacs? "))
(kill-emacs)))
(defun 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 (null proc)
(save-buffers-kill-emacs)
(server-save-buffers-kill-display proc arg))))
;; We use /: as a prefix to "quote" a file name
;; so that magic file name handlers will not apply to it.
......@@ -4972,7 +4988,7 @@ With prefix arg, silently save all file-visiting buffers, then kill."
(define-key ctl-x-map "i" 'insert-file)
(define-key esc-map "~" 'not-modified)
(define-key ctl-x-map "\C-d" 'list-directory)
(define-key ctl-x-map "\C-c" 'server-save-buffers-kill-display)
(define-key ctl-x-map "\C-c" 'save-buffers-kill-display)
(define-key ctl-x-map "\C-q" 'toggle-read-only)
(define-key ctl-x-4-map "f" 'find-file-other-window)
......
......@@ -1511,6 +1511,60 @@ selected frame's terminal)."
(add-hook 'delete-frame-functions 'terminal-handle-delete-frame)
(defun terminal-getenv (variable &optional terminal)
"Get the value of VARIABLE in the client environment of TERMINAL.
VARIABLE should be a string. Value is nil if VARIABLE is undefined in
the environment. Otherwise, value is a string.
If TERMINAL was created by an emacsclient invocation, then the
variable is looked up in the environment of the emacsclient
process; otherwise the function consults the environment of the
Emacs process.
TERMINAL can be a terminal id, a frame, or nil (meaning the
selected frame's terminal)."
(setq terminal (terminal-id terminal))
(if (not (terminal-parameter-p terminal 'environment))
(getenv variable)
(let ((env (terminal-parameter terminal 'environment))
result entry)
(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)))))
(if (null result)
(getenv variable)
result))))
(defmacro with-terminal-environment (terminal vars &rest body)
"Evaluate BODY with environment variables VARS set to those of TERMINAL.
The environment variables are then restored to their previous values.
VARS should be a list of strings.
TERMINAL can be a terminal id, a frame, or nil (meaning the
selected frame's terminal).
See also `terminal-getenv'."
(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 (terminal-getenv ,var ,terminal)))
(setq ,oldvalues (cons (cons ,var (getenv ,var)) ,oldvalues))
(setenv ,var ,value)))
(unwind-protect
(progn ,@body)
(dolist (,pair ,oldvalues)
(setenv (car ,pair) (cdr ,pair)))))))
(provide 'frame)
;; arch-tag: 82979c70-b8f2-4306-b2ad-ddbd6b328b56
......
......@@ -2449,7 +2449,7 @@ See also `locale-charset-language-names', `locale-language-names',
(let ((vars '("LC_ALL" "LC_CTYPE" "LANG")))
(while (and vars
(= 0 (length locale))) ; nil or empty string
(setq locale (server-getenv (pop vars))))))
(setq locale (terminal-getenv (pop vars))))))
(unless locale
;; The two tests are kept separate so the byte-compiler sees
......@@ -2562,7 +2562,7 @@ See also `locale-charset-language-names', `locale-language-names',
;; Mac OS X's Terminal.app by default uses utf-8 regardless of
;; the locale.
(when (and (null window-system)
(equal (server-getenv "TERM_PROGRAM") "Apple_Terminal"))
(equal (terminal-getenv "TERM_PROGRAM") "Apple_Terminal"))
(set-terminal-coding-system 'utf-8)
(set-keyboard-coding-system 'utf-8)))
......@@ -2580,7 +2580,7 @@ See also `locale-charset-language-names', `locale-language-names',
(setq ps-paper-type 'a4)))
(let ((vars '("LC_ALL" "LC_PAPER" "LANG")))
(while (and vars (= 0 (length locale)))
(setq locale (server-getenv (pop vars)))))
(setq locale (terminal-getenv (pop vars)))))
(when locale
;; As of glibc 2.2.5, these are the only US Letter locales,
;; and the rest are A4.
......
This diff is collapsed.
......@@ -167,7 +167,6 @@
(load "vmsproc")))
(load "abbrev")
(load "buff-menu")
(load "server") ; server-getenv is used throughout the terminal initialization code
(if (fboundp 'x-create-frame)
(progn
......
......@@ -209,39 +209,36 @@ New clients have no properties."
(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.
(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."
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 (quote ,vars))
(let ((,value (cdr (assoc ,var (server-client-get ,client 'environment)))))
(dolist (,var ,vars)
(let ((,value (server-getenv-from ,env ,var)))
(setq ,oldvalues (cons (cons ,var (getenv ,var)) ,oldvalues))
(setenv ,var ,value)))
(unwind-protect
......@@ -483,7 +480,7 @@ The following commands are accepted by the server:
error if there is a mismatch. The server replies with
`-good-version' to confirm the match.
`-env NAME VALUE'
`-env NAME=VALUE'
An environment variable on the client side.
`-current-frame'
......@@ -571,8 +568,9 @@ The following commands are accepted by the client:
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.
display ; Open the frame on this display.
dontkill ; t if the client should not be killed.
env
(files nil)
(lineno 1)
(columnno 0))
......@@ -605,7 +603,7 @@ The following commands are accepted by the client:
((equal "-current-frame" arg) (setq current-frame t))
;; -display DISPLAY:
;; Open X frames on the given instead of the default.
;; 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))))
......@@ -639,6 +637,7 @@ The following commands are accepted by the client:
(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)
......@@ -675,13 +674,13 @@ The following commands are accepted by the client:
(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")
(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.
......@@ -690,6 +689,7 @@ The following commands are accepted by the client:
(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"))
......@@ -737,18 +737,13 @@ The following commands are accepted by the client:
(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))))
;; -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 name (decode-coding-string name coding-system))
(setq value (decode-coding-string value coding-system)))
(setq var (decode-coding-string var coding-system)))
(setq request (substring request (match-end 0)))
(server-client-set
client 'environment
(cons (cons name value)
(server-client-get client 'environment)))))
(setq env (cons var env))))
;; Unknown command.
(t (error "Unknown command: %s" arg)))))
......@@ -1053,30 +1048,23 @@ done that."
;; 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.
;;;###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."
(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))))
(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)
......
......@@ -26,8 +26,6 @@
;;; Code:
(require 'server)
(defvar rxvt-function-map nil
"Function key overrides for rxvt.")
......@@ -293,7 +291,7 @@ for the currently selected frame."
;; intelligent way than the default guesswork in startup.el.
(defun rxvt-set-background-mode ()
"Set background mode as appropriate for the default rxvt colors."
(let ((fgbg (server-getenv "COLORFGBG"))
(let ((fgbg (terminal-getenv "COLORFGBG"))
bg rgb)
(setq default-frame-background-mode 'light)
(when (and fgbg
......
......@@ -82,7 +82,6 @@
(require 'menu-bar)
(require 'fontset)
(require 'x-dnd)
(require 'server)
(defvar x-invocation-args)
(defvar x-keysym-table)
......@@ -2408,7 +2407,7 @@ order until succeed.")
(aset x-resource-name i ?-))))
(x-open-connection (or x-display-name
(setq x-display-name (server-getenv "DISPLAY")))
(setq x-display-name (terminal-getenv "DISPLAY")))
x-command-line-resources
;; Exit Emacs with fatal error if this fails and we
;; are the initial display.
......
......@@ -26,8 +26,6 @@
;;; Code:
(require 'server)
(defvar xterm-function-map nil
"Function key map overrides for xterm.")
......@@ -194,8 +192,8 @@
;; rxvt terminals sometimes set the TERM variable to "xterm", but
;; rxvt's keybindings that are incompatible with xterm's. It is
;; better in that case to use rxvt's initializion function.
(if (and (server-getenv "COLORTERM")
(string-match "\\`rxvt" (server-getenv "COLORTERM")))
(if (and (terminal-getenv "COLORTERM")
(string-match "\\`rxvt" (terminal-getenv "COLORTERM")))
(progn
(eval-and-compile (load "term/rxvt"))
(terminal-init-rxvt))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment