示例#1
0
文件: callproc.c 项目: coetry/remacs
Lisp_Object
encode_current_directory (void)
{
  Lisp_Object dir;

  dir = BVAR (current_buffer, directory);

  dir = Funhandled_file_name_directory (dir);

  /* If the file name handler says that dir is unreachable, use
     a sensible default. */
  if (NILP (dir))
    dir = build_string ("~");

  dir = expand_and_dir_to_file (dir, Qnil);

  if (NILP (Ffile_accessible_directory_p (dir)))
    report_file_error ("Setting current directory",
		       BVAR (current_buffer, directory));

  /* Remove "/:" from DIR and encode it.  */
  dir = ENCODE_FILE (remove_slash_colon (dir));

  if (! file_accessible_directory_p (dir))
    report_file_error ("Setting current directory",
		       BVAR (current_buffer, directory));

  return dir;
}
示例#2
0
文件: cygw32.c 项目: Wilfred/emacs
static Lisp_Object
conv_filename_to_w32_unicode (Lisp_Object in, int absolute_p)
{
  ssize_t converted_len;
  Lisp_Object converted;
  unsigned flags;
  int count = SPECPDL_INDEX ();

  chdir_to_default_directory ();

  flags = CCP_POSIX_TO_WIN_W;
  if (!absolute_p) {
    flags |= CCP_RELATIVE;
  }

  in = ENCODE_FILE (in);

  converted_len = cygwin_conv_path (flags, SDATA (in), NULL, 0);
  if (converted_len < 2)
    error ("cygwin_conv_path: %s", strerror (errno));

  converted = make_uninit_string (converted_len - 1);
  if (cygwin_conv_path (flags, SDATA (in),
                        SDATA (converted), converted_len))
    error ("cygwin_conv_path: %s", strerror (errno));

  return unbind_to (count, converted);
}
示例#3
0
文件: filelock.c 项目: mmaruska/emacs
void
lock_file (Lisp_Object fn)
{
  register Lisp_Object attack, orig_fn, encoded_fn;
  register char *lfname, *locker;
  lock_info_type lock_info;
  struct gcpro gcpro1;

  /* Don't do locking while dumping Emacs.
     Uncompressing wtmp files uses call-process, which does not work
     in an uninitialized Emacs.  */
  if (! NILP (Vpurify_flag))
    return;

  orig_fn = fn;
  GCPRO1 (fn);
  fn = Fexpand_file_name (fn, Qnil);
  encoded_fn = ENCODE_FILE (fn);

  /* Create the name of the lock-file for file fn */
  MAKE_LOCK_NAME (lfname, encoded_fn);

  /* See if this file is visited and has changed on disk since it was
     visited.  */
  {
    register Lisp_Object subject_buf;

    subject_buf = get_truename_buffer (orig_fn);

    if (!NILP (subject_buf)
	&& NILP (Fverify_visited_file_modtime (subject_buf))
	&& !NILP (Ffile_exists_p (fn)))
      call1 (intern ("ask-user-about-supersession-threat"), fn);

  }
  UNGCPRO;

  /* Try to lock the lock. */
  if (lock_if_free (&lock_info, lfname) <= 0)
    /* Return now if we have locked it, or if lock creation failed */
    return;

  /* Else consider breaking the lock */
  locker = (char *) alloca (strlen (lock_info.user) + strlen (lock_info.host)
			    + LOCK_PID_MAX + 9);
  sprintf (locker, "%s@%s (pid %lu)", lock_info.user, lock_info.host,
           lock_info.pid);
  FREE_LOCK_INFO (lock_info);

  attack = call2 (intern ("ask-user-about-lock"), fn, build_string (locker));
  if (!NILP (attack))
    /* User says take the lock */
    {
      lock_file_1 (lfname, 1);
      return;
    }
  /* User says ignore the lock */
}
示例#4
0
文件: filelock.c 项目: damianjb/emacs
void
unlock_file (register Lisp_Object fn)
{
  register char *lfname;

  fn = Fexpand_file_name (fn, Qnil);
  fn = ENCODE_FILE (fn);

  MAKE_LOCK_NAME (lfname, fn);

  if (current_lock_owner (0, lfname) == 2)
    unlink (lfname);
}
示例#5
0
文件: cygw32.c 项目: Wilfred/emacs
static void
chdir_to_default_directory (void)
{
  Lisp_Object new_cwd;
  int old_cwd_fd = emacs_open (".", O_RDONLY | O_DIRECTORY, 0);

  if (old_cwd_fd == -1)
    error ("could not open current directory: %s", strerror (errno));

  record_unwind_protect_int (fchdir_unwind, old_cwd_fd);

  new_cwd = Funhandled_file_name_directory (
    Fexpand_file_name (build_string ("."), Qnil));
  if (!STRINGP (new_cwd))
    new_cwd = build_string ("/");

  if (chdir (SSDATA (ENCODE_FILE (new_cwd))))
    error ("could not chdir: %s", strerror (errno));
}
示例#6
0
文件: dired.c 项目: fs814/emacs
Lisp_Object
directory_files_internal (Lisp_Object directory, Lisp_Object full,
			  Lisp_Object match, Lisp_Object nosort, bool attrs,
			  Lisp_Object id_format)
{
  DIR *d;
  int fd;
  ptrdiff_t directory_nbytes;
  Lisp_Object list, dirfilename, encoded_directory;
  struct re_pattern_buffer *bufp = NULL;
  bool needsep = 0;
  ptrdiff_t count = SPECPDL_INDEX ();
  struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
  struct dirent *dp;
#ifdef WINDOWSNT
  Lisp_Object w32_save = Qnil;
#endif

  /* Don't let the compiler optimize away all copies of DIRECTORY,
     which would break GC; see Bug#16986.  Although this is required
     only in the common case where GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS,
     it shouldn't break anything in the other cases.  */
  Lisp_Object volatile directory_volatile = directory;

  /* Because of file name handlers, these functions might call
     Ffuncall, and cause a GC.  */
  list = encoded_directory = dirfilename = Qnil;
  GCPRO5 (match, directory, list, dirfilename, encoded_directory);
  dirfilename = Fdirectory_file_name (directory);

  if (!NILP (match))
    {
      CHECK_STRING (match);

      /* MATCH might be a flawed regular expression.  Rather than
	 catching and signaling our own errors, we just call
	 compile_pattern to do the work for us.  */
      /* Pass 1 for the MULTIBYTE arg
	 because we do make multibyte strings if the contents warrant.  */
# ifdef WINDOWSNT
      /* Windows users want case-insensitive wildcards.  */
      bufp = compile_pattern (match, 0,
			      BVAR (&buffer_defaults, case_canon_table), 0, 1);
# else	/* !WINDOWSNT */
      bufp = compile_pattern (match, 0, Qnil, 0, 1);
# endif	 /* !WINDOWSNT */
    }

  /* Note: ENCODE_FILE and DECODE_FILE can GC because they can run
     run_pre_post_conversion_on_str which calls Lisp directly and
     indirectly.  */
  if (STRING_MULTIBYTE (dirfilename))
    dirfilename = ENCODE_FILE (dirfilename);
  encoded_directory = (STRING_MULTIBYTE (directory)
		       ? ENCODE_FILE (directory) : directory);

  /* Now *bufp is the compiled form of MATCH; don't call anything
     which might compile a new regexp until we're done with the loop!  */

  d = open_directory (SSDATA (dirfilename), &fd);
  if (d == NULL)
    report_file_error ("Opening directory", directory);

  /* Unfortunately, we can now invoke expand-file-name and
     file-attributes on filenames, both of which can throw, so we must
     do a proper unwind-protect.  */
  record_unwind_protect_ptr (directory_files_internal_unwind, d);

#ifdef WINDOWSNT
  if (attrs)
    {
      extern int is_slow_fs (const char *);

      /* Do this only once to avoid doing it (in w32.c:stat) for each
	 file in the directory, when we call Ffile_attributes below.  */
      record_unwind_protect (directory_files_internal_w32_unwind,
			     Vw32_get_true_file_attributes);
      w32_save = Vw32_get_true_file_attributes;
      if (EQ (Vw32_get_true_file_attributes, Qlocal))
	{
	  /* w32.c:stat will notice these bindings and avoid calling
	     GetDriveType for each file.  */
	  if (is_slow_fs (SDATA (dirfilename)))
	    Vw32_get_true_file_attributes = Qnil;
	  else
	    Vw32_get_true_file_attributes = Qt;
	}
    }
#endif

  directory_nbytes = SBYTES (directory);
  re_match_object = Qt;

  /* Decide whether we need to add a directory separator.  */
  if (directory_nbytes == 0
      || !IS_ANY_SEP (SREF (directory, directory_nbytes - 1)))
    needsep = 1;

  /* Loop reading blocks until EOF or error.  */
  for (;;)
    {
      ptrdiff_t len;
      bool wanted = 0;
      Lisp_Object name, finalname;
      struct gcpro gcpro1, gcpro2;

      errno = 0;
      dp = readdir (d);
      if (!dp)
	{
	  if (errno == EAGAIN || errno == EINTR)
	    {
	      QUIT;
	      continue;
	    }
	  break;
	}

      len = dirent_namelen (dp);
      name = finalname = make_unibyte_string (dp->d_name, len);
      GCPRO2 (finalname, name);

      /* Note: DECODE_FILE can GC; it should protect its argument,
	 though.  */
      name = DECODE_FILE (name);
      len = SBYTES (name);

      /* Now that we have unwind_protect in place, we might as well
	 allow matching to be interrupted.  */
      immediate_quit = 1;
      QUIT;

      if (NILP (match)
	  || re_search (bufp, SSDATA (name), len, 0, len, 0) >= 0)
	wanted = 1;

      immediate_quit = 0;

      if (wanted)
	{
	  if (!NILP (full))
	    {
	      Lisp_Object fullname;
	      ptrdiff_t nbytes = len + directory_nbytes + needsep;
	      ptrdiff_t nchars;

	      fullname = make_uninit_multibyte_string (nbytes, nbytes);
	      memcpy (SDATA (fullname), SDATA (directory),
		      directory_nbytes);

	      if (needsep)
		SSET (fullname, directory_nbytes, DIRECTORY_SEP);

	      memcpy (SDATA (fullname) + directory_nbytes + needsep,
		      SDATA (name), len);

	      nchars = multibyte_chars_in_text (SDATA (fullname), nbytes);

	      /* Some bug somewhere.  */
	      if (nchars > nbytes)
		emacs_abort ();

	      STRING_SET_CHARS (fullname, nchars);
	      if (nchars == nbytes)
		STRING_SET_UNIBYTE (fullname);

	      finalname = fullname;
	    }
	  else
	    finalname = name;

	  if (attrs)
	    {
	      Lisp_Object fileattrs
		= file_attributes (fd, dp->d_name, id_format);
	      list = Fcons (Fcons (finalname, fileattrs), list);
	    }
	  else
	    list = Fcons (finalname, list);
	}

      UNGCPRO;
    }

  block_input ();
  closedir (d);
  unblock_input ();
#ifdef WINDOWSNT
  if (attrs)
    Vw32_get_true_file_attributes = w32_save;
#endif

  /* Discard the unwind protect.  */
  specpdl_ptr = specpdl + count;

  if (NILP (nosort))
    list = Fsort (Fnreverse (list),
		  attrs ? Qfile_attributes_lessp : Qstring_lessp);

  (void) directory_volatile;
  RETURN_UNGCPRO (list);
}
示例#7
0
文件: doc.c 项目: primitivorm/emacs
Lisp_Object
get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
{
  char *from, *to, *name, *p, *p1;
  int fd;
  int offset;
  EMACS_INT position;
  Lisp_Object file, tem, pos;
  ptrdiff_t count;
  USE_SAFE_ALLOCA;

  if (INTEGERP (filepos))
    {
      file = Vdoc_file_name;
      pos = filepos;
    }
  else if (CONSP (filepos))
    {
      file = XCAR (filepos);
      pos = XCDR (filepos);
    }
  else
    return Qnil;

  position = eabs (XINT (pos));

  if (!STRINGP (Vdoc_directory))
    return Qnil;

  if (!STRINGP (file))
    return Qnil;

  /* Put the file name in NAME as a C string.
     If it is relative, combine it with Vdoc_directory.  */

  tem = Ffile_name_absolute_p (file);
  file = ENCODE_FILE (file);
  Lisp_Object docdir
    = NILP (tem) ? ENCODE_FILE (Vdoc_directory) : empty_unibyte_string;
  ptrdiff_t docdir_sizemax = SBYTES (docdir) + 1;
#ifndef CANNOT_DUMP
  docdir_sizemax = max (docdir_sizemax, sizeof sibling_etc);
#endif
  name = SAFE_ALLOCA (docdir_sizemax + SBYTES (file));
  lispstpcpy (lispstpcpy (name, docdir), file);

  fd = emacs_open (name, O_RDONLY, 0);
  if (fd < 0)
    {
#ifndef CANNOT_DUMP
      if (!NILP (Vpurify_flag))
	{
	  /* Preparing to dump; DOC file is probably not installed.
	     So check in ../etc.  */
	  lispstpcpy (stpcpy (name, sibling_etc), file);

	  fd = emacs_open (name, O_RDONLY, 0);
	}
#endif
      if (fd < 0)
	{
	  if (errno == EMFILE || errno == ENFILE)
	    report_file_error ("Read error on documentation file", file);

	  SAFE_FREE ();
	  AUTO_STRING (cannot_open, "Cannot open doc string file \"");
	  AUTO_STRING (quote_nl, "\"\n");
	  return concat3 (cannot_open, file, quote_nl);
	}
    }
  count = SPECPDL_INDEX ();
  record_unwind_protect_int (close_file_unwind, fd);

  /* Seek only to beginning of disk block.  */
  /* Make sure we read at least 1024 bytes before `position'
     so we can check the leading text for consistency.  */
  offset = min (position, max (1024, position % (8 * 1024)));
  if (TYPE_MAXIMUM (off_t) < position
      || lseek (fd, position - offset, 0) < 0)
    error ("Position %"pI"d out of range in doc string file \"%s\"",
	   position, name);

  /* Read the doc string into get_doc_string_buffer.
     P points beyond the data just read.  */

  p = get_doc_string_buffer;
  while (1)
    {
      ptrdiff_t space_left = (get_doc_string_buffer_size - 1
			      - (p - get_doc_string_buffer));
      int nread;

      /* Allocate or grow the buffer if we need to.  */
      if (space_left <= 0)
	{
	  ptrdiff_t in_buffer = p - get_doc_string_buffer;
	  get_doc_string_buffer
	    = xpalloc (get_doc_string_buffer, &get_doc_string_buffer_size,
		       16 * 1024, -1, 1);
	  p = get_doc_string_buffer + in_buffer;
	  space_left = (get_doc_string_buffer_size - 1
			- (p - get_doc_string_buffer));
	}

      /* Read a disk block at a time.
         If we read the same block last time, maybe skip this?  */
      if (space_left > 1024 * 8)
	space_left = 1024 * 8;
      nread = emacs_read (fd, p, space_left);
      if (nread < 0)
	report_file_error ("Read error on documentation file", file);
      p[nread] = 0;
      if (!nread)
	break;
      if (p == get_doc_string_buffer)
	p1 = strchr (p + offset, '\037');
      else
	p1 = strchr (p, '\037');
      if (p1)
	{
	  *p1 = 0;
	  p = p1;
	  break;
	}
      p += nread;
    }
  unbind_to (count, Qnil);
  SAFE_FREE ();

  /* Sanity checking.  */
  if (CONSP (filepos))
    {
      int test = 1;
      /* A dynamic docstring should be either at the very beginning of a "#@
	 comment" or right after a dynamic docstring delimiter (in case we
	 pack several such docstrings within the same comment).  */
      if (get_doc_string_buffer[offset - test] != '\037')
	{
	  if (get_doc_string_buffer[offset - test++] != ' ')
	    return Qnil;
	  while (get_doc_string_buffer[offset - test] >= '0'
		 && get_doc_string_buffer[offset - test] <= '9')
	    test++;
	  if (get_doc_string_buffer[offset - test++] != '@'
	      || get_doc_string_buffer[offset - test] != '#')
	    return Qnil;
	}
    }
  else
    {
      int test = 1;
      if (get_doc_string_buffer[offset - test++] != '\n')
	return Qnil;
      while (get_doc_string_buffer[offset - test] > ' ')
	test++;
      if (get_doc_string_buffer[offset - test] != '\037')
	return Qnil;
    }

  /* Scan the text and perform quoting with ^A (char code 1).
     ^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_.  */
  from = get_doc_string_buffer + offset;
  to = get_doc_string_buffer + offset;
  while (from != p)
    {
      if (*from == 1)
	{
	  int c;

	  from++;
	  c = *from++;
	  if (c == 1)
	    *to++ = c;
	  else if (c == '0')
	    *to++ = 0;
	  else if (c == '_')
	    *to++ = 037;
	  else
	    {
	      unsigned char uc = c;
	      error ("\
Invalid data in documentation file -- %c followed by code %03o",
		     1, uc);
	    }
	}
      else
	*to++ = *from++;
    }

  /* If DEFINITION, read from this buffer
     the same way we would read bytes from a file.  */
  if (definition)
    {
      read_bytecode_pointer = (unsigned char *) get_doc_string_buffer + offset;
      return Fread (Qlambda);
    }

  if (unibyte)
    return make_unibyte_string (get_doc_string_buffer + offset,
				to - (get_doc_string_buffer + offset));
  else
    {
      /* The data determines whether the string is multibyte.  */
      ptrdiff_t nchars
	= multibyte_chars_in_text (((unsigned char *) get_doc_string_buffer
				    + offset),
				   to - (get_doc_string_buffer + offset));
      return make_string_from_bytes (get_doc_string_buffer + offset,
				     nchars,
				     to - (get_doc_string_buffer + offset));
    }
}
示例#8
0
文件: doc.c 项目: rradonic/emacs
Lisp_Object
get_doc_string (Lisp_Object filepos, int unibyte, int definition)
{
    char *from, *to;
    register int fd;
    register char *name;
    register char *p, *p1;
    EMACS_INT minsize;
    EMACS_INT offset, position;
    Lisp_Object file, tem;

    if (INTEGERP (filepos))
    {
        file = Vdoc_file_name;
        position = XINT (filepos);
    }
    else if (CONSP (filepos))
    {
        file = XCAR (filepos);
        position = XINT (XCDR (filepos));
    }
    else
        return Qnil;

    if (position < 0)
        position = - position;

    if (!STRINGP (Vdoc_directory))
        return Qnil;

    if (!STRINGP (file))
        return Qnil;

    /* Put the file name in NAME as a C string.
       If it is relative, combine it with Vdoc_directory.  */

    tem = Ffile_name_absolute_p (file);
    file = ENCODE_FILE (file);
    if (NILP (tem))
    {
        Lisp_Object docdir = ENCODE_FILE (Vdoc_directory);
        minsize = SCHARS (docdir);
        /* sizeof ("../etc/") == 8 */
        if (minsize < 8)
            minsize = 8;
        name = (char *) alloca (minsize + SCHARS (file) + 8);
        strcpy (name, SSDATA (docdir));
        strcat (name, SSDATA (file));
    }
    else
    {
        name = SSDATA (file);
    }

    fd = emacs_open (name, O_RDONLY, 0);
    if (fd < 0)
    {
#ifndef CANNOT_DUMP
        if (!NILP (Vpurify_flag))
        {
            /* Preparing to dump; DOC file is probably not installed.
               So check in ../etc.  */
            strcpy (name, "../etc/");
            strcat (name, SSDATA (file));

            fd = emacs_open (name, O_RDONLY, 0);
        }
#endif
        if (fd < 0)
            error ("Cannot open doc string file \"%s\"", name);
    }

    /* Seek only to beginning of disk block.  */
    /* Make sure we read at least 1024 bytes before `position'
       so we can check the leading text for consistency.  */
    offset = min (position, max (1024, position % (8 * 1024)));
    if (0 > lseek (fd, position - offset, 0))
    {
        emacs_close (fd);
        error ("Position %"pI"d out of range in doc string file \"%s\"",
               position, name);
    }

    /* Read the doc string into get_doc_string_buffer.
       P points beyond the data just read.  */

    p = get_doc_string_buffer;
    while (1)
    {
        ptrdiff_t space_left = (get_doc_string_buffer_size - 1
                                - (p - get_doc_string_buffer));
        int nread;

        /* Allocate or grow the buffer if we need to.  */
        if (space_left <= 0)
        {
            ptrdiff_t in_buffer = p - get_doc_string_buffer;
            get_doc_string_buffer =
                xpalloc (get_doc_string_buffer, &get_doc_string_buffer_size,
                         16 * 1024, -1, 1);
            p = get_doc_string_buffer + in_buffer;
            space_left = (get_doc_string_buffer_size - 1
                          - (p - get_doc_string_buffer));
        }

        /* Read a disk block at a time.
           If we read the same block last time, maybe skip this?  */
        if (space_left > 1024 * 8)
            space_left = 1024 * 8;
        nread = emacs_read (fd, p, space_left);
        if (nread < 0)
        {
            emacs_close (fd);
            error ("Read error on documentation file");
        }
        p[nread] = 0;
        if (!nread)
            break;
        if (p == get_doc_string_buffer)
            p1 = strchr (p + offset, '\037');
        else
            p1 = strchr (p, '\037');
        if (p1)
        {
            *p1 = 0;
            p = p1;
            break;
        }
        p += nread;
    }
    emacs_close (fd);

    /* Sanity checking.  */
    if (CONSP (filepos))
    {
        int test = 1;
        if (get_doc_string_buffer[offset - test++] != ' ')
            return Qnil;
        while (get_doc_string_buffer[offset - test] >= '0'
                && get_doc_string_buffer[offset - test] <= '9')
            test++;
        if (get_doc_string_buffer[offset - test++] != '@'
                || get_doc_string_buffer[offset - test] != '#')
            return Qnil;
    }
    else
    {
        int test = 1;
        if (get_doc_string_buffer[offset - test++] != '\n')
            return Qnil;
        while (get_doc_string_buffer[offset - test] > ' ')
            test++;
        if (get_doc_string_buffer[offset - test] != '\037')
            return Qnil;
    }

    /* Scan the text and perform quoting with ^A (char code 1).
       ^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_.  */
    from = get_doc_string_buffer + offset;
    to = get_doc_string_buffer + offset;
    while (from != p)
    {
        if (*from == 1)
        {
            int c;

            from++;
            c = *from++;
            if (c == 1)
                *to++ = c;
            else if (c == '0')
                *to++ = 0;
            else if (c == '_')
                *to++ = 037;
            else
            {
                unsigned char uc = c;
                error ("\
Invalid data in documentation file -- %c followed by code %03o",
                       1, uc);
            }
        }
        else
            *to++ = *from++;
    }

    /* If DEFINITION, read from this buffer
       the same way we would read bytes from a file.  */
    if (definition)
    {
        read_bytecode_pointer = (unsigned char *) get_doc_string_buffer + offset;
        return Fread (Qlambda);
    }

    if (unibyte)
        return make_unibyte_string (get_doc_string_buffer + offset,
                                    to - (get_doc_string_buffer + offset));
    else
    {
        /* The data determines whether the string is multibyte.  */
        EMACS_INT nchars =
            multibyte_chars_in_text (((unsigned char *) get_doc_string_buffer
                                      + offset),
                                     to - (get_doc_string_buffer + offset));
        return make_string_from_bytes (get_doc_string_buffer + offset,
                                       nchars,
                                       to - (get_doc_string_buffer + offset));
    }
}
示例#9
0
文件: dired.c 项目: stanis/emacs
Lisp_Object
directory_files_internal (Lisp_Object directory, Lisp_Object full, Lisp_Object match, Lisp_Object nosort, int attrs, Lisp_Object id_format)
{
  DIR *d;
  int directory_nbytes;
  Lisp_Object list, dirfilename, encoded_directory;
  struct re_pattern_buffer *bufp = NULL;
  int needsep = 0;
  int count = SPECPDL_INDEX ();
  struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
  DIRENTRY *dp;
#ifdef WINDOWSNT
  Lisp_Object w32_save = Qnil;
#endif

  /* Because of file name handlers, these functions might call
     Ffuncall, and cause a GC.  */
  list = encoded_directory = dirfilename = Qnil;
  GCPRO5 (match, directory, list, dirfilename, encoded_directory);
  dirfilename = Fdirectory_file_name (directory);

  if (!NILP (match))
    {
      CHECK_STRING (match);

      /* MATCH might be a flawed regular expression.  Rather than
	 catching and signaling our own errors, we just call
	 compile_pattern to do the work for us.  */
      /* Pass 1 for the MULTIBYTE arg
	 because we do make multibyte strings if the contents warrant.  */
# ifdef WINDOWSNT
      /* Windows users want case-insensitive wildcards.  */
      bufp = compile_pattern (match, 0,
			      buffer_defaults.case_canon_table, 0, 1);
# else	/* !WINDOWSNT */
      bufp = compile_pattern (match, 0, Qnil, 0, 1);
# endif	 /* !WINDOWSNT */
    }

  /* Note: ENCODE_FILE and DECODE_FILE can GC because they can run
     run_pre_post_conversion_on_str which calls Lisp directly and
     indirectly.  */
  if (STRING_MULTIBYTE (dirfilename))
    dirfilename = ENCODE_FILE (dirfilename);
  encoded_directory = (STRING_MULTIBYTE (directory)
		       ? ENCODE_FILE (directory) : directory);

  /* Now *bufp is the compiled form of MATCH; don't call anything
     which might compile a new regexp until we're done with the loop!  */

  BLOCK_INPUT;
  d = opendir (SDATA (dirfilename));
  UNBLOCK_INPUT;
  if (d == NULL)
    report_file_error ("Opening directory", Fcons (directory, Qnil));

  /* Unfortunately, we can now invoke expand-file-name and
     file-attributes on filenames, both of which can throw, so we must
     do a proper unwind-protect.  */
  record_unwind_protect (directory_files_internal_unwind,
			 make_save_value (d, 0));

#ifdef WINDOWSNT
  if (attrs)
    {
      extern int is_slow_fs (const char *);

      /* Do this only once to avoid doing it (in w32.c:stat) for each
	 file in the directory, when we call Ffile_attributes below.  */
      record_unwind_protect (directory_files_internal_w32_unwind,
			     Vw32_get_true_file_attributes);
      w32_save = Vw32_get_true_file_attributes;
      if (EQ (Vw32_get_true_file_attributes, Qlocal))
	{
	  /* w32.c:stat will notice these bindings and avoid calling
	     GetDriveType for each file.  */
	  if (is_slow_fs (SDATA (dirfilename)))
	    Vw32_get_true_file_attributes = Qnil;
	  else
	    Vw32_get_true_file_attributes = Qt;
	}
    }
#endif

  directory_nbytes = SBYTES (directory);
  re_match_object = Qt;

  /* Decide whether we need to add a directory separator.  */
  if (directory_nbytes == 0
      || !IS_ANY_SEP (SREF (directory, directory_nbytes - 1)))
    needsep = 1;

  /* Loop reading blocks until EOF or error.  */
  for (;;)
    {
      errno = 0;
      dp = readdir (d);

      if (dp == NULL && (0
#ifdef EAGAIN
			 || errno == EAGAIN
#endif
#ifdef EINTR
			 || errno == EINTR
#endif
			 ))
	{ QUIT; continue; }

      if (dp == NULL)
	break;

      if (DIRENTRY_NONEMPTY (dp))
	{
	  int len;
	  int wanted = 0;
	  Lisp_Object name, finalname;
	  struct gcpro gcpro1, gcpro2;

	  len = NAMLEN (dp);
	  name = finalname = make_unibyte_string (dp->d_name, len);
	  GCPRO2 (finalname, name);

	  /* Note: DECODE_FILE can GC; it should protect its argument,
	     though.  */
	  name = DECODE_FILE (name);
	  len = SBYTES (name);

	  /* Now that we have unwind_protect in place, we might as well
             allow matching to be interrupted.  */
	  immediate_quit = 1;
	  QUIT;

	  if (NILP (match)
	      || (0 <= re_search (bufp, SDATA (name), len, 0, len, 0)))
	    wanted = 1;

	  immediate_quit = 0;

	  if (wanted)
	    {
	      if (!NILP (full))
		{
		  Lisp_Object fullname;
		  int nbytes = len + directory_nbytes + needsep;
		  int nchars;

		  fullname = make_uninit_multibyte_string (nbytes, nbytes);
		  memcpy (SDATA (fullname), SDATA (directory),
			  directory_nbytes);

		  if (needsep)
		    SSET (fullname, directory_nbytes, DIRECTORY_SEP);

		  memcpy (SDATA (fullname) + directory_nbytes + needsep,
			  SDATA (name), len);

		  nchars = chars_in_text (SDATA (fullname), nbytes);

		  /* Some bug somewhere.  */
		  if (nchars > nbytes)
		    abort ();

		  STRING_SET_CHARS (fullname, nchars);
		  if (nchars == nbytes)
		    STRING_SET_UNIBYTE (fullname);

		  finalname = fullname;
		}
	      else
		finalname = name;

	      if (attrs)
		{
		  /* Construct an expanded filename for the directory entry.
		     Use the decoded names for input to Ffile_attributes.  */
		  Lisp_Object decoded_fullname, fileattrs;
		  struct gcpro gcpro1, gcpro2;

		  decoded_fullname = fileattrs = Qnil;
		  GCPRO2 (decoded_fullname, fileattrs);

		  /* Both Fexpand_file_name and Ffile_attributes can GC.  */
		  decoded_fullname = Fexpand_file_name (name, directory);
		  fileattrs = Ffile_attributes (decoded_fullname, id_format);

		  list = Fcons (Fcons (finalname, fileattrs), list);
		  UNGCPRO;
		}
	      else
		list = Fcons (finalname, list);
	    }

	  UNGCPRO;
	}
    }

  BLOCK_INPUT;
  closedir (d);
  UNBLOCK_INPUT;
#ifdef WINDOWSNT
  if (attrs)
    Vw32_get_true_file_attributes = w32_save;
#endif

  /* Discard the unwind protect.  */
  specpdl_ptr = specpdl + count;

  if (NILP (nosort))
    list = Fsort (Fnreverse (list),
		  attrs ? Qfile_attributes_lessp : Qstring_lessp);

  RETURN_UNGCPRO (list);
}
示例#10
0
Lisp_Object
directory_files_internal (Lisp_Object directory, Lisp_Object full,
			  Lisp_Object match, Lisp_Object nosort, bool attrs,
			  Lisp_Object id_format)
{
  ptrdiff_t directory_nbytes;
  Lisp_Object list, dirfilename, encoded_directory;
  bool needsep = 0;
  ptrdiff_t count = SPECPDL_INDEX ();
#ifdef WINDOWSNT
  Lisp_Object w32_save = Qnil;
#endif

  /* Don't let the compiler optimize away all copies of DIRECTORY,
     which would break GC; see Bug#16986.  */
  Lisp_Object volatile directory_volatile = directory;

  /* Because of file name handlers, these functions might call
     Ffuncall, and cause a GC.  */
  list = encoded_directory = dirfilename = Qnil;
  dirfilename = Fdirectory_file_name (directory);

  /* Note: ENCODE_FILE and DECODE_FILE can GC because they can run
     run_pre_post_conversion_on_str which calls Lisp directly and
     indirectly.  */
  dirfilename = ENCODE_FILE (dirfilename);
  encoded_directory = ENCODE_FILE (directory);

  int fd;
  DIR *d = open_directory (dirfilename, &fd);

  /* Unfortunately, we can now invoke expand-file-name and
     file-attributes on filenames, both of which can throw, so we must
     do a proper unwind-protect.  */
  record_unwind_protect_ptr (directory_files_internal_unwind, d);

#ifdef WINDOWSNT
  if (attrs)
    {
      /* Do this only once to avoid doing it (in w32.c:stat) for each
	 file in the directory, when we call file_attributes below.  */
      record_unwind_protect (directory_files_internal_w32_unwind,
			     Vw32_get_true_file_attributes);
      w32_save = Vw32_get_true_file_attributes;
      if (EQ (Vw32_get_true_file_attributes, Qlocal))
	{
	  /* w32.c:stat will notice these bindings and avoid calling
	     GetDriveType for each file.  */
	  if (is_slow_fs (SSDATA (dirfilename)))
	    Vw32_get_true_file_attributes = Qnil;
	  else
	    Vw32_get_true_file_attributes = Qt;
	}
    }
#endif

  directory_nbytes = SBYTES (directory);
  re_match_object = Qt;

  /* Decide whether we need to add a directory separator.  */
  if (directory_nbytes == 0
      || !IS_ANY_SEP (SREF (directory, directory_nbytes - 1)))
    needsep = 1;

  /* Windows users want case-insensitive wildcards.  */
  Lisp_Object case_table =
#ifdef WINDOWSNT
    BVAR (&buffer_defaults, case_canon_table)
#else
    Qnil
#endif
    ;

  if (!NILP (match))
    CHECK_STRING (match);

  /* Loop reading directory entries.  */
  for (struct dirent *dp; (dp = read_dirent (d, directory)); )
    {
      ptrdiff_t len = dirent_namelen (dp);
      Lisp_Object name = make_unibyte_string (dp->d_name, len);
      Lisp_Object finalname = name;

      /* Note: DECODE_FILE can GC; it should protect its argument,
	 though.  */
      name = DECODE_FILE (name);
      len = SBYTES (name);

      /* Now that we have unwind_protect in place, we might as well
	 allow matching to be interrupted.  */
      maybe_quit ();

      bool wanted = (NILP (match) ||
                     fast_string_match_internal (
                       match, name, case_table) >= 0);

      if (wanted)
	{
	  if (!NILP (full))
	    {
	      Lisp_Object fullname;
	      ptrdiff_t nbytes = len + directory_nbytes + needsep;
	      ptrdiff_t nchars;

	      fullname = make_uninit_multibyte_string (nbytes, nbytes);
	      memcpy (SDATA (fullname), SDATA (directory),
		      directory_nbytes);

	      if (needsep)
		SSET (fullname, directory_nbytes, DIRECTORY_SEP);

	      memcpy (SDATA (fullname) + directory_nbytes + needsep,
		      SDATA (name), len);

	      nchars = multibyte_chars_in_text (SDATA (fullname), nbytes);

	      /* Some bug somewhere.  */
	      if (nchars > nbytes)
		emacs_abort ();

	      STRING_SET_CHARS (fullname, nchars);
	      if (nchars == nbytes)
		STRING_SET_UNIBYTE (fullname);

	      finalname = fullname;
	    }
	  else
	    finalname = name;

	  if (attrs)
	    {
	      Lisp_Object fileattrs
		= file_attributes (fd, dp->d_name, directory, name, id_format);
	      list = Fcons (Fcons (finalname, fileattrs), list);
	    }
	  else
	    list = Fcons (finalname, list);
	}
    }

  closedir (d);
#ifdef WINDOWSNT
  if (attrs)
    Vw32_get_true_file_attributes = w32_save;
#endif

  /* Discard the unwind protect.  */
  specpdl_ptr = specpdl + count;

  if (NILP (nosort))
    list = Fsort (Fnreverse (list),
		  attrs ? Qfile_attributes_lessp : Qstring_lessp);

  (void) directory_volatile;
  return list;
}