[Emacs-diffs] Changes to emacs/src/lread.c

[Stefan Monnier]

Index: emacs/src/lread.c
diff -c emacs/src/lread.c:1.282 emacs/src/lread.c:1.283
*** emacs/src/lread.c:1.282     Fri Mar 29 07:37:22 2002
--- emacs/src/lread.c   Mon Apr 29 20:59:49 2002
***************
*** 694,700 ****
                   : Fappend (2, (tmp[0] = Vload_suffixes,
                                  tmp[1] = default_suffixes,
                                  tmp))),
!                 &found, 0);
        UNGCPRO;
      }
  
--- 694,700 ----
                   : Fappend (2, (tmp[0] = Vload_suffixes,
                                  tmp[1] = default_suffixes,
                                  tmp))),
!                 &found, Qnil);
        UNGCPRO;
      }
  
***************
*** 942,947 ****
--- 942,965 ----
          );
  }
  
+ DEFUN ("locate-file-internal", Flocate_file_internal, Slocate_file_internal, 
2, 4, 0,
+        doc: /* Search for FILENAME through PATH.
+ If SUFFIXES is non-nil, it should be a list of suffixes to append to
+ file name when searching.
+ If non-nil, PREDICATE is used instead of `file-readable-p'.
+ PREDICATE can also be an integer to pass to the access(2) function,
+ in which case file-name-handlers are ignored.  */)
+      (filename, path, suffixes, predicate)
+      Lisp_Object filename, path, suffixes, predicate;
+ {
+   Lisp_Object file;
+   int fd = openp (path, filename, suffixes, &file, predicate);
+   if (NILP (predicate) && fd > 0)
+     close (fd);
+   return file;
+ }
+ 
+ 
  /* Search for a file whose name is STR, looking in directories
     in the Lisp list PATH, and trying suffixes from SUFFIX.
     On success, returns a file descriptor.  On failure, returns -1.
***************
*** 949,972 ****
     SUFFIXES is a list of strings containing possible suffixes.
     The empty suffix is automatically added iff the list is empty.
  
!    EXEC_ONLY nonzero means don't open the files,
!    just look for one that is executable.  In this case,
!    returns 1 on success.
  
     If STOREPTR is nonzero, it points to a slot where the name of
     the file actually found should be stored as a Lisp string.
     nil is stored there on failure.
  
     If the file we find is remote, return -2
!    but store the found remote file name in *STOREPTR.
!    We do not check for remote files if EXEC_ONLY is nonzero.  */
  
  int
! openp (path, str, suffixes, storeptr, exec_only)
       Lisp_Object path, str;
       Lisp_Object suffixes;
       Lisp_Object *storeptr;
