Return to environ.c CVS log

Up to [Apple XNU] / GNUtools / emacs / src

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

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