Return to environ.c CVS log

Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / src

Annotation of 43BSDReno/contrib/emacs-18.55/src/environ.c, revision 1.1

1.1     ! root        1: /* Environment-hacking for GNU Emacs subprocess
        !             2:    Copyright (C) 1986 Free Software Foundation, Inc.
        !             3: 
        !             4: This file is part of GNU Emacs.
        !             5: 
        !             6: GNU Emacs is distributed in the hope that it will be useful,
        !             7: but WITHOUT ANY WARRANTY.  No author or distributor
        !             8: accepts responsibility to anyone for the consequences of using it
        !             9: or for whether it serves any particular purpose or works at all,
        !            10: unless he says so in writing.  Refer to the GNU Emacs General Public
        !            11: License for full details.
        !            12: 
        !            13: Everyone is granted permission to copy, modify and redistribute
        !            14: GNU Emacs, but only under the conditions described in the
        !            15: GNU Emacs General Public License.   A copy of this license is
        !            16: supposed to have been given to you along with GNU Emacs so you
        !            17: can know your rights and responsibilities.  It should be in a
        !            18: file named COPYING.  Among other things, the copyright notice
        !            19: and this notice must be preserved on all copies.  */
        !            20: 
        !            21: 
        !            22: #include "config.h"
        !            23: #include "lisp.h"
        !            24: 
        !            25: #ifdef MAINTAIN_ENVIRONMENT
        !            26: 
        !            27: #ifdef VMS
        !            28: you lose -- this is un*x-only
        !            29: #endif
        !            30: 
        !            31: /* alist of (name-string . value-string) */
        !            32: Lisp_Object Venvironment_alist;
        !            33: extern char **environ;
        !            34: 
        !            35: void
        !            36: set_environment_alist (str, val)
        !            37:      register Lisp_Object str, val;
        !            38: {
        !            39:   register Lisp_Object tem;
        !            40: 
        !            41:   tem = Fassoc (str, Venvironment_alist);
        !            42:   if (NULL (tem))
        !            43:     if (NULL (val))
        !            44:       ;
        !            45:     else
        !            46:       Venvironment_alist = Fcons (Fcons (str, val), Venvironment_alist);
        !            47:   else
        !            48:     if (NULL (val))
        !            49:       Venvironment_alist = Fdelq (tem, Venvironment_alist);
        !            50:     else
        !            51:       XCONS (tem)->cdr = val;
        !            52: }
        !            53: 
        !            54: 
        !            55: 
        !            56: static void
        !            57: initialize_environment_alist ()
        !            58: {
        !            59:   register unsigned char **e, *s;
        !            60:   extern char *index ();
        !            61: 
        !            62:   for (e = (unsigned char **) environ; *e; e++)
        !            63:     {
        !            64:       s = (unsigned char *) index (*e, '=');
        !            65:       if (s)
        !            66:        set_environment_alist (make_string (*e, s - *e),
        !            67:                               build_string (s + 1));
        !            68:     }
        !            69: }
        !            70: 
        !            71: 
        !            72: unsigned char *
        !            73: getenv_1 (str, ephemeral)
        !            74:      register unsigned char *str;
        !            75:      int ephemeral;            /* if ephmeral, don't need to gc-proof */
        !            76: {
        !            77:   register Lisp_Object env;
        !            78:   int len = strlen (str);
        !            79: 
        !            80:   for (env = Venvironment_alist; CONSP (env); env = XCONS (env)->cdr)
        !            81:     {
        !            82:       register Lisp_Object car = XCONS (env)->car;
        !            83:       register Lisp_Object tem = XCONS (car)->car;
        !            84: 
        !            85:       if ((len == XSTRING (tem)->size) &&
        !            86:          (!bcmp (str, XSTRING (tem)->data, len)))
        !            87:        {
        !            88:          /* Found it in the lisp environment */
        !            89:          tem = XCONS (car)->cdr;
        !            90:          if (ephemeral)
        !            91:            /* Caller promises that gc won't make him lose */
        !            92:            return XSTRING (tem)->data;
        !            93:          else
        !            94:            {
        !            95:              register unsigned char **e;
        !            96:              unsigned char *s;
        !            97:              int ll = XSTRING (tem)->size;
        !            98: 
        !            99:              /* Look for element in the original unix environment */
        !           100:              for (e = (unsigned char **) environ; *e; e++)
        !           101:                if (!bcmp (str, *e, len) && *(*e + len) == '=')
        !           102:                  {
        !           103:                    s = *e + len + 1;
        !           104:                    if (strlen (s) >= ll)
        !           105:                      /* User hasn't either hasn't munged it or has set it
        !           106:                         to something shorter -- we don't have to cons */
        !           107:                      goto copy;
        !           108:                    else
        !           109:                      goto cons;
        !           110:                  };
        !           111:            cons:
        !           112:              /* User has setenv'ed it to a diferent value, and our caller
        !           113:                 isn't guaranteeing that he won't stash it away somewhere.
        !           114:                 We can't just return a pointer to the lisp string, as that
        !           115:                 will be corrupted when gc happens.  So, we cons (in such
        !           116:                 a way that it can't be freed -- though this isn't such a
        !           117:                 problem since the only callers of getenv (as opposed to
        !           118:                 those of egetenv) are very early, before the user -could-
        !           119:                 have frobbed the environment. */
        !           120:              s = (unsigned char *) xmalloc (ll + 1);
        !           121:            copy:
        !           122:              bcopy (XSTRING (tem)->data, s, ll + 1);
        !           123:              return (s);
        !           124:            }
        !           125:        }
        !           126:     }
        !           127:   return ((unsigned char *) 0);
        !           128: }
        !           129: 
        !           130: /* unsigned  -- stupid delcaration in lisp.h */ char *
        !           131: getenv (str)
        !           132:      register unsigned char *str;
        !           133: {
        !           134:   return ((char *) getenv_1 (str, 0));
        !           135: }
        !           136: 
        !           137: unsigned char *
        !           138: egetenv (str)
        !           139:      register unsigned char *str;
        !           140: {
        !           141:   return (getenv_1 (str, 1));
        !           142: }
        !           143: 
        !           144: 
        !           145: #if (1 == 1) /* use caller-alloca versions, rather than callee-malloc */
        !           146: int
        !           147: size_of_current_environ ()
        !           148: {
        !           149:   register int size;
        !           150:   Lisp_Object tem;
        !           151: 
        !           152:   tem = Flength (Venvironment_alist);
        !           153:   
        !           154:   size = (XINT (tem) + 1) * sizeof (unsigned char *);
        !           155:   /* + 1 for environment-terminating 0 */
        !           156: 
        !           157:   for (tem = Venvironment_alist; !NULL (tem); tem = XCONS (tem)->cdr)
        !           158:     {
        !           159:       register Lisp_Object str, val;
        !           160: 
        !           161:       str = XCONS (XCONS (tem)->car)->car;
        !           162:       val = XCONS (XCONS (tem)->car)->cdr;
        !           163: 
        !           164:       size += (XSTRING (str)->size +
        !           165:               XSTRING (val)->size +
        !           166:               2);      /* 1 for '=', 1 for '\000' */
        !           167:     }
        !           168:   return size;
        !           169: }
        !           170: 
        !           171: void
        !           172: get_current_environ (memory_block)
        !           173:      unsigned char **memory_block;
        !           174: {
        !           175:   register unsigned char **e, *s;
        !           176:   register int len;
        !           177:   register Lisp_Object tem;
        !           178: 
        !           179:   e = memory_block;
        !           180: 
        !           181:   tem = Flength (Venvironment_alist);
        !           182:   
        !           183:   s = (unsigned char *) memory_block
        !           184:                + (XINT (tem) + 1) * sizeof (unsigned char *);
        !           185: 
        !           186:   for (tem = Venvironment_alist; !NULL (tem); tem = XCONS (tem)->cdr)
        !           187:     {
        !           188:       register Lisp_Object str, val;
        !           189: 
        !           190:       str = XCONS (XCONS (tem)->car)->car;
        !           191:       val = XCONS (XCONS (tem)->car)->cdr;
        !           192: 
        !           193:       *e++ = s;
        !           194:       len = XSTRING (str)->size;
        !           195:       bcopy (XSTRING (str)->data, s, len);
        !           196:       s += len;
        !           197:       *s++ = '=';
        !           198:       len = XSTRING (val)->size;
        !           199:       bcopy (XSTRING (val)->data, s, len);
        !           200:       s += len;
        !           201:       *s++ = '\000';
        !           202:     }
        !           203:   *e = 0;
        !           204: }
        !           205: 
        !           206: #else
        !           207: /* dead code (this function mallocs, caller frees) superseded by above (which allows caller to use alloca) */
        !           208: unsigned char **
        !           209: current_environ ()
        !           210: {
        !           211:   unsigned char **env;
        !           212:   register unsigned char **e, *s;
        !           213:   register int len, env_len;
        !           214:   Lisp_Object tem;
        !           215:   Lisp_Object str, val;
        !           216: 
        !           217:   tem = Flength (Venvironment_alist);
        !           218: 
        !           219:   env_len = (XINT (tem) + 1) * sizeof (char *);
        !           220:   /* + 1 for terminating 0 */
        !           221: 
        !           222:   len = 0;
        !           223:   for (tem = Venvironment_alist; !NULL (tem); tem = XCONS (tem)->cdr)
        !           224:     {
        !           225:       str = XCONS (XCONS (tem)->car)->car;
        !           226:       val = XCONS (XCONS (tem)->car)->cdr;
        !           227: 
        !           228:       len += (XSTRING (str)->size +
        !           229:              XSTRING (val)->size +
        !           230:              2);
        !           231:     }
        !           232: 
        !           233:   e = env = (unsigned char **) xmalloc (env_len + len);
        !           234:   s = (unsigned char *) env + env_len;
        !           235: 
        !           236:   for (tem = Venvironment_alist; !NULL (tem); tem = XCONS (tem)->cdr)
        !           237:     {
        !           238:       str = XCONS (XCONS (tem)->car)->car;
        !           239:       val = XCONS (XCONS (tem)->car)->cdr;
        !           240: 
        !           241:       *e++ = s;
        !           242:       len = XSTRING (str)->size;
        !           243:       bcopy (XSTRING (str)->data, s, len);
        !           244:       s += len;
        !           245:       *s++ = '=';
        !           246:       len = XSTRING (val)->size;
        !           247:       bcopy (XSTRING (val)->data, s, len);
        !           248:       s += len;
        !           249:       *s++ = '\000';
        !           250:     }
        !           251:   *e = 0;
        !           252: 
        !           253:   return env;
        !           254: }
        !           255: 
        !           256: #endif /* dead code */
        !           257: 
        !           258: 
        !           259: DEFUN ("getenv", Fgetenv, Sgetenv, 1, 2, "sEnvironment variable: \np",
        !           260:   "Return the value of environment variable VAR, as a string.\n\
        !           261: When invoked interactively, print the value in the echo area.\n\
        !           262: VAR is a string, the name of the variable,\n\
        !           263:  or the symbol t, meaning to return an alist representing the\n\
        !           264:  current environment.")
        !           265:   (str, interactivep)
        !           266:      Lisp_Object str, interactivep;
        !           267: {
        !           268:   Lisp_Object val;
        !           269:   
        !           270:   if (str == Qt)               /* If arg is t, return whole environment */
        !           271:     return (Fcopy_alist (Venvironment_alist));
        !           272: 
        !           273:   CHECK_STRING (str, 0);
        !           274:   val = Fcdr (Fassoc (str, Venvironment_alist));
        !           275:   if (!NULL (interactivep))
        !           276:     {
        !           277:       if (NULL (val))
        !           278:        message ("%s not defined in environment", XSTRING (str)->data);
        !           279:       else
        !           280:        message ("\"%s\"", XSTRING (val)->data);
        !           281:     }
        !           282:   return val;
        !           283: }
        !           284: 
        !           285: DEFUN ("setenv", Fsetenv, Ssetenv, 1, 2,
        !           286:   "sEnvironment variable: \nsSet %s to value: ",
        !           287:   "Return the value of environment variable VAR, as a string.\n\
        !           288: When invoked interactively, print the value in the echo area.\n\
        !           289: VAR is a string, the name of the variable.")
        !           290:   (str, val)
        !           291:      Lisp_Object str;
        !           292:      Lisp_Object val;
        !           293: {
        !           294:   Lisp_Object tem;
        !           295: 
        !           296:   CHECK_STRING (str, 0);
        !           297:   if (!NULL (val))
        !           298:     CHECK_STRING (val, 0);
        !           299: 
        !           300:   set_environment_alist (str, val);
        !           301:   return val;
        !           302: }
        !           303: 
        !           304: 
        !           305: syms_of_environ ()
        !           306: {
        !           307:   staticpro (&Venvironment_alist);
        !           308:   defsubr (&Ssetenv);
        !           309:   defsubr (&Sgetenv);
        !           310: }
        !           311: 
        !           312: init_environ ()
        !           313: {
        !           314:   Venvironment_alist = Qnil;
        !           315:   initialize_environment_alist ();
        !           316: }
        !           317: 
        !           318: #endif /* MAINTAIN_ENVIRONMENT */

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.