LCOV - code coverage report
Current view: top level - lisp - env.el (source / functions) Hit Total Coverage
Test: tramp-tests-after.info Lines: 64 98 65.3 %
Date: 2017-08-30 10:12:24 Functions: 5 8 62.5 %

          Line data    Source code
       1             : ;;; env.el --- functions to manipulate environment variables  -*- lexical-binding:t -*-
       2             : 
       3             : ;; Copyright (C) 1991, 1994, 2000-2017 Free Software Foundation, Inc.
       4             : 
       5             : ;; Maintainer: emacs-devel@gnu.org
       6             : ;; Keywords: processes, unix
       7             : ;; Package: emacs
       8             : 
       9             : ;; This file is part of GNU Emacs.
      10             : 
      11             : ;; GNU Emacs is free software: you can redistribute it and/or modify
      12             : ;; it under the terms of the GNU General Public License as published by
      13             : ;; the Free Software Foundation, either version 3 of the License, or
      14             : ;; (at your option) any later version.
      15             : 
      16             : ;; GNU Emacs is distributed in the hope that it will be useful,
      17             : ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
      18             : ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
      19             : ;; GNU General Public License for more details.
      20             : 
      21             : ;; You should have received a copy of the GNU General Public License
      22             : ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
      23             : 
      24             : ;;; Commentary:
      25             : 
      26             : ;; UNIX processes inherit a list of name-to-string associations from their
      27             : ;; parents called their `environment'; these are commonly used to control
      28             : ;; program options.  This package permits you to set environment variables
      29             : ;; to be passed to any sub-process run under Emacs.
      30             : 
      31             : ;; Note that the environment string `process-environment' is not
      32             : ;; decoded, but the args of `setenv' and `getenv' are normally
      33             : ;; multibyte text and get coding conversion.
      34             : 
      35             : ;;; Code:
      36             : 
      37             : ;; History list for environment variable names.
      38             : (defvar read-envvar-name-history nil)
      39             : 
      40             : (defun read-envvar-name (prompt &optional mustmatch)
      41             :   "Read environment variable name, prompting with PROMPT.
      42             : Optional second arg MUSTMATCH, if non-nil, means require existing envvar name.
      43             : If it is also not t, RET does not exit if it does non-null completion."
      44           0 :   (completing-read prompt
      45           0 :                    (mapcar (lambda (enventry)
      46           0 :                              (let ((str (substring enventry 0
      47           0 :                                              (string-match "=" enventry))))
      48           0 :                                (if (multibyte-string-p str)
      49           0 :                                    (decode-coding-string
      50           0 :                                     str locale-coding-system t)
      51           0 :                                  str)))
      52           0 :                            (append process-environment
      53             :                                    ;;(frame-environment)
      54           0 :                                    ))
      55           0 :                    nil mustmatch nil 'read-envvar-name-history))
      56             : 
      57             : ;; History list for VALUE argument to setenv.
      58             : (defvar setenv-history nil)
      59             : 
      60             : (defconst env--substitute-vars-regexp
      61             :   "\\$\\(?:\\(?1:[[:alnum:]_]+\\)\\|{\\(?1:[^{}]+\\)}\\|\\$\\)")
      62             : 
      63             : (defun substitute-env-vars (string &optional when-undefined)
      64             :   "Substitute environment variables referred to in STRING.
      65             : `$FOO' where FOO is an environment variable name means to substitute
      66             : the value of that variable.  The variable name should be terminated
      67             : with a character not a letter, digit or underscore; otherwise, enclose
      68             : the entire variable name in braces.  For instance, in `ab$cd-x',
      69             : `$cd' is treated as an environment variable.
      70             : 
      71             : If WHEN-DEFINED is nil, references to undefined environment variables
      72             : are replaced by the empty string; if it is a function, the function is called
      73             : with the variable name as argument and should return the text with which
      74             : to replace it or nil to leave it unchanged.
      75             : If it is non-nil and not a function, references to undefined variables are
      76             : left unchanged.
      77             : 
      78             : Use `$$' to insert a single dollar sign."
      79       46846 :   (let ((start 0))
      80       51442 :     (while (string-match env--substitute-vars-regexp string start)
      81        4596 :       (cond ((match-beginning 1)
      82        3220 :              (let* ((var (match-string 1 string))
      83        3220 :                     (value (getenv var)))
      84        3220 :                (if (and (null value)
      85        3213 :                         (if (functionp when-undefined)
      86           0 :                             (null (setq value (funcall when-undefined var)))
      87        3220 :                           when-undefined))
      88        3213 :                    (setq start (match-end 0))
      89           7 :                  (setq string (replace-match (or value "") t t string)
      90        3220 :                        start (+ (match-beginning 0) (length value))))))
      91             :             (t
      92        1376 :              (setq string (replace-match "$" t t string)
      93       46846 :                    start (+ (match-beginning 0) 1)))))
      94       46846 :     string))
      95             : 
      96             : (defun substitute-env-in-file-name (filename)
      97         216 :   (substitute-env-vars filename
      98             :                        ;; How 'bout we lookup other tables than the env?
      99             :                        ;; E.g. we could accept bookmark names as well!
     100         216 :                        (if (memq system-type '(windows-nt ms-dos))
     101           0 :                            (lambda (var) (getenv (upcase var)))
     102         216 :                          t)))
     103             : 
     104             : (defun setenv-internal (env variable value keep-empty)
     105             :   "Set VARIABLE to VALUE in ENV, adding empty entries if KEEP-EMPTY.
     106             : Changes ENV by side-effect, and returns its new value."
     107         511 :   (let ((pattern (concat "\\`" (regexp-quote variable) "\\(=\\|\\'\\)"))
     108             :         (case-fold-search nil)
     109         511 :         (scan env)
     110             :         prev found)
     111             :     ;; Handle deletions from the beginning of the list specially.
     112         511 :     (if (and (null value)
     113         147 :              (not keep-empty)
     114           0 :              env
     115           0 :              (stringp (car env))
     116         511 :              (string-match pattern (car env)))
     117           0 :         (cdr env)
     118             :       ;; Try to find existing entry for VARIABLE in ENV.
     119       48989 :       (while (and scan (stringp (car scan)))
     120       48478 :         (when (string-match pattern (car scan))
     121         145 :           (if value
     122         145 :               (setcar scan (concat variable "=" value))
     123           0 :             (if keep-empty
     124           0 :                 (setcar scan variable)
     125         145 :               (setcdr prev (cdr scan))))
     126         145 :           (setq found t
     127       48478 :                 scan nil))
     128       48478 :         (setq prev scan
     129       48478 :               scan (cdr scan)))
     130         511 :       (if (and (not found) (or value keep-empty))
     131         366 :           (cons (if value
     132         219 :                     (concat variable "=" value)
     133         366 :                   variable)
     134         366 :                 env)
     135         511 :         env))))
     136             : 
     137             : ;; Fixme: Should the environment be recoded if LC_CTYPE &c is set?
     138             : 
     139             : (defun setenv (variable &optional value substitute-env-vars)
     140             :   "Set the value of the environment variable named VARIABLE to VALUE.
     141             : VARIABLE should be a string.  VALUE is optional; if not provided or
     142             : nil, the environment variable VARIABLE will be removed.
     143             : 
     144             : Interactively, a prefix argument means to unset the variable, and
     145             : otherwise the current value (if any) of the variable appears at
     146             : the front of the history list when you type in the new value.
     147             : This function always replaces environment variables in the new
     148             : value when called interactively.
     149             : 
     150             : SUBSTITUTE-ENV-VARS, if non-nil, means to substitute environment
     151             : variables in VALUE with `substitute-env-vars', which see.
     152             : This is normally used only for interactive calls.
     153             : 
     154             : The return value is the new value of VARIABLE, or nil if
     155             : it was removed from the environment.
     156             : 
     157             : This function works by modifying `process-environment'.
     158             : 
     159             : As a special case, setting variable `TZ' calls `set-time-zone-rule' as
     160             : a side-effect."
     161             :   (interactive
     162           0 :    (if current-prefix-arg
     163           0 :        (list (read-envvar-name "Clear environment variable: " 'exact) nil)
     164           0 :      (let* ((var (read-envvar-name "Set environment variable: " nil))
     165           0 :             (value (getenv var)))
     166           0 :        (when value
     167           0 :          (add-to-history 'setenv-history value))
     168             :        ;; Here finally we specify the args to give call setenv with.
     169           0 :        (list var
     170           0 :              (read-from-minibuffer (format "Set %s to value: " var)
     171             :                                    nil nil nil 'setenv-history
     172           0 :                                    value)
     173           0 :              t))))
     174         511 :   (if (and (multibyte-string-p variable) locale-coding-system)
     175           0 :       (let ((codings (find-coding-systems-string (concat variable value))))
     176           0 :         (unless (or (eq 'undecided (car codings))
     177           0 :                     (memq (coding-system-base locale-coding-system) codings))
     178           0 :           (error "Can't encode `%s=%s' with `locale-coding-system'"
     179         511 :                  variable (or value "")))))
     180         511 :   (and value
     181         364 :        substitute-env-vars
     182         511 :        (setq value (substitute-env-vars value)))
     183         511 :   (if (multibyte-string-p variable)
     184         511 :       (setq variable (encode-coding-string variable locale-coding-system)))
     185         511 :   (if (and value (multibyte-string-p value))
     186         511 :       (setq value (encode-coding-string value locale-coding-system)))
     187         511 :   (if (string-match "=" variable)
     188         511 :       (error "Environment variable name `%s' contains `='" variable))
     189         511 :   (if (string-equal "TZ" variable)
     190         511 :       (set-time-zone-rule value))
     191         511 :   (setq process-environment (setenv-internal process-environment
     192         511 :                                              variable value t))
     193         511 :   value)
     194             : 
     195             : (defun getenv (variable &optional frame)
     196             :   "Get the value of environment variable VARIABLE.
     197             : VARIABLE should be a string.  Value is nil if VARIABLE is undefined in
     198             : the environment.  Otherwise, value is a string.
     199             : 
     200             : If optional parameter FRAME is non-nil, then it should be a
     201             : frame.  This function will look up VARIABLE in its `environment'
     202             : parameter.
     203             : 
     204             : Otherwise, this function searches `process-environment' for
     205             : VARIABLE.  If it is not found there, then it continues the search
     206             : in the environment list of the selected frame."
     207           0 :   (interactive (list (read-envvar-name "Get environment variable: " t)))
     208       31026 :   (let ((value (getenv-internal (if (multibyte-string-p variable)
     209        3200 :                                     (encode-coding-string
     210        3200 :                                      variable locale-coding-system)
     211       31026 :                                   variable)
     212       31026 :                                 (and frame
     213           0 :                                      (assq 'environment
     214       31026 :                                            (frame-parameters frame))))))
     215       31026 :     (if (and enable-multibyte-characters value)
     216       31026 :         (setq value (decode-coding-string value locale-coding-system)))
     217       31026 :     (when (called-interactively-p 'interactive)
     218       31026 :       (message "%s" (if value value "Not set")))
     219       31026 :     value))
     220             : 
     221             : (provide 'env)
     222             : 
     223             : ;;; env.el ends here

Generated by: LCOV version 1.12