1 | ;;; env.el --- functions to manipulate environment variables. |
---|
2 | |
---|
3 | ;; Copyright (C) 1991, 1994 Free Software Foundation, Inc. |
---|
4 | |
---|
5 | ;; Maintainer: FSF |
---|
6 | ;; Keywords: processes, unix |
---|
7 | |
---|
8 | ;; This file is part of GNU Emacs. |
---|
9 | |
---|
10 | ;; GNU Emacs is free software; you can redistribute it and/or modify |
---|
11 | ;; it under the terms of the GNU General Public License as published by |
---|
12 | ;; the Free Software Foundation; either version 2, or (at your option) |
---|
13 | ;; any later version. |
---|
14 | |
---|
15 | ;; GNU Emacs is distributed in the hope that it will be useful, |
---|
16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
---|
17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
---|
18 | ;; GNU General Public License for more details. |
---|
19 | |
---|
20 | ;; You should have received a copy of the GNU General Public License |
---|
21 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
---|
22 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
---|
23 | ;; Boston, MA 02111-1307, USA. |
---|
24 | |
---|
25 | ;;; Commentary: |
---|
26 | |
---|
27 | ;; UNIX processes inherit a list of name-to-string associations from their |
---|
28 | ;; parents called their `environment'; these are commonly used to control |
---|
29 | ;; program options. This package permits you to set environment variables |
---|
30 | ;; to be passed to any sub-process run under Emacs. |
---|
31 | |
---|
32 | ;;; Code: |
---|
33 | |
---|
34 | ;; History list for environment variable names. |
---|
35 | (defvar read-envvar-name-history nil) |
---|
36 | |
---|
37 | (defun read-envvar-name (prompt &optional mustmatch) |
---|
38 | "Read environment variable name, prompting with PROMPT. |
---|
39 | Optional second arg MUSTMATCH, if non-nil, means require existing envvar name. |
---|
40 | If it is also not t, RET does not exit if it does non-null completion." |
---|
41 | (completing-read prompt |
---|
42 | (mapcar (function |
---|
43 | (lambda (enventry) |
---|
44 | (list (substring enventry 0 |
---|
45 | (string-match "=" enventry))))) |
---|
46 | process-environment) |
---|
47 | nil mustmatch nil 'read-envvar-name-history)) |
---|
48 | |
---|
49 | ;; History list for VALUE argument to setenv. |
---|
50 | (defvar setenv-history nil) |
---|
51 | |
---|
52 | ;;;###autoload |
---|
53 | (defun setenv (variable &optional value unset) |
---|
54 | "Set the value of the environment variable named VARIABLE to VALUE. |
---|
55 | VARIABLE should be a string. VALUE is optional; if not provided or is |
---|
56 | `nil', the environment variable VARIABLE will be removed. |
---|
57 | |
---|
58 | Interactively, a prefix argument means to unset the variable. |
---|
59 | Interactively, the current value (if any) of the variable |
---|
60 | appears at the front of the history list when you type in the new value. |
---|
61 | |
---|
62 | This function works by modifying `process-environment'." |
---|
63 | (interactive |
---|
64 | (if current-prefix-arg |
---|
65 | (list (read-envvar-name "Clear environment variable: " 'exact) nil t) |
---|
66 | (let* ((var (read-envvar-name "Set environment variable: " nil)) |
---|
67 | (oldval (getenv var)) |
---|
68 | newval |
---|
69 | oldhist) |
---|
70 | ;; Don't put the current value on the history |
---|
71 | ;; if it is already there. |
---|
72 | (if (equal oldval (car setenv-history)) |
---|
73 | (setq oldval nil)) |
---|
74 | ;; Now if OLDVAL is non-nil, we should add it to the history. |
---|
75 | (if oldval |
---|
76 | (setq setenv-history (cons oldval setenv-history))) |
---|
77 | (setq oldhist setenv-history) |
---|
78 | (setq newval (read-from-minibuffer (format "Set %s to value: " var) |
---|
79 | nil nil nil 'setenv-history)) |
---|
80 | ;; If we added the current value to the history, remove it. |
---|
81 | ;; Note that read-from-minibuffer may have added the new value. |
---|
82 | ;; Don't remove that! |
---|
83 | (if oldval |
---|
84 | (if (eq oldhist setenv-history) |
---|
85 | (setq setenv-history (cdr setenv-history)) |
---|
86 | (setcdr setenv-history (cdr (cdr setenv-history))))) |
---|
87 | ;; Here finally we specify the args to give call setenv with. |
---|
88 | (list var newval)))) |
---|
89 | (if unset (setq value nil)) |
---|
90 | (if (string-match "=" variable) |
---|
91 | (error "Environment variable name `%s' contains `='" variable) |
---|
92 | (let ((pattern (concat "\\`" (regexp-quote (concat variable "=")))) |
---|
93 | (case-fold-search nil) |
---|
94 | (scan process-environment) |
---|
95 | found) |
---|
96 | (if (string-equal "TZ" variable) |
---|
97 | (set-time-zone-rule value)) |
---|
98 | (while scan |
---|
99 | (cond ((string-match pattern (car scan)) |
---|
100 | (setq found t) |
---|
101 | (if (eq nil value) |
---|
102 | (setq process-environment (delq (car scan) process-environment)) |
---|
103 | (setcar scan (concat variable "=" value))) |
---|
104 | (setq scan nil))) |
---|
105 | (setq scan (cdr scan))) |
---|
106 | (or found |
---|
107 | (if value |
---|
108 | (setq process-environment |
---|
109 | (cons (concat variable "=" value) |
---|
110 | process-environment))))))) |
---|
111 | |
---|
112 | (require 'product) |
---|
113 | (product-provide (provide 'env) (require 'apel-ver)) |
---|
114 | |
---|
115 | ;;; env.el ends here |
---|