static emacs_value
module_make_string (emacs_env *env, const char *str, ptrdiff_t length)
{
  MODULE_FUNCTION_BEGIN (module_nil);
  Lisp_Object lstr = make_unibyte_string (str, length);
  return lisp_to_value (code_convert_string_norecord (lstr, Qutf_8, false));
}
Exemple #2
0
static Lisp_Object
inotifyevent_to_event (Lisp_Object watch, struct inotify_event const *ev)
{
  Lisp_Object name;
  uint32_t mask;
  CONS_TO_INTEGER (Fnth (make_number (3), watch), uint32_t, mask);

  if (! (mask & ev->mask))
    return Qnil;

  if (ev->len > 0)
    {
      size_t const len = strlen (ev->name);
      name = make_unibyte_string (ev->name, min (len, ev->len));
      name = DECODE_FILE (name);
    }
  else
    name = XCAR (XCDR (watch));

  return list2 (list4 (Fcons (INTEGER_TO_CONS (ev->wd), XCAR (watch)),
                       mask_to_aspects (ev->mask),
                       name,
		       INTEGER_TO_CONS (ev->cookie)),
		Fnth (make_number (2), watch));
}
Exemple #3
0
static emacs_value
module_make_string (emacs_env *env, const char *str, ptrdiff_t length)
{
  MODULE_FUNCTION_BEGIN (module_nil);
  if (length > STRING_BYTES_BOUND)
    {
      module_non_local_exit_signal_1 (env, Qoverflow_error, Qnil);
      return module_nil;
    }
  Lisp_Object lstr = make_unibyte_string (str, length);
  return lisp_to_value (code_convert_string_norecord (lstr, Qutf_8, false));
}
Exemple #4
0
static Lisp_Object
inotifyevent_to_event (Lisp_Object watch_object, struct inotify_event const *ev)
{
  Lisp_Object name = Qnil;
  if (ev->len > 0)
    {
      size_t const len = strlen (ev->name);
      name = make_unibyte_string (ev->name, min (len, ev->len));
      name = DECODE_FILE (name);
    }
  else
    name = XCAR (XCDR (watch_object));

  return list2 (list4 (make_watch_descriptor (ev->wd),
                       mask_to_aspects (ev->mask),
                       name,
                       make_number (ev->cookie)),
		Fnth (make_number (2), watch_object));
}
Exemple #5
0
static int
handle_file_notifications (struct input_event *hold_quit)
{
  BYTE *p = file_notifications;
  FILE_NOTIFY_INFORMATION *fni = (PFILE_NOTIFY_INFORMATION)p;
  const DWORD min_size
    = offsetof (FILE_NOTIFY_INFORMATION, FileName) + sizeof(wchar_t);
  struct input_event inev;
  int nevents = 0;

  /* We cannot process notification before Emacs is fully initialized,
     since we need the UTF-16LE coding-system to be set up.  */
  if (!initialized)
    {
      notification_buffer_in_use = 0;
      return nevents;
    }

  enter_crit ();
  if (notification_buffer_in_use)
    {
      DWORD info_size = notifications_size;
      Lisp_Object cs = intern ("utf-16le");
      Lisp_Object obj = w32_get_watch_object (notifications_desc);

      /* notifications_size could be zero when the buffer of
	 notifications overflowed on the OS level, or when the
	 directory being watched was itself deleted.  Do nothing in
	 that case.  */
      if (info_size
	  && !NILP (obj) && CONSP (obj))
	{
	  Lisp_Object callback = XCDR (obj);

	  EVENT_INIT (inev);

	  while (info_size >= min_size)
	    {
	      Lisp_Object utf_16_fn
		= make_unibyte_string ((char *)fni->FileName,
				       fni->FileNameLength);
	      /* Note: mule-conf is preloaded, so utf-16le must
		 already be defined at this point.  */
	      Lisp_Object fname
		= code_convert_string_norecord (utf_16_fn, cs, 0);
	      Lisp_Object action = lispy_file_action (fni->Action);

	      inev.kind = FILE_NOTIFY_EVENT;
	      inev.code = (ptrdiff_t)XINT (XIL ((EMACS_INT)notifications_desc));
	      inev.timestamp = GetTickCount ();
	      inev.modifiers = 0;
	      inev.frame_or_window = callback;
	      inev.arg = Fcons (action, fname);
	      kbd_buffer_store_event_hold (&inev, hold_quit);

	      if (!fni->NextEntryOffset)
		break;
	      p += fni->NextEntryOffset;
	      fni = (PFILE_NOTIFY_INFORMATION)p;
	      info_size -= fni->NextEntryOffset;
	    }
	}
      notification_buffer_in_use = 0;
    }
  leave_crit ();
  return nevents;
}
Exemple #6
0
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);
}
Exemple #7
0
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));
    }
}
Exemple #8
0
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);
  if (NILP (tem))
    {
      minsize = SCHARS (Vdoc_directory);
      /* sizeof ("../etc/") == 8 */
      if (minsize < 8)
	minsize = 8;
      name = (char *) alloca (minsize + SCHARS (file) + 8);
      strcpy (name, SSDATA (Vdoc_directory));
      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)
    {
      EMACS_INT space_left = (get_doc_string_buffer_size
			      - (p - get_doc_string_buffer));
      int nread;

      /* Allocate or grow the buffer if we need to.  */
      if (space_left == 0)
	{
	  EMACS_INT in_buffer = p - get_doc_string_buffer;
	  get_doc_string_buffer_size += 16 * 1024;
	  get_doc_string_buffer
	    = (char *) xrealloc (get_doc_string_buffer,
				 get_doc_string_buffer_size + 1);
	  p = get_doc_string_buffer + in_buffer;
	  space_left = (get_doc_string_buffer_size
			- (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));
    }
}
Exemple #9
0
int
handle_file_notifications (struct input_event *hold_quit)
{
  struct notifications_set *ns = NULL;
  int nevents = 0;
  int done = 0;

  /* We cannot process notification before Emacs is fully initialized,
     since we need the UTF-16LE coding-system to be set up.  */
  if (!initialized)
    {
      return nevents;
    }

  while (!done)
    {
      ns = NULL;

      /* Find out if there is a record available in the linked list of
	 notifications sets.  If so, unlink te set from the linked list.
	 Use the critical section.  */
      enter_crit ();
      if (notifications_set_head->next != notifications_set_head)
	{
	  ns = notifications_set_head->next;
	  ns->prev->next = ns->next;
	  ns->next->prev = ns->prev;
	}
      else
	done = 1;
      leave_crit();

      if (ns)
	{
	  BYTE *p = ns->notifications;
	  FILE_NOTIFY_INFORMATION *fni = (PFILE_NOTIFY_INFORMATION)p;
	  const DWORD min_size
	    = offsetof (FILE_NOTIFY_INFORMATION, FileName) + sizeof(wchar_t);
	  struct input_event inev;
	  DWORD info_size = ns->size;
	  Lisp_Object cs = Qutf_16le;
	  Lisp_Object obj = w32_get_watch_object (ns->desc);

	  /* notifications size could be zero when the buffer of
	     notifications overflowed on the OS level, or when the
	     directory being watched was itself deleted.  Do nothing in
	     that case.  */
	  if (info_size
	      && !NILP (obj) && CONSP (obj))
	    {
	      Lisp_Object callback = XCDR (obj);

	      EVENT_INIT (inev);

	      while (info_size >= min_size)
		{
		  Lisp_Object utf_16_fn
		    = make_unibyte_string ((char *)fni->FileName,
					   fni->FileNameLength);
		  /* Note: mule-conf is preloaded, so utf-16le must
		     already be defined at this point.  */
		  Lisp_Object fname
		    = code_convert_string_norecord (utf_16_fn, cs, 0);
		  Lisp_Object action = lispy_file_action (fni->Action);

		  inev.kind = FILE_NOTIFY_EVENT;
		  inev.timestamp = GetTickCount ();
		  inev.modifiers = 0;
		  inev.frame_or_window = callback;
		  inev.arg = Fcons (action, fname);
		  inev.arg = list3 (make_pointer_integer (ns->desc),
				    action, fname);
		  kbd_buffer_store_event_hold (&inev, hold_quit);
		  nevents++;
		  if (!fni->NextEntryOffset)
		    break;
		  p += fni->NextEntryOffset;
		  fni = (PFILE_NOTIFY_INFORMATION)p;
		  info_size -= fni->NextEntryOffset;
		}
	    }
	  /* Free this notification set.  */
	  free (ns->notifications);
	  free (ns);
	}
    }
  return nevents;
}
Exemple #10
0
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);
}
Exemple #11
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;
}