/[emacs]/emacs/src/lread.c
ViewVC logotype

Diff of /emacs/src/lread.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.290 by lektu, Thu Jul 11 14:12:50 2002 UTC revision 1.291 by raeburn, Mon Jul 15 00:00:36 2002 UTC
# Line 695  Return t if file exists.  */) Line 695  Return t if file exists.  */)
695    
696    /* Avoid weird lossage with null string as arg,    /* Avoid weird lossage with null string as arg,
697       since it would try to load a directory as a Lisp file */       since it would try to load a directory as a Lisp file */
698    if (XSTRING (file)->size > 0)    if (SCHARS (file) > 0)
699      {      {
700        int size = STRING_BYTES (XSTRING (file));        int size = SBYTES (file);
701        Lisp_Object tmp[2];        Lisp_Object tmp[2];
702    
703        GCPRO1 (file);        GCPRO1 (file);
# Line 706  Return t if file exists.  */) Line 706  Return t if file exists.  */)
706          {          {
707            /* Don't insist on adding a suffix if FILE already ends with one.  */            /* Don't insist on adding a suffix if FILE already ends with one.  */
708            if (size > 3            if (size > 3
709                && !strcmp (XSTRING (file)->data + size - 3, ".el"))                && !strcmp (SDATA (file) + size - 3, ".el"))
710              must_suffix = Qnil;              must_suffix = Qnil;
711            else if (size > 4            else if (size > 4
712                     && !strcmp (XSTRING (file)->data + size - 4, ".elc"))                     && !strcmp (SDATA (file) + size - 4, ".elc"))
713              must_suffix = Qnil;              must_suffix = Qnil;
714            /* Don't insist on adding a suffix            /* Don't insist on adding a suffix
715               if the argument includes a directory name.  */               if the argument includes a directory name.  */
# Line 778  Return t if file exists.  */) Line 778  Return t if file exists.  */)
778      Vloads_in_progress = Fcons (found, Vloads_in_progress);      Vloads_in_progress = Fcons (found, Vloads_in_progress);
779    }    }
780    
781    if (!bcmp (&(XSTRING (found)->data[STRING_BYTES (XSTRING (found)) - 4]),    if (!bcmp (&(SREF (found, SBYTES (found) - 4)),
782               ".elc", 4))               ".elc", 4))
783      /* Load .elc files directly, but not when they are      /* Load .elc files directly, but not when they are
784         remote and have no handler!  */         remote and have no handler!  */
# Line 793  Return t if file exists.  */) Line 793  Return t if file exists.  */)
793                safe_p = 0;                safe_p = 0;
794                if (!load_dangerous_libraries)                if (!load_dangerous_libraries)
795                  error ("File `%s' was not compiled in Emacs",                  error ("File `%s' was not compiled in Emacs",
796                         XSTRING (found)->data);                         SDATA (found));
797                else if (!NILP (nomessage))                else if (!NILP (nomessage))
798                  message_with_string ("File `%s' not compiled in Emacs", found, 1);                  message_with_string ("File `%s' not compiled in Emacs", found, 1);
799              }              }
# Line 806  Return t if file exists.  */) Line 806  Return t if file exists.  */)
806  #ifdef DOS_NT  #ifdef DOS_NT
807            fmode = "rb";            fmode = "rb";
808  #endif /* DOS_NT */  #endif /* DOS_NT */
809            stat ((char *)XSTRING (efound)->data, &s1);            stat ((char *)SDATA (efound), &s1);
810            XSTRING (efound)->data[STRING_BYTES (XSTRING (efound)) - 1] = 0;            SREF (efound, SBYTES (efound) - 1) = 0;
811            result = stat ((char *)XSTRING (efound)->data, &s2);            result = stat ((char *)SDATA (efound), &s2);
812            XSTRING (efound)->data[STRING_BYTES (XSTRING (efound)) - 1] = 'c';            SREF (efound, SBYTES (efound) - 1) = 'c';
813            UNGCPRO;            UNGCPRO;
814    
815            if (result >= 0 && (unsigned) s1.st_mtime < (unsigned) s2.st_mtime)            if (result >= 0 && (unsigned) s1.st_mtime < (unsigned) s2.st_mtime)
# Line 823  Return t if file exists.  */) Line 823  Return t if file exists.  */)
823                    Lisp_Object file;                    Lisp_Object file;
824                    file = Fsubstring (found, make_number (0), make_number (-1));                    file = Fsubstring (found, make_number (0), make_number (-1));
825                    message_with_string ("Source file `%s' newer than byte-compiled file",                    message_with_string ("Source file `%s' newer than byte-compiled file",
826                                         file, SMBP (file));                                         file, STRING_MULTIBYTE (file));
827                  }                  }
828              }              }
829          }          }
# Line 848  Return t if file exists.  */) Line 848  Return t if file exists.  */)
848    emacs_close (fd);    emacs_close (fd);
849    GCPRO1 (efound);    GCPRO1 (efound);
850    efound = ENCODE_FILE (found);    efound = ENCODE_FILE (found);
851    stream = fopen ((char *) XSTRING (efound)->data, fmode);    stream = fopen ((char *) SDATA (efound), fmode);
852    UNGCPRO;    UNGCPRO;
853  #else  /* not WINDOWSNT */  #else  /* not WINDOWSNT */
854    stream = fdopen (fd, fmode);    stream = fdopen (fd, fmode);
# Line 856  Return t if file exists.  */) Line 856  Return t if file exists.  */)
856    if (stream == 0)    if (stream == 0)
857      {      {
858        emacs_close (fd);        emacs_close (fd);
859        error ("Failure to create stdio stream for %s", XSTRING (file)->data);        error ("Failure to create stdio stream for %s", SDATA (file));
860      }      }
861    
862    if (! NILP (Vpurify_flag))    if (! NILP (Vpurify_flag))
# Line 958  static int Line 958  static int
958  complete_filename_p (pathname)  complete_filename_p (pathname)
959       Lisp_Object pathname;       Lisp_Object pathname;
960  {  {
961    register unsigned char *s = XSTRING (pathname)->data;    register unsigned char *s = SDATA (pathname);
962    return (IS_DIRECTORY_SEP (s[0])    return (IS_DIRECTORY_SEP (s[0])
963            || (XSTRING (pathname)->size > 2            || (SCHARS (pathname) > 2
964                && IS_DEVICE_SEP (s[1]) && IS_DIRECTORY_SEP (s[2]))                && IS_DEVICE_SEP (s[1]) && IS_DIRECTORY_SEP (s[2]))
965  #ifdef ALTOS  #ifdef ALTOS
966            || *s == '@'            || *s == '@'
# Line 1032  openp (path, str, suffixes, storeptr, pr Line 1032  openp (path, str, suffixes, storeptr, pr
1032      {      {
1033        CHECK_STRING_CAR (tail);        CHECK_STRING_CAR (tail);
1034        max_suffix_len = max (max_suffix_len,        max_suffix_len = max (max_suffix_len,
1035                              STRING_BYTES (XSTRING (XCAR (tail))));                              SBYTES (XCAR (tail)));
1036      }      }
1037    
1038    string = filename = Qnil;    string = filename = Qnil;
# Line 1060  openp (path, str, suffixes, storeptr, pr Line 1060  openp (path, str, suffixes, storeptr, pr
1060    
1061        /* Calculate maximum size of any filename made from        /* Calculate maximum size of any filename made from
1062           this path element/specified file name and any possible suffix.  */           this path element/specified file name and any possible suffix.  */
1063        want_size = max_suffix_len + STRING_BYTES (XSTRING (filename)) + 1;        want_size = max_suffix_len + SBYTES (filename) + 1;
1064        if (fn_size < want_size)        if (fn_size < want_size)
1065          fn = (char *) alloca (fn_size = 100 + want_size);          fn = (char *) alloca (fn_size = 100 + want_size);
1066    
# Line 1068  openp (path, str, suffixes, storeptr, pr Line 1068  openp (path, str, suffixes, storeptr, pr
1068        for (tail = NILP (suffixes) ? default_suffixes : suffixes;        for (tail = NILP (suffixes) ? default_suffixes : suffixes;
1069             CONSP (tail); tail = XCDR (tail))             CONSP (tail); tail = XCDR (tail))
1070          {          {
1071            int lsuffix = STRING_BYTES (XSTRING (XCAR (tail)));            int lsuffix = SBYTES (XCAR (tail));
1072            Lisp_Object handler;            Lisp_Object handler;
1073            int exists;            int exists;
1074    
1075            /* Concatenate path element/specified name with the suffix.            /* Concatenate path element/specified name with the suffix.
1076               If the directory starts with /:, remove that.  */               If the directory starts with /:, remove that.  */
1077            if (XSTRING (filename)->size > 2            if (SCHARS (filename) > 2
1078                && XSTRING (filename)->data[0] == '/'                && SREF (filename, 0) == '/'
1079                && XSTRING (filename)->data[1] == ':')                && SREF (filename, 1) == ':')
1080              {              {
1081                strncpy (fn, XSTRING (filename)->data + 2,                strncpy (fn, SDATA (filename) + 2,
1082                         STRING_BYTES (XSTRING (filename)) - 2);                         SBYTES (filename) - 2);
1083                fn[STRING_BYTES (XSTRING (filename)) - 2] = 0;                fn[SBYTES (filename) - 2] = 0;
1084              }              }
1085            else            else
1086              {              {
1087                strncpy (fn, XSTRING (filename)->data,                strncpy (fn, SDATA (filename),
1088                         STRING_BYTES (XSTRING (filename)));                         SBYTES (filename));
1089                fn[STRING_BYTES (XSTRING (filename))] = 0;                fn[SBYTES (filename)] = 0;
1090              }              }
1091    
1092            if (lsuffix != 0)  /* Bug happens on CCI if lsuffix is 0.  */            if (lsuffix != 0)  /* Bug happens on CCI if lsuffix is 0.  */
1093              strncat (fn, XSTRING (XCAR (tail))->data, lsuffix);              strncat (fn, SDATA (XCAR (tail)), lsuffix);
1094    
1095            /* Check that the file exists and is not a directory.  */            /* Check that the file exists and is not a directory.  */
1096            /* We used to only check for handlers on non-absolute file names:            /* We used to only check for handlers on non-absolute file names:
# Line 1125  openp (path, str, suffixes, storeptr, pr Line 1125  openp (path, str, suffixes, storeptr, pr
1125                char *pfn;                char *pfn;
1126    
1127                encoded_fn = ENCODE_FILE (string);                encoded_fn = ENCODE_FILE (string);
1128                pfn = XSTRING (encoded_fn)->data;                pfn = SDATA (encoded_fn);
1129                exists = (stat (pfn, &st) >= 0                exists = (stat (pfn, &st) >= 0
1130                          && (st.st_mode & S_IFMT) != S_IFDIR);                          && (st.st_mode & S_IFMT) != S_IFDIR);
1131                if (exists)                if (exists)
# Line 1507  read_internal_start (stream, start, end) Line 1507  read_internal_start (stream, start, end)
1507      {      {
1508        int startval, endval;        int startval, endval;
1509        if (NILP (end))        if (NILP (end))
1510          endval = XSTRING (stream)->size;          endval = SCHARS (stream);
1511        else        else
1512          {          {
1513            CHECK_NUMBER (end);            CHECK_NUMBER (end);
1514            endval = XINT (end);            endval = XINT (end);
1515            if (endval < 0 || endval > XSTRING (stream)->size)            if (endval < 0 || endval > SCHARS (stream))
1516              args_out_of_range (stream, end);              args_out_of_range (stream, end);
1517          }          }
1518    
# Line 1963  read1 (readcharfun, pch, first_in_list) Line 1963  read1 (readcharfun, pch, first_in_list)
1963    
1964                UNREAD (c);                UNREAD (c);
1965                tmp = read1 (readcharfun, pch, first_in_list);                tmp = read1 (readcharfun, pch, first_in_list);
1966                if (size_in_chars != XSTRING (tmp)->size                if (size_in_chars != SCHARS (tmp)
1967                    /* We used to print 1 char too many                    /* We used to print 1 char too many
1968                       when the number of bits was a multiple of 8.                       when the number of bits was a multiple of 8.
1969                       Accept such input in case it came from an old version.  */                       Accept such input in case it came from an old version.  */
1970                    && ! (XFASTINT (length)                    && ! (XFASTINT (length)
1971                          == (XSTRING (tmp)->size - 1) * BITS_PER_CHAR))                          == (SCHARS (tmp) - 1) * BITS_PER_CHAR))
1972                  Fsignal (Qinvalid_read_syntax,                  Fsignal (Qinvalid_read_syntax,
1973                           Fcons (make_string ("#&...", 5), Qnil));                           Fcons (make_string ("#&...", 5), Qnil));
1974                                    
1975                val = Fmake_bool_vector (length, Qnil);                val = Fmake_bool_vector (length, Qnil);
1976                bcopy (XSTRING (tmp)->data, XBOOL_VECTOR (val)->data,                bcopy (SDATA (tmp), XBOOL_VECTOR (val)->data,
1977                       size_in_chars);                       size_in_chars);
1978                /* Clear the extraneous bits in the last byte.  */                /* Clear the extraneous bits in the last byte.  */
1979                if (XINT (length) != size_in_chars * BITS_PER_CHAR)                if (XINT (length) != size_in_chars * BITS_PER_CHAR)
# Line 2614  substitute_object_recurse (object, place Line 2614  substitute_object_recurse (object, place
2614          /* Check for text properties in each interval.          /* Check for text properties in each interval.
2615             substitute_in_interval contains part of the logic. */             substitute_in_interval contains part of the logic. */
2616    
2617          INTERVAL    root_interval = XSTRING (subtree)->intervals;          INTERVAL    root_interval = STRING_INTERVALS (subtree);
2618          Lisp_Object arg           = Fcons (object, placeholder);          Lisp_Object arg           = Fcons (object, placeholder);
2619                        
2620          traverse_intervals_noorder (root_interval,          traverse_intervals_noorder (root_interval,
# Line 2760  read_vector (readcharfun, bytecodeflag) Line 2760  read_vector (readcharfun, bytecodeflag)
2760                    /* Coerce string to unibyte (like string-as-unibyte,                    /* Coerce string to unibyte (like string-as-unibyte,
2761                       but without generating extra garbage and                       but without generating extra garbage and
2762                       guaranteeing no change in the contents).  */                       guaranteeing no change in the contents).  */
2763                    XSTRING (bytestr)->size = STRING_BYTES (XSTRING (bytestr));                    SCHARS (bytestr) = SBYTES (bytestr);
2764                    SET_STRING_BYTES (XSTRING (bytestr), -1);                    STRING_SET_UNIBYTE (bytestr);
2765    
2766                    item = Fread (bytestr);                    item = Fread (bytestr);
2767                    if (!CONSP (item))                    if (!CONSP (item))
# Line 3040  it defaults to the value of `obarray'. Line 3040  it defaults to the value of `obarray'.
3040    
3041    CHECK_STRING (string);    CHECK_STRING (string);
3042    
3043    tem = oblookup (obarray, XSTRING (string)->data,    tem = oblookup (obarray, SDATA (string),
3044                    XSTRING (string)->size,                    SCHARS (string),
3045                    STRING_BYTES (XSTRING (string)));                    SBYTES (string));
3046    if (!INTEGERP (tem))    if (!INTEGERP (tem))
3047      return tem;      return tem;
3048    
# Line 3055  it defaults to the value of `obarray'. Line 3055  it defaults to the value of `obarray'.
3055    else    else
3056      XSYMBOL (sym)->interned = SYMBOL_INTERNED;      XSYMBOL (sym)->interned = SYMBOL_INTERNED;
3057    
3058    if ((XSTRING (string)->data[0] == ':')    if ((SREF (string, 0) == ':')
3059        && EQ (obarray, initial_obarray))        && EQ (obarray, initial_obarray))
3060      {      {
3061        XSYMBOL (sym)->constant = 1;        XSYMBOL (sym)->constant = 1;
# Line 3124  OBARRAY defaults to the value of the var Line 3124  OBARRAY defaults to the value of the var
3124        string = name;        string = name;
3125      }      }
3126    
3127    tem = oblookup (obarray, XSTRING (string)->data,    tem = oblookup (obarray, SDATA (string),
3128                    XSTRING (string)->size,                    SCHARS (string),
3129                    STRING_BYTES (XSTRING (string)));                    SBYTES (string));
3130    if (INTEGERP (tem))    if (INTEGERP (tem))
3131      return Qnil;      return Qnil;
3132    /* If arg was a symbol, don't delete anything but that symbol itself.  */    /* If arg was a symbol, don't delete anything but that symbol itself.  */
# Line 3203  oblookup (obarray, ptr, size, size_byte) Line 3203  oblookup (obarray, ptr, size, size_byte)
3203    else    else
3204      for (tail = bucket; ; XSETSYMBOL (tail, XSYMBOL (tail)->next))      for (tail = bucket; ; XSETSYMBOL (tail, XSYMBOL (tail)->next))
3205        {        {
3206          if (STRING_BYTES (XSTRING (SYMBOL_NAME (tail))) == size_byte          if (SBYTES (SYMBOL_NAME (tail)) == size_byte
3207              && XSTRING (SYMBOL_NAME (tail))->size == size              && SCHARS (SYMBOL_NAME (tail)) == size
3208              && !bcmp (XSTRING (SYMBOL_NAME (tail))->data, ptr, size_byte))              && !bcmp (SDATA (SYMBOL_NAME (tail)), ptr, size_byte))
3209            return tail;            return tail;
3210          else if (XSYMBOL (tail)->next == 0)          else if (XSYMBOL (tail)->next == 0)
3211            break;            break;
# Line 3618  init_lread () Line 3618  init_lread ()
3618            if (STRINGP (dirfile))            if (STRINGP (dirfile))
3619              {              {
3620                dirfile = Fdirectory_file_name (dirfile);                dirfile = Fdirectory_file_name (dirfile);
3621                if (access (XSTRING (dirfile)->data, 0) < 0)                if (access (SDATA (dirfile), 0) < 0)
3622                  dir_warning ("Warning: Lisp directory `%s' does not exist.\n",                  dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
3623                               XCAR (path_tail));                               XCAR (path_tail));
3624              }              }
# Line 3654  dir_warning (format, dirname) Line 3654  dir_warning (format, dirname)
3654       Lisp_Object dirname;       Lisp_Object dirname;
3655  {  {
3656    char *buffer    char *buffer
3657      = (char *) alloca (XSTRING (dirname)->size + strlen (format) + 5);      = (char *) alloca (SCHARS (dirname) + strlen (format) + 5);
3658    
3659    fprintf (stderr, format, XSTRING (dirname)->data);    fprintf (stderr, format, SDATA (dirname));
3660    sprintf (buffer, format, XSTRING (dirname)->data);    sprintf (buffer, format, SDATA (dirname));
3661    /* Don't log the warning before we've initialized!! */    /* Don't log the warning before we've initialized!! */
3662    if (initialized)    if (initialized)
3663      message_dolog (buffer, strlen (buffer), 0, STRING_MULTIBYTE (dirname));      message_dolog (buffer, strlen (buffer), 0, STRING_MULTIBYTE (dirname));

Legend:
Removed from v.1.290  
changed lines
  Added in v.1.291

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26