Mercurial > emacs
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: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-443
author | Karoly Lorentey <lorentey@elte.hu> |
---|---|
date | Sat, 19 Nov 2005 19:17:56 +0000 |
parents | b31326248cf6 |
children | bb2edc915032 |
comparison
equal
deleted
inserted
replaced
83402:606eab743857 | 83403:51eb0aa362f3 |
---|---|
207 New clients have no properties." | 207 New clients have no properties." |
208 (unless (server-client proc) | 208 (unless (server-client proc) |
209 (setq server-clients (cons (cons proc nil) | 209 (setq server-clients (cons (cons proc nil) |
210 server-clients)))) | 210 server-clients)))) |
211 | 211 |
212 ;;;###autoload | 212 (defun server-getenv-from (env variable) |
213 (defun server-getenv (variable &optional frame) | 213 "Get the value of VARIABLE in ENV. |
214 "Get the value of VARIABLE in the client environment of frame FRAME. | 214 VARIABLE should be a string. Value is nil if VARIABLE is |
215 VARIABLE should be a string. Value is nil if VARIABLE is undefined in | 215 undefined in ENV. Otherwise, value is a string. |
216 the environment. Otherwise, value is a string. | 216 |
217 | 217 ENV should be in the same format as `process-environment'." |
218 If FRAME is an emacsclient frame, then the variable is looked up | 218 (let (entry result) |
219 in the environment of the emacsclient process; otherwise the | 219 (while (and env (null result)) |
220 function consults the environment of the Emacs process. | 220 (setq entry (car env) |
221 | 221 env (cdr env)) |
222 If FRAME is nil or missing, then the selected frame is used." | 222 (if (and (> (length entry) (length variable)) |
223 (when (not frame) (setq frame (selected-frame))) | 223 (eq ?= (aref entry (length variable))) |
224 (let ((client (frame-parameter frame 'client)) env) | 224 (equal variable (substring entry 0 (length variable)))) |
225 (if (null client) | 225 (setq result (substring entry (+ (length variable) 1))))) |
226 (getenv variable) | 226 result)) |
227 (setq env (server-client-get client 'environment)) | 227 |
228 (if (null env) | 228 (defmacro server-with-environment (env vars &rest body) |
229 (getenv variable) | 229 "Evaluate BODY with environment variables VARS set to those in ENV. |
230 (cdr (assoc variable env)))))) | |
231 | |
232 (defmacro server-with-client-environment (client vars &rest body) | |
233 "Evaluate BODY with environment variables VARS set to those of CLIENT. | |
234 The environment variables are then restored to their previous values. | 230 The environment variables are then restored to their previous values. |
235 | 231 |
236 VARS should be a list of strings." | 232 VARS should be a list of strings. |
233 ENV should be in the same format as `process-environment'." | |
237 (declare (indent 2)) | 234 (declare (indent 2)) |
238 (let ((oldvalues (make-symbol "oldvalues")) | 235 (let ((oldvalues (make-symbol "oldvalues")) |
239 (var (make-symbol "var")) | 236 (var (make-symbol "var")) |
240 (value (make-symbol "value")) | 237 (value (make-symbol "value")) |
241 (pair (make-symbol "pair"))) | 238 (pair (make-symbol "pair"))) |
242 `(let (,oldvalues) | 239 `(let (,oldvalues) |
243 (dolist (,var (quote ,vars)) | 240 (dolist (,var ,vars) |
244 (let ((,value (cdr (assoc ,var (server-client-get ,client 'environment))))) | 241 (let ((,value (server-getenv-from ,env ,var))) |
245 (setq ,oldvalues (cons (cons ,var (getenv ,var)) ,oldvalues)) | 242 (setq ,oldvalues (cons (cons ,var (getenv ,var)) ,oldvalues)) |
246 (setenv ,var ,value))) | 243 (setenv ,var ,value))) |
247 (unwind-protect | 244 (unwind-protect |
248 (progn ,@body) | 245 (progn ,@body) |
249 (dolist (,pair ,oldvalues) | 246 (dolist (,pair ,oldvalues) |
481 `-version CLIENT-VERSION' | 478 `-version CLIENT-VERSION' |
482 Check version numbers between server and client, and signal an | 479 Check version numbers between server and client, and signal an |
483 error if there is a mismatch. The server replies with | 480 error if there is a mismatch. The server replies with |
484 `-good-version' to confirm the match. | 481 `-good-version' to confirm the match. |
485 | 482 |
486 `-env NAME VALUE' | 483 `-env NAME=VALUE' |
487 An environment variable on the client side. | 484 An environment variable on the client side. |
488 | 485 |
489 `-current-frame' | 486 `-current-frame' |
490 Forbid the creation of new frames. | 487 Forbid the creation of new frames. |
491 | 488 |
569 default-file-name-coding-system))) | 566 default-file-name-coding-system))) |
570 (client (server-client proc)) | 567 (client (server-client proc)) |
571 current-frame | 568 current-frame |
572 nowait ; t if emacsclient does not want to wait for us. | 569 nowait ; t if emacsclient does not want to wait for us. |
573 frame ; The frame that was opened for the client (if any). | 570 frame ; The frame that was opened for the client (if any). |
574 display ; Open the frame on this display. | 571 display ; Open the frame on this display. |
575 dontkill ; t if the client should not be killed. | 572 dontkill ; t if the client should not be killed. |
573 env | |
576 (files nil) | 574 (files nil) |
577 (lineno 1) | 575 (lineno 1) |
578 (columnno 0)) | 576 (columnno 0)) |
579 ;; Remove this line from STRING. | 577 ;; Remove this line from STRING. |
580 (setq string (substring string (match-end 0))) | 578 (setq string (substring string (match-end 0))) |
603 | 601 |
604 ;; -current-frame: Don't create frames. | 602 ;; -current-frame: Don't create frames. |
605 ((equal "-current-frame" arg) (setq current-frame t)) | 603 ((equal "-current-frame" arg) (setq current-frame t)) |
606 | 604 |
607 ;; -display DISPLAY: | 605 ;; -display DISPLAY: |
608 ;; Open X frames on the given instead of the default. | 606 ;; Open X frames on the given display instead of the default. |
609 ((and (equal "-display" arg) (string-match "\\([^ ]*\\) " request)) | 607 ((and (equal "-display" arg) (string-match "\\([^ ]*\\) " request)) |
610 (setq display (match-string 1 request) | 608 (setq display (match-string 1 request) |
611 request (substring request (match-end 0)))) | 609 request (substring request (match-end 0)))) |
612 | 610 |
613 ;; -window-system: Open a new X frame. | 611 ;; -window-system: Open a new X frame. |
637 ;; the moment. | 635 ;; the moment. |
638 (modify-frame-parameters frame params) | 636 (modify-frame-parameters frame params) |
639 (select-frame frame) | 637 (select-frame frame) |
640 (server-client-set client 'frame frame) | 638 (server-client-set client 'frame frame) |
641 (server-client-set client 'device (frame-display frame)) | 639 (server-client-set client 'device (frame-display frame)) |
640 (set-terminal-parameter frame 'environment env) | |
642 (setq dontkill t)) | 641 (setq dontkill t)) |
643 ;; This emacs does not support X. | 642 ;; This emacs does not support X. |
644 (server-log "Window system unsupported" proc) | 643 (server-log "Window system unsupported" proc) |
645 (server-send-string proc "-window-system-unsupported \n") | 644 (server-send-string proc "-window-system-unsupported \n") |
646 (setq dontkill t)))) | 645 (setq dontkill t)))) |
673 (type (server-unquote-arg (match-string 2 request)))) | 672 (type (server-unquote-arg (match-string 2 request)))) |
674 (setq request (substring request (match-end 0))) | 673 (setq request (substring request (match-end 0))) |
675 (unless (server-client-get client 'version) | 674 (unless (server-client-get client 'version) |
676 (error "Protocol error; make sure you use the correct version of emacsclient")) | 675 (error "Protocol error; make sure you use the correct version of emacsclient")) |
677 (unless current-frame | 676 (unless current-frame |
678 (server-with-client-environment proc | 677 (server-with-environment env |
679 ("LANG" "LC_CTYPE" "LC_ALL" | 678 '("LANG" "LC_CTYPE" "LC_ALL" |
680 ;; For tgetent(3); list according to ncurses(3). | 679 ;; For tgetent(3); list according to ncurses(3). |
681 "BAUDRATE" "COLUMNS" "ESCDELAY" "HOME" "LINES" | 680 "BAUDRATE" "COLUMNS" "ESCDELAY" "HOME" "LINES" |
682 "NCURSES_ASSUMED_COLORS" "NCURSES_NO_PADDING" | 681 "NCURSES_ASSUMED_COLORS" "NCURSES_NO_PADDING" |
683 "NCURSES_NO_SETBUF" "TERM" "TERMCAP" "TERMINFO" | 682 "NCURSES_NO_SETBUF" "TERM" "TERMCAP" "TERMINFO" |
684 "TERMINFO_DIRS" "TERMPATH") | 683 "TERMINFO_DIRS" "TERMPATH") |
685 (setq frame (make-frame-on-tty tty type | 684 (setq frame (make-frame-on-tty tty type |
686 ;; Ignore nowait here; we always need to clean | 685 ;; Ignore nowait here; we always need to clean |
687 ;; up opened ttys when the client dies. | 686 ;; up opened ttys when the client dies. |
688 `((client . ,proc))))) | 687 `((client . ,proc))))) |
689 (select-frame frame) | 688 (select-frame frame) |
690 (server-client-set client 'frame frame) | 689 (server-client-set client 'frame frame) |
691 (server-client-set client 'tty (display-name frame)) | 690 (server-client-set client 'tty (display-name frame)) |
692 (server-client-set client 'device (frame-display frame)) | 691 (server-client-set client 'device (frame-display frame)) |
692 (set-terminal-parameter frame 'environment env) | |
693 | 693 |
694 ;; Reply with our pid. | 694 ;; Reply with our pid. |
695 (server-send-string proc (concat "-emacs-pid " (number-to-string (emacs-pid)) "\n")) | 695 (server-send-string proc (concat "-emacs-pid " (number-to-string (emacs-pid)) "\n")) |
696 (setq dontkill t)))) | 696 (setq dontkill t)))) |
697 | 697 |
735 (buffer-substring-no-properties (point-min) | 735 (buffer-substring-no-properties (point-min) |
736 (point-max))))))))) | 736 (point-max))))))))) |
737 (setq lineno 1 | 737 (setq lineno 1 |
738 columnno 0))) | 738 columnno 0))) |
739 | 739 |
740 ;; -env NAME VALUE: An environment variable. | 740 ;; -env NAME=VALUE: An environment variable. |
741 ((and (equal "-env" arg) (string-match "\\([^ ]+\\) \\([^ ]+\\) " request)) | 741 ((and (equal "-env" arg) (string-match "\\([^ ]+\\) " request)) |
742 (let ((name (server-unquote-arg (match-string 1 request))) | 742 (let ((var (server-unquote-arg (match-string 1 request)))) |
743 (value (server-unquote-arg (match-string 2 request)))) | |
744 (when coding-system | 743 (when coding-system |
745 (setq name (decode-coding-string name coding-system)) | 744 (setq var (decode-coding-string var coding-system))) |
746 (setq value (decode-coding-string value coding-system))) | |
747 (setq request (substring request (match-end 0))) | 745 (setq request (substring request (match-end 0))) |
748 (server-client-set | 746 (setq env (cons var env)))) |
749 client 'environment | |
750 (cons (cons name value) | |
751 (server-client-get client 'environment))))) | |
752 | 747 |
753 ;; Unknown command. | 748 ;; Unknown command. |
754 (t (error "Unknown command: %s" arg))))) | 749 (t (error "Unknown command: %s" arg))))) |
755 | 750 |
756 (let (buffers) | 751 (let (buffers) |
1051 (switch-to-buffer next-buffer) | 1046 (switch-to-buffer next-buffer) |
1052 ;; After all the above, we might still have ended up with | 1047 ;; After all the above, we might still have ended up with |
1053 ;; a minibuffer/dedicated-window (if there's no other). | 1048 ;; a minibuffer/dedicated-window (if there's no other). |
1054 (error (pop-to-buffer next-buffer))))))))) | 1049 (error (pop-to-buffer next-buffer))))))))) |
1055 | 1050 |
1056 (defun server-save-buffers-kill-display (&optional arg) | 1051 ;;;###autoload |
1057 "Offer to save each buffer, then kill the current connection. | 1052 (defun server-save-buffers-kill-display (proc &optional arg) |
1058 If the current frame has no client, kill Emacs itself. | 1053 "Offer to save each buffer, then kill PROC. |
1059 | 1054 |
1060 With prefix arg, silently save all file-visiting buffers, then kill. | 1055 With prefix arg, silently save all file-visiting buffers, then kill. |
1061 | 1056 |
1062 If emacsclient was started with a list of filenames to edit, then | 1057 If emacsclient was started with a list of filenames to edit, then |
1063 only these files will be asked to be saved." | 1058 only these files will be asked to be saved." |
1064 (interactive "P") | 1059 (let ((buffers (server-client-get proc 'buffers))) |
1065 (let ((proc (frame-parameter (selected-frame) 'client)) | 1060 ;; If client is bufferless, emulate a normal Emacs session |
1066 (frame (selected-frame))) | 1061 ;; exit and offer to save all buffers. Otherwise, offer to |
1067 (if proc | 1062 ;; save only the buffers belonging to the client. |
1068 (let ((buffers (server-client-get proc 'buffers))) | 1063 (save-some-buffers arg |
1069 ;; If client is bufferless, emulate a normal Emacs session | 1064 (if buffers |
1070 ;; exit and offer to save all buffers. Otherwise, offer to | 1065 (lambda () (memq (current-buffer) buffers)) |
1071 ;; save only the buffers belonging to the client. | 1066 t)) |
1072 (save-some-buffers arg | 1067 (server-delete-client proc))) |
1073 (if buffers | |
1074 (lambda () (memq (current-buffer) buffers)) | |
1075 t)) | |
1076 (server-delete-client proc) | |
1077 (when (frame-live-p frame) | |
1078 (delete-frame frame))) | |
1079 (save-buffers-kill-emacs)))) | |
1080 | 1068 |
1081 (define-key ctl-x-map "#" 'server-edit) | 1069 (define-key ctl-x-map "#" 'server-edit) |
1082 | 1070 |
1083 (defun server-unload-hook () | 1071 (defun server-unload-hook () |
1084 "Unload the server library." | 1072 "Unload the server library." |