Commit 36ab8612 authored by Miles Bader's avatar Miles Bader
Browse files

Rudimentary fix for environment variable handling.

* lisp/env.el (getenv): Restore David Kastrup's fix.
(environment): Add optional frame parameter.

* lisp/mule-cmds.el (set-locale-environment): Fix getenv call.
* lisp/term/rxvt.el (rxvt-set-background-mode): Ditto.
* lisp/x-win.el (x-initialize-window-system, terminal-init-xterm): Ditto.

* lisp/server.el (server-with-environment): Restore the original environment.

Revision: emacs@sv.gnu.org/emacs--multi-tty--0--patch-6
Creator:  Karoly Lorentey <karoly@lorentey.hu>
parent a9683a70
...@@ -19,13 +19,8 @@ nice if they could connect to this instance from a remote ssh session ...@@ -19,13 +19,8 @@ nice if they could connect to this instance from a remote ssh session
and check their messages without opening a remote X frame or resorting and check their messages without opening a remote X frame or resorting
to gnus-slave. to gnus-slave.
WHO IS DOING IT THANKS
--------------- ------
I'm Károly Lőrentey. My address: lorentey@elte.hu.
Comments, bug reports, suggestions and patches are welcome; send them
to multi-tty@lists.fnord.hu.
The following is a (sadly incomplete) list of people who have The following is a (sadly incomplete) list of people who have
contributed to the project by testing, submitting patches, bug contributed to the project by testing, submitting patches, bug
...@@ -70,21 +65,6 @@ Richard Stallman was kind enough to review an earlier version of my ...@@ -70,21 +65,6 @@ Richard Stallman was kind enough to review an earlier version of my
patches. patches.
MAILING LISTS
-------------
The multi-tty mailing list (discussion & bug reports):
Address: multi-tty@lists.fnord.hu
Signup: http://lists.fnord.hu/mailman/listinfo/multi-tty
Archive: http://news.gmane.org/gmane.emacs.multi-tty/
Commit notifications (read-only):
Address: multi-tty-commits@lists.fnord.hu
Signup: http://lists.fnord.hu/mailman/listinfo/multi-tty-commits
STATUS STATUS
------ ------
...@@ -107,13 +87,14 @@ few tricky test cases for you. ...@@ -107,13 +87,14 @@ few tricky test cases for you.
Known problems: Known problems:
* GTK support. If you compile your Emacs with the GTK * GTK support. If you compile your Emacs with the GTK
toolkit, some functionality of multi-tty will be lost. In toolkit, some functionality of multi-tty may be lost. In
particular, you will not be able to work on multiple X particular, you may get crashes while working on multiple X
displays at once. Current releases of GTK have limitations displays at once. Previous releases of GTK had limitations
and bugs that prevent full-blown multi-display support in and bugs that prevented full-blown multi-display support in
Emacs. (GTK crashes when Emacs tries to disconnect from an Emacs. (GTK crashed when Emacs tries to disconnect from an
X server.) Use the Lucid toolkit if you want to see a X server.) Things are much improved in the current GTK
complete feature set. version, but if you do experience crashes in libgtk, try
compiling Emacs with the Lucid toolkit instead.
* The single-kboard mode. * The single-kboard mode.
...@@ -154,68 +135,12 @@ Known problems: ...@@ -154,68 +135,12 @@ Known problems:
HOW TO GET THE BRANCH HOW TO GET THE BRANCH
--------------------- ---------------------
The branch uses Bazaar 1 (http://bazaar.canonical.com) for version control. To get the branch, check out the "multi-tty" CVS branch from Emacs CVS.
Retrieving the latest version of the branch:
baz register-archive -f http://aszt.inf.elte.hu/~lorentey/mirror/arch/2004
baz get lorentey@elte.hu--2004/emacs--multi-tty <directory>
This incantation uses an archive mirror that is hosted on a
high-bandwidth site. Please note that on average there is a two-hour
delay for commits to arrive on this mirror. My primary mirror is on the
low-bandwidth http://lorentey.hu/ site:
baz register-archive -f http://lorentey.hu/arch/2004/
baz get lorentey@elte.hu--2004/emacs--multi-tty <directory>
This is "instantly" updated, but very slow from outside Hungary. Alternatively, you can use Bazaar version 1 (not 2) or tla:
(By "instantly" I mean as soon as I connect the notebook I work on to
a network. It could take days.)
The Arch supermirror provides mirroring services for all public Arch baz register-archive http://arch.sv.gnu.org/archives/emacs
repositories. We have a mirror there, too, if you prefer. baz get emacs@sv.gnu.org/emacs--multi-tty--0 <directory>
baz register-archive -f http://mirrors.sourcecontrol.net/lorentey%40elte.hu--2004
baz get lorentey@elte.hu--2004/emacs--multi-tty <directory>
My GPG key id is 0FB27A3F; it is available from
hkp://wwwkeys.eu.pgp.net/, or from my homepage at
http://lorentey.hu/rolam/gpg.html)
Don't worry if the above checkout takes a few minutes to complete;
once you have a source tree, updating it to the latest revision will
be _much_ faster. Use the following command for the update:
baz replay
You can find more information about Bazaar on
http://bazaar.canonical.com/. It's a distributed source control
system that is somewhat less broken than competing projects.
If you don't have Bazaar, the branch has a homepage from which you can
download conventional patches against Emacs CVS HEAD:
http://lorentey.hu/project/emacs.html
I suggest you use Bazaar whenever feasible.
DEBIAN PACKAGES
---------------
If you run Debian, or a distribution based on Debian, you are welcome
to use our binary packages; put these lines in your /etc/apt/sources.list:
# Multi-tty Emacs
deb http://aszt.inf.elte.hu/~lorentey/mirror/apt unstable multi-tty
deb-src http://aszt.inf.elte.hu/~lorentey/mirror/apt unstable multi-tty
Note that these packages are intended solely to provide an easy way to
test the new multi-tty features. They are not to be taken as Emacs
releases, and it's a mistake to expect robust operation or any kind of
timely support for them. Do not install them, unless you'd like to
have your editor crash on you.
COMPILATION COMPILATION
...@@ -225,7 +150,7 @@ The multi-tty branch is compiled the same way as Emacs itself: ...@@ -225,7 +150,7 @@ The multi-tty branch is compiled the same way as Emacs itself:
make maintainer-clean # (If you have compiled Emacs before) make maintainer-clean # (If you have compiled Emacs before)
./configure --without-gtk <your favourite options> ./configure <your favourite options>
make bootstrap make bootstrap
make install make install
...@@ -262,8 +187,9 @@ exit emacs, all terminals should be restored to their previous states. ...@@ -262,8 +187,9 @@ exit emacs, all terminals should be restored to their previous states.
This is work in progress, and probably full of bugs. It is a good This is work in progress, and probably full of bugs. It is a good
idea to run emacs from gdb, so that you'll have a live instance to idea to run emacs from gdb, so that you'll have a live instance to
debug if something goes wrong. Please send me your bug reports on our debug if something goes wrong. Please send your bug reports to
mailing list: multi-tty@lists.fnord.hu emacs-devel@gnu.org. Please don't forget to mention that you are
using the multi-tty branch.
TIPS & TRICKS TIPS & TRICKS
------------- -------------
...@@ -348,8 +274,7 @@ following: ...@@ -348,8 +274,7 @@ following:
CHANGELOG CHANGELOG
--------- ---------
See arch logs. See the ChangeLog.multi-tty files in the source tree.
NEWS NEWS
---- ----
......
...@@ -212,20 +212,24 @@ in the environment list of the selected frame." ...@@ -212,20 +212,24 @@ in the environment list of the selected frame."
(let ((value (getenv-internal (if (multibyte-string-p variable) (let ((value (getenv-internal (if (multibyte-string-p variable)
(encode-coding-string (encode-coding-string
variable locale-coding-system) variable locale-coding-system)
variable)))) variable)
frame)))
(if (and enable-multibyte-characters value) (if (and enable-multibyte-characters value)
(setq value (decode-coding-string value locale-coding-system))) (setq value (decode-coding-string value locale-coding-system)))
(when (interactive-p) (when (interactive-p)
(message "%s" (if value value "Not set"))) (message "%s" (if value value "Not set")))
value)) value))
(defun environment () (defun environment (&optional frame)
"Return a list of environment variables with their values. "Return a list of environment variables with their values.
Each entry in the list is a string of the form NAME=VALUE. Each entry in the list is a string of the form NAME=VALUE.
The returned list can not be used to change environment The returned list can not be used to change environment
variables, only read them. See `setenv' to do that. variables, only read them. See `setenv' to do that.
If optional parameter FRAME is non-nil, then it should be a
frame. The function returns the environment of that frame.
The list is constructed by concatenating the elements of The list is constructed by concatenating the elements of
`process-environment' and the 'environment parameter of the `process-environment' and the 'environment parameter of the
selected frame, and removing duplicated and empty values. selected frame, and removing duplicated and empty values.
...@@ -234,7 +238,7 @@ Non-ASCII characters are encoded according to the initial value of ...@@ -234,7 +238,7 @@ Non-ASCII characters are encoded according to the initial value of
`locale-coding-system', i.e. the elements must normally be decoded for use. `locale-coding-system', i.e. the elements must normally be decoded for use.
See `setenv' and `getenv'." See `setenv' and `getenv'."
(let* ((env (append process-environment (let* ((env (append process-environment
(frame-parameter (frame-with-environment) (frame-parameter (frame-with-environment frame)
'environment) 'environment)
nil)) nil))
(scan env) (scan env)
......
...@@ -2454,7 +2454,7 @@ is returned. Thus, for instance, if charset \"ISO8859-2\", ...@@ -2454,7 +2454,7 @@ is returned. Thus, for instance, if charset \"ISO8859-2\",
;; too, for setting things such as calendar holidays, ps-print paper ;; too, for setting things such as calendar holidays, ps-print paper
;; size, spelling dictionary. ;; size, spelling dictionary.
(defun set-locale-environment (&optional locale-name display) (defun set-locale-environment (&optional locale-name frame)
"Set up multi-lingual environment for using LOCALE-NAME. "Set up multi-lingual environment for using LOCALE-NAME.
This sets the language environment, the coding system priority, This sets the language environment, the coding system priority,
the default input method and sometimes other things. the default input method and sometimes other things.
...@@ -2475,10 +2475,9 @@ directory named `/usr/share/locale' or `/usr/lib/locale'. LOCALE-NAME ...@@ -2475,10 +2475,9 @@ directory named `/usr/share/locale' or `/usr/lib/locale'. LOCALE-NAME
will be translated according to the table specified by will be translated according to the table specified by
`locale-translation-file-name'. `locale-translation-file-name'.
If DISPLAY is non-nil, only set the keyboard coding system and If FRAME is non-nil, only set the keyboard coding system and the
the terminal coding system for the given display, and don't touch terminal coding system for the terminal of that frame, and don't
session-global parameters like the language environment. DISPLAY touch session-global parameters like the language environment.
may be a display id or a frame.
See also `locale-charset-language-names', `locale-language-names', See also `locale-charset-language-names', `locale-language-names',
`locale-preferred-coding-systems' and `locale-coding-system'." `locale-preferred-coding-systems' and `locale-coding-system'."
...@@ -2509,7 +2508,7 @@ See also `locale-charset-language-names', `locale-language-names', ...@@ -2509,7 +2508,7 @@ See also `locale-charset-language-names', `locale-language-names',
(let ((vars '("LC_ALL" "LC_CTYPE" "LANG"))) (let ((vars '("LC_ALL" "LC_CTYPE" "LANG")))
(while (and vars (while (and vars
(= 0 (length locale))) ; nil or empty string (= 0 (length locale))) ; nil or empty string
(setq locale (getenv (pop vars) display))))) (setq locale (getenv (pop vars) frame)))))
(unless locale (unless locale
;; The two tests are kept separate so the byte-compiler sees ;; The two tests are kept separate so the byte-compiler sees
...@@ -2583,7 +2582,7 @@ See also `locale-charset-language-names', `locale-language-names', ...@@ -2583,7 +2582,7 @@ See also `locale-charset-language-names', `locale-language-names',
;; Set up for this character set. This is now the right way ;; Set up for this character set. This is now the right way
;; to do it for both unibyte and multibyte modes. ;; to do it for both unibyte and multibyte modes.
(unless display (unless frame
(set-language-environment language-name)) (set-language-environment language-name))
;; If default-enable-multibyte-characters is nil, ;; If default-enable-multibyte-characters is nil,
...@@ -2591,7 +2590,7 @@ See also `locale-charset-language-names', `locale-language-names', ...@@ -2591,7 +2590,7 @@ See also `locale-charset-language-names', `locale-language-names',
;; so the display table and terminal coding system are irrelevant. ;; so the display table and terminal coding system are irrelevant.
(when default-enable-multibyte-characters (when default-enable-multibyte-characters
(set-display-table-and-terminal-coding-system (set-display-table-and-terminal-coding-system
language-name coding-system display)) language-name coding-system frame))
;; Set the `keyboard-coding-system' if appropriate (tty ;; Set the `keyboard-coding-system' if appropriate (tty
;; only). At least X and MS Windows can generate ;; only). At least X and MS Windows can generate
...@@ -2603,13 +2602,13 @@ See also `locale-charset-language-names', `locale-language-names', ...@@ -2603,13 +2602,13 @@ See also `locale-charset-language-names', `locale-language-names',
(let ((kcs (or coding-system (let ((kcs (or coding-system
(car (get-language-info language-name (car (get-language-info language-name
'coding-system))))) 'coding-system)))))
(if kcs (set-keyboard-coding-system kcs display))) (if kcs (set-keyboard-coding-system kcs frame)))
(unless display (unless frame
(setq locale-coding-system (setq locale-coding-system
(car (get-language-info language-name 'coding-priority))))) (car (get-language-info language-name 'coding-priority)))))
(when (and (not display) (when (and (not frame)
coding-system coding-system
(not (coding-system-equal coding-system (not (coding-system-equal coding-system
locale-coding-system))) locale-coding-system)))
...@@ -2625,9 +2624,9 @@ See also `locale-charset-language-names', `locale-language-names', ...@@ -2625,9 +2624,9 @@ See also `locale-charset-language-names', `locale-language-names',
(when (boundp 'w32-ansi-code-page) (when (boundp 'w32-ansi-code-page)
(let ((code-page-coding (intern (format "cp%d" w32-ansi-code-page)))) (let ((code-page-coding (intern (format "cp%d" w32-ansi-code-page))))
(when (coding-system-p code-page-coding) (when (coding-system-p code-page-coding)
(unless display (setq locale-coding-system code-page-coding)) (unless frame (setq locale-coding-system code-page-coding))
(set-keyboard-coding-system code-page-coding display) (set-keyboard-coding-system code-page-coding frame)
(set-terminal-coding-system code-page-coding display)))) (set-terminal-coding-system code-page-coding frame))))
(when (eq system-type 'darwin) (when (eq system-type 'darwin)
;; On Darwin, file names are always encoded in utf-8, no matter ;; On Darwin, file names are always encoded in utf-8, no matter
...@@ -2636,13 +2635,13 @@ See also `locale-charset-language-names', `locale-language-names', ...@@ -2636,13 +2635,13 @@ See also `locale-charset-language-names', `locale-language-names',
;; Mac OS X's Terminal.app by default uses utf-8 regardless of ;; Mac OS X's Terminal.app by default uses utf-8 regardless of
;; the locale. ;; the locale.
(when (and (null window-system) (when (and (null window-system)
(equal (getenv "TERM_PROGRAM" display) "Apple_Terminal")) (equal (getenv "TERM_PROGRAM" frame) "Apple_Terminal"))
(set-terminal-coding-system 'utf-8) (set-terminal-coding-system 'utf-8)
(set-keyboard-coding-system 'utf-8))) (set-keyboard-coding-system 'utf-8)))
;; Default to A4 paper if we're not in a C, POSIX or US locale. ;; Default to A4 paper if we're not in a C, POSIX or US locale.
;; (See comments in Flocale_info.) ;; (See comments in Flocale_info.)
(unless display (unless frame
(let ((locale locale) (let ((locale locale)
(paper (locale-info 'paper))) (paper (locale-info 'paper)))
(if paper (if paper
...@@ -2654,7 +2653,7 @@ See also `locale-charset-language-names', `locale-language-names', ...@@ -2654,7 +2653,7 @@ See also `locale-charset-language-names', `locale-language-names',
(setq ps-paper-type 'a4))) (setq ps-paper-type 'a4)))
(let ((vars '("LC_ALL" "LC_PAPER" "LANG"))) (let ((vars '("LC_ALL" "LC_PAPER" "LANG")))
(while (and vars (= 0 (length locale))) (while (and vars (= 0 (length locale)))
(setq locale (getenv (pop vars) display)))) (setq locale (getenv (pop vars) frame))))
(when locale (when locale
;; As of glibc 2.2.5, these are the only US Letter locales, ;; As of glibc 2.2.5, these are the only US Letter locales,
;; and the rest are A4. ;; and the rest are A4.
......
...@@ -268,19 +268,21 @@ The environment variables are then restored to their previous values. ...@@ -268,19 +268,21 @@ 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'." ENV should be in the same format as `process-environment'."
(declare (indent 2)) (declare (indent 2))
(let ((oldvalues (make-symbol "oldvalues")) (let ((old-env (make-symbol "old-env"))
(var (make-symbol "var")) (var (make-symbol "var"))
(value (make-symbol "value")) (value (make-symbol "value"))
(pair (make-symbol "pair"))) (pair (make-symbol "pair")))
`(let (,oldvalues) `(let ((,old-env process-environment))
(dolist (,var ,vars) (dolist (,var ,vars)
(let ((,value (server-getenv-from ,env ,var))) (let ((,value (server-getenv-from ,env ,var)))
(setq ,oldvalues (cons (cons ,var (getenv ,var)) ,oldvalues)) (setq process-environment
(setenv ,var ,value))) (cons (if (null ,value)
,var
(concat ,var "=" ,value))
process-environment))))
(unwind-protect (unwind-protect
(progn ,@body) (progn ,@body)
(dolist (,pair ,oldvalues) (setq process-environment ,old-env)))))
(setenv (car ,pair) (cdr ,pair)))))))
(defun server-delete-client (client &optional noframe) (defun server-delete-client (client &optional noframe)
"Delete CLIENT, including its buffers, terminals and frames. "Delete CLIENT, including its buffers, terminals and frames.
......
...@@ -284,7 +284,7 @@ for the currently selected frame." ...@@ -284,7 +284,7 @@ for the currently selected frame."
;; intelligent way than the default guesswork in startup.el. ;; intelligent way than the default guesswork in startup.el.
(defun rxvt-set-background-mode () (defun rxvt-set-background-mode ()
"Set background mode as appropriate for the default rxvt colors." "Set background mode as appropriate for the default rxvt colors."
(let ((fgbg (getenv "COLORFGBG" (terminal-id))) (let ((fgbg (getenv "COLORFGBG"))
bg rgb) bg rgb)
(set-terminal-parameter nil 'background-mode 'light) (set-terminal-parameter nil 'background-mode 'light)
(when (and fgbg (when (and fgbg
......
...@@ -2436,7 +2436,7 @@ order until succeed.") ...@@ -2436,7 +2436,7 @@ order until succeed.")
(aset x-resource-name i ?-)))) (aset x-resource-name i ?-))))
(x-open-connection (or x-display-name (x-open-connection (or x-display-name
(setq x-display-name (or (getenv "DISPLAY" (terminal-id)) (setq x-display-name (or (getenv "DISPLAY" (selected-frame))
(getenv "DISPLAY")))) (getenv "DISPLAY"))))
x-command-line-resources x-command-line-resources
;; Exit Emacs with fatal error if this fails and we ;; Exit Emacs with fatal error if this fails and we
......
...@@ -327,8 +327,8 @@ ...@@ -327,8 +327,8 @@
;; rxvt terminals sometimes set the TERM variable to "xterm", but ;; rxvt terminals sometimes set the TERM variable to "xterm", but
;; rxvt's keybindings are incompatible with xterm's. It is ;; rxvt's keybindings are incompatible with xterm's. It is
;; better in that case to use rxvt's initializion function. ;; better in that case to use rxvt's initializion function.
(if (and (getenv "COLORTERM" (terminal-id)) (if (and (getenv "COLORTERM" (selected-frame))
(string-match "\\`rxvt" (getenv "COLORTERM" (terminal-id)))) (string-match "\\`rxvt" (getenv "COLORTERM" (selected-frame))))
(tty-run-terminal-initialization (selected-frame) "rxvt") (tty-run-terminal-initialization (selected-frame) "rxvt")
;; The terminal intialization C code file might have initialized ;; The terminal intialization C code file might have initialized
......
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