!      int exec_only;
  {
    register int fd;
    int fn_size = 100;
--- 967,991 ----
     SUFFIXES is a list of strings containing possible suffixes.
     The empty suffix is automatically added iff the list is empty.
  
!    PREDICATE non-nil means don't open the files,
!    just look for one that satisfies the predicate.  In this case,
!    returns 1 on success.  The predicate can be a lisp function or
!    an integer to pass to `access' (in which case file-name-handlers
!    are ignored).
  
     If STOREPTR is nonzero, it points to a slot where the name of
     the file actually found should be stored as a Lisp string.
     nil is stored there on failure.
  
     If the file we find is remote, return -2
!    but store the found remote file name in *STOREPTR.  */
  
  int
! openp (path, str, suffixes, storeptr, predicate)
       Lisp_Object path, str;
       Lisp_Object suffixes;
       Lisp_Object *storeptr;
!      Lisp_Object predicate;
  {
    register int fd;
    int fn_size = 100;
***************
*** 1054,1062 ****
             (load "/bar.el") where the file is actually "/bar.el.gz".  */
          handler = Ffind_file_name_handler (filename, Qfile_exists_p);
          string = build_string (fn);
!         if (!NILP (handler) && !exec_only)
!           {
!             exists = !NILP (Ffile_readable_p (string));
              if (exists && !NILP (Ffile_directory_p (string)))
                exists = 0;
  
--- 1073,1084 ----
             (load "/bar.el") where the file is actually "/bar.el.gz".  */
          handler = Ffind_file_name_handler (filename, Qfile_exists_p);
          string = build_string (fn);
!         if ((!NILP (handler) || !NILP (predicate)) && !NATNUMP (predicate))
!             {
!             if (NILP (predicate))
!               exists = !NILP (Ffile_readable_p (string));
!             else
!               exists = !NILP (call1 (predicate, string));
              if (exists && !NILP (Ffile_directory_p (string)))
                exists = 0;
  
***************
*** 1080,1087 ****
              if (exists)
                {
                  /* Check that we can access or open it.  */
!                 if (exec_only)
!                   fd = (access (pfn, X_OK) == 0) ? 1 : -1;
                  else
                    fd = emacs_open (pfn, O_RDONLY, 0);
  
--- 1102,1109 ----
              if (exists)
                {
                  /* Check that we can access or open it.  */
!                 if (NATNUMP (predicate))
!                   fd = (access (pfn, XFASTINT (predicate)) == 0) ? 1 : -1;
                  else
                    fd = emacs_open (pfn, O_RDONLY, 0);
  
***************
*** 1123,1131 ****
    tail = Vload_history;
    prev = Qnil;
    foundit = 0;
!   while (!NILP (tail))
      {
!       tem = Fcar (tail);
  
        /* Find the feature's previous assoc list... */
        if (!NILP (Fequal (source, Fcar (tem))))
--- 1145,1153 ----
    tail = Vload_history;
    prev = Qnil;
    foundit = 0;
!   while (CONSP (tail))
      {
!       tem = XCAR (tail);
  
        /* Find the feature's previous assoc list... */
        if (!NILP (Fequal (source, Fcar (tem))))
***************
*** 1134,1144 ****
  
          /*  If we're loading, remove it. */
          if (loading)
!           {     
              if (NILP (prev))
!               Vload_history = Fcdr (tail);
              else
!               Fsetcdr (prev, Fcdr (tail));
            }
  
          /*  Otherwise, cons on new symbols that are not already members.  */
--- 1156,1166 ----
  
          /*  If we're loading, remove it. */
          if (loading)
!           {
              if (NILP (prev))
!               Vload_history = XCDR (tail);
              else
!               Fsetcdr (prev, XCDR (tail));
            }
  
          /*  Otherwise, cons on new symbols that are not already members.  */
***************
*** 1148,1167 ****
  
              while (CONSP (tem2))
                {
!                 newelt = Fcar (tem2);
  
                  if (NILP (Fmemq (newelt, tem)))
!                   Fsetcar (tail, Fcons (Fcar (tem),
!                                         Fcons (newelt, Fcdr (tem))));
  
!                 tem2 = Fcdr (tem2);
                  QUIT;
                }
            }
        }
        else
        prev = tail;
!       tail = Fcdr (tail);
        QUIT;
      }
  
--- 1170,1189 ----
  
              while (CONSP (tem2))
                {
!                 newelt = XCAR (tem2);
  
                  if (NILP (Fmemq (newelt, tem)))
!                   Fsetcar (tail, Fcons (XCAR (tem),
!                                         Fcons (newelt, XCDR (tem))));
  
!                 tem2 = XCDR (tem2);
                  QUIT;
                }
            }
        }
        else
        prev = tail;
!       tail = XCDR (tail);
        QUIT;
      }
  
***************
*** 3594,3599 ****
--- 3616,3622 ----
    defsubr (&Sread_event);
    defsubr (&Sget_file_char);
    defsubr (&Smapatoms);
+   defsubr (&Slocate_file_internal);
  
    DEFVAR_LISP ("obarray", &Vobarray,
               doc: /* Symbol table for use by `intern' and `read'.