]> code.delx.au - gnu-emacs/blobdiff - src/fileio.c
removed x-list-font.c per change 2001-01-17 Gerd Moellmann <gerd@gnu.org>
[gnu-emacs] / src / fileio.c
index 0fcad5d99a272f643fdcebfd52b29200c62c0e95..eb6421a13744d06d624a1f7b3503e1ff87a03e75 100644 (file)
@@ -1,5 +1,5 @@
 /* File IO for GNU Emacs.
-   Copyright (C) 1985,86,87,88,93,94,95,96,97,98,99,2000
+   Copyright (C) 1985,86,87,88,93,94,95,96,97,98,99,2000, 2001
      Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
@@ -65,8 +65,10 @@ Boston, MA 02111-1307, USA.  */
 #include <errno.h>
 
 #ifndef vax11c
+#ifndef USE_CRT_DLL
 extern int errno;
 #endif
+#endif
 
 #ifdef APOLLO
 #include <sys/time.h>
@@ -839,22 +841,29 @@ static char make_temp_name_tbl[64] =
   'w','x','y','z','0','1','2','3',
   '4','5','6','7','8','9','-','_'
 };
+
 static unsigned make_temp_name_count, make_temp_name_count_initialized_p;
 
-DEFUN ("make-temp-name", Fmake_temp_name, Smake_temp_name, 1, 1, 0,
-  "Generate temporary file name (string) starting with PREFIX (a string).\n\
-The Emacs process number forms part of the result,\n\
-so there is no danger of generating a name being used by another process.\n\
-\n\
-In addition, this function makes an attempt to choose a name\n\
-which has no existing file.  To make this work,\n\
-PREFIX should be an absolute file name.\n\
-\n\
-There is a race condition between calling `make-temp-name' and creating the\n\
-file which opens all kinds of security holes.  For that reason, you should\n\
-probably use `make-temp-file' instead.")
-  (prefix)
+/* Value is a temporary file name starting with PREFIX, a string.
+   
+   The Emacs process number forms part of the result, so there is
+   no danger of generating a name being used by another process.
+   In addition, this function makes an attempt to choose a name
+   which has no existing file.  To make this work, PREFIX should be
+   an absolute file name.
+   
+   BASE64_P non-zero means add the pid as 3 characters in base64
+   encoding.  In this case, 6 characters will be added to PREFIX to
+   form the file name.  Otherwise, if Emacs is running on a system
+   with long file names, add the pid as a decimal number.
+
+   This function signals an error if no unique file name could be
+   generated.  */
+
+Lisp_Object
+make_temp_name (prefix, base64_p)
      Lisp_Object prefix;
+     int base64_p;
 {
   Lisp_Object val;
   int len;
@@ -862,7 +871,7 @@ probably use `make-temp-file' instead.")
   unsigned char *p, *data;
   char pidbuf[20];
   int pidlen;
-
+     
   CHECK_STRING (prefix, 0);
 
   /* VAL is created by adding 6 characters to PREFIX.  The first
@@ -872,16 +881,26 @@ probably use `make-temp-file' instead.")
 
   pid = (int) getpid ();
 
+  if (base64_p)
+    {
+      pidbuf[0] = make_temp_name_tbl[pid & 63], pid >>= 6;
+      pidbuf[1] = make_temp_name_tbl[pid & 63], pid >>= 6;
+      pidbuf[2] = make_temp_name_tbl[pid & 63], pid >>= 6;
+      pidlen = 3;
+    }
+  else
+    {
 #ifdef HAVE_LONG_FILE_NAMES
-  sprintf (pidbuf, "%d", pid);
-  pidlen = strlen (pidbuf);
+      sprintf (pidbuf, "%d", pid);
+      pidlen = strlen (pidbuf);
 #else
-  pidbuf[0] = make_temp_name_tbl[pid & 63], pid >>= 6;
-  pidbuf[1] = make_temp_name_tbl[pid & 63], pid >>= 6;
-  pidbuf[2] = make_temp_name_tbl[pid & 63], pid >>= 6;
-  pidlen = 3;
+      pidbuf[0] = make_temp_name_tbl[pid & 63], pid >>= 6;
+      pidbuf[1] = make_temp_name_tbl[pid & 63], pid >>= 6;
+      pidbuf[2] = make_temp_name_tbl[pid & 63], pid >>= 6;
+      pidlen = 3;
 #endif
-
+    }
+  
   len = XSTRING (prefix)->size;
   val = make_uninit_string (len + 3 + pidlen);
   data = XSTRING (val)->data;
@@ -933,7 +952,7 @@ probably use `make-temp-file' instead.")
               in looping through 225307 stat's, which is not only
               dog-slow, but also useless since it will fallback to
               the errow below, anyway.  */
-           report_file_error ("Cannot create temporary name for prefix `%s'",
+           report_file_error ("Cannot create temporary name for prefix",
                               Fcons (prefix, Qnil));
          /* not reached */
        }
@@ -944,6 +963,26 @@ probably use `make-temp-file' instead.")
   return Qnil;
 }
 
+
+DEFUN ("make-temp-name", Fmake_temp_name, Smake_temp_name, 1, 1, 0,
+  "Generate temporary file name (string) starting with PREFIX (a string).\n\
+The Emacs process number forms part of the result,\n\
+so there is no danger of generating a name being used by another process.\n\
+\n\
+In addition, this function makes an attempt to choose a name\n\
+which has no existing file.  To make this work,\n\
+PREFIX should be an absolute file name.\n\
+\n\
+There is a race condition between calling `make-temp-name' and creating the\n\
+file which opens all kinds of security holes.  For that reason, you should\n\
+probably use `make-temp-file' instead.")
+  (prefix)
+     Lisp_Object prefix;
+{
+  return make_temp_name (prefix, 0);
+}
+
+
 \f
 DEFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
   "Convert filename NAME to absolute, and canonicalize it.\n\
@@ -1934,7 +1973,7 @@ duplicates what `expand-file-name' does.")
   unsigned char *nm;
 
   register unsigned char *s, *p, *o, *x, *endp;
-  unsigned char *target;
+  unsigned char *target = NULL;
   int total = 0;
   int substituted = 0;
   unsigned char *xnm;
@@ -2141,6 +2180,7 @@ duplicates what `expand-file-name' does.")
 
   /* NOTREACHED */
 #endif /* not VMS */
+  return Qnil;
 }
 \f
 /* A slightly faster and more convenient way to get
@@ -2238,8 +2278,8 @@ This is what happens in interactive use with M-x.\n\
 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
 last-modified time as the old one.  (This works on only some systems.)\n\
 A prefix arg makes KEEP-TIME non-nil.")
-  (file, newname, ok_if_already_exists, keep_date)
-     Lisp_Object file, newname, ok_if_already_exists, keep_date;
+  (file, newname, ok_if_already_exists, keep_time)
+     Lisp_Object file, newname, ok_if_already_exists, keep_time;
 {
   int ifd, ofd, n;
   char buf[16 * 1024];
@@ -2266,7 +2306,7 @@ A prefix arg makes KEEP-TIME non-nil.")
     handler = Ffind_file_name_handler (newname, Qcopy_file);
   if (!NILP (handler))
     RETURN_UNGCPRO (call5 (handler, Qcopy_file, file, newname,
-                          ok_if_already_exists, keep_date));
+                          ok_if_already_exists, keep_time));
 
   encoded_file = ENCODE_FILE (file);
   encoded_newname = ENCODE_FILE (newname);
@@ -2341,7 +2381,7 @@ A prefix arg makes KEEP-TIME non-nil.")
 
   if (input_file_statable_p)
     {
-      if (!NILP (keep_date))
+      if (!NILP (keep_time))
        {
          EMACS_TIME atime, mtime;
          EMACS_SET_SECS_USECS (atime, st.st_atime, 0);
@@ -2509,6 +2549,12 @@ This is what happens in interactive use with M-x.")
   encoded_file = ENCODE_FILE (file);
   encoded_newname = ENCODE_FILE (newname);
 
+#ifdef DOS_NT
+  /* If the file names are identical but for the case, don't ask for
+     confirmation: they simply want to change the letter-case of the
+     file name.  */
+  if (NILP (Fstring_equal (Fdowncase (file), Fdowncase (newname))))
+#endif
   if (NILP (ok_if_already_exists)
       || INTEGERP (ok_if_already_exists))
     barf_or_query_if_file_exists (encoded_newname, "rename to it",
@@ -3372,11 +3418,11 @@ actually used.")
   int inserted = 0;
   register int how_much;
   register int unprocessed;
-  int count = specpdl_ptr - specpdl;
+  int count = BINDING_STACK_SIZE ();
   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
   Lisp_Object handler, val, insval, orig_filename;
   Lisp_Object p;
-  int total;
+  int total = 0;
   int not_regular = 0;
   unsigned char read_buf[READ_BUF_SIZE];
   struct coding_system coding;
@@ -3606,6 +3652,8 @@ actually used.")
        }
 
       setup_coding_system (Fcheck_coding_system (val), &coding);
+      /* Ensure we set Vlast_coding_system_used.  */
+      set_coding_system = 1;
 
       if (NILP (current_buffer->enable_multibyte_characters)
          && ! NILP (val))
@@ -3613,12 +3661,12 @@ actually used.")
           end-of-line conversion.  */
        setup_raw_text_coding_system (&coding);
 
+      coding.src_multibyte = 0;
+      coding.dst_multibyte
+       = !NILP (current_buffer->enable_multibyte_characters);
       coding_system_decided = 1;
     }
 
-  /* Ensure we always set Vlast_coding_system_used.  */
-  set_coding_system = 1;
-
   /* If requested, replace the accessible part of the buffer
      with the file contents.  Avoid replacing text at the
      beginning or end of the buffer that matches the file contents;
@@ -3635,9 +3683,7 @@ actually used.")
      and let the following if-statement handle the replace job.  */
   if (!NILP (replace)
       && BEGV < ZV
-      && ! CODING_REQUIRE_DECODING (&coding)
-      && (coding.eol_type == CODING_EOL_UNDECIDED
-         || coding.eol_type == CODING_EOL_LF))
+      && !(coding.common_flags & CODING_REQUIRE_DECODING_MASK))
     {
       /* same_at_start and same_at_end count bytes,
         because file access counts bytes
@@ -3674,7 +3720,7 @@ actually used.")
 
          if (coding.type == coding_type_undecided)
            detect_coding (&coding, buffer, nread);
-         if (CODING_REQUIRE_DECODING (&coding))
+         if (coding.common_flags & CODING_REQUIRE_DECODING_MASK)
            /* We found that the file should be decoded somehow.
                Let's give up here.  */
            {
@@ -3892,7 +3938,11 @@ actually used.")
              /* Save for next iteration whatever we didn't convert.  */
              unprocessed = this - coding.consumed;
              bcopy (read_buf + coding.consumed, read_buf, unprocessed);
-             this = coding.produced;
+             if (!NILP (current_buffer->enable_multibyte_characters))
+               this = coding.produced;
+             else
+               this = str_as_unibyte (conversion_buffer + inserted,
+                                      coding.produced);
            }
 
          inserted += this;
@@ -3992,7 +4042,7 @@ actually used.")
       /* Set `inserted' to the number of inserted characters.  */
       inserted = PT - temp;
 
-      free (conversion_buffer);
+      xfree (conversion_buffer);
       emacs_close (fd);
       specpdl_ptr--;
 
@@ -4091,6 +4141,8 @@ actually used.")
     error ("IO error reading %s: %s",
           XSTRING (orig_filename)->data, emacs_strerror (errno));
 
+ notfound:
+
   if (! coding_system_decided)
     {
       /* The coding system is not yet decided.  Decide it by an
@@ -4153,42 +4205,40 @@ actually used.")
        setup_coding_system (val, &temp_coding);
        bcopy (&temp_coding, &coding, sizeof coding);
       }
+      /* Ensure we set Vlast_coding_system_used.  */
+      set_coding_system = 1;
 
       if (NILP (current_buffer->enable_multibyte_characters)
          && ! NILP (val))
        /* We must suppress all character code conversion except for
           end-of-line conversion.  */
        setup_raw_text_coding_system (&coding);
+      coding.src_multibyte = 0;
+      coding.dst_multibyte
+       = !NILP (current_buffer->enable_multibyte_characters);
+    }
+
+  if (!NILP (visit)
+      && (coding.type == coding_type_no_conversion
+         || coding.type == coding_type_raw_text))
+    {
+      /* Visiting a file with these coding system always make the buffer
+        unibyte. */
+      current_buffer->enable_multibyte_characters = Qnil;
+      coding.dst_multibyte = 0;
     }
 
   if (inserted > 0 || coding.type == coding_type_ccl)
     {
       if (CODING_MAY_REQUIRE_DECODING (&coding))
        {
-         /* Here, we don't have to consider byte combining (see the
-             comment below) because code_convert_region takes care of
-             it.  */
          code_convert_region (PT, PT_BYTE, PT + inserted, PT_BYTE + inserted,
                               &coding, 0, 0);
-         inserted = (NILP (current_buffer->enable_multibyte_characters)
-                     ? coding.produced : coding.produced_char);
-       }
-      else if (!NILP (current_buffer->enable_multibyte_characters))
-       {
-         int inserted_byte = inserted;
-
-         /* There's a possibility that we must combine bytes at the
-            head (resp. the tail) of the just inserted text with the
-            bytes before (resp. after) the gap to form a single
-            character.  */
-         inserted = multibyte_chars_in_text (GPT_ADDR - inserted, inserted);
-         adjust_after_insert (PT, PT_BYTE,
-                              PT + inserted_byte, PT_BYTE + inserted_byte,
-                              inserted);
+         inserted = coding.produced_char;
        }
       else
        adjust_after_insert (PT, PT_BYTE, PT + inserted, PT_BYTE + inserted,
-                            inserted);
+                            inserted);
     }
 
 #ifdef DOS_NT
@@ -4203,7 +4253,6 @@ actually used.")
     current_buffer->buffer_file_type = Qnil;
 #endif
 
- notfound:
  handled:
 
   if (!NILP (visit))
@@ -4235,19 +4284,29 @@ actually used.")
        Fsignal (Qfile_error,
                 Fcons (build_string ("not a regular file"),
                        Fcons (orig_filename, Qnil)));
-
-      /* If visiting nonexistent file, return nil.  */
-      if (current_buffer->modtime == -1)
-       report_file_error ("Opening input file", Fcons (orig_filename, Qnil));
     }
 
   /* Decode file format */
   if (inserted > 0)
     {
+      int empty_undo_list_p = 0;
+      
+      /* If we're anyway going to discard undo information, don't
+        record it in the first place.  The buffer's undo list at this
+        point is either nil or t when visiting a file.  */
+      if (!NILP (visit))
+       {
+         empty_undo_list_p = NILP (current_buffer->undo_list);
+         current_buffer->undo_list = Qt;
+       }
+         
       insval = call3 (Qformat_decode,
                      Qnil, make_number (inserted), visit);
       CHECK_NUMBER (insval, 0);
       inserted = XFASTINT (insval);
+      
+      if (!NILP (visit))
+       current_buffer->undo_list = empty_undo_list_p ? Qnil : Qt;
     }
 
   if (set_coding_system)
@@ -4263,20 +4322,24 @@ actually used.")
       update_compositions (PT, PT, CHECK_BORDER);
     }
 
-  if (inserted > 0)
+  p = Vafter_insert_file_functions;
+  while (!NILP (p))
     {
-      p = Vafter_insert_file_functions;
-      while (!NILP (p))
+      insval = call1 (Fcar (p), make_number (inserted));
+      if (!NILP (insval))
        {
-         insval = call1 (Fcar (p), make_number (inserted));
-         if (!NILP (insval))
-           {
-             CHECK_NUMBER (insval, 0);
-             inserted = XFASTINT (insval);
-           }
-         QUIT;
-         p = Fcdr (p);
+         CHECK_NUMBER (insval, 0);
+         inserted = XFASTINT (insval);
        }
+      QUIT;
+      p = Fcdr (p);
+    }
+
+  if (!NILP (visit)
+      && current_buffer->modtime == -1)
+    {
+      /* If visiting nonexistent file, return nil.  */
+      report_file_error ("Opening input file", Fcons (orig_filename, Qnil));
     }
 
   /* ??? Retval needs to be dealt with in all cases consistently.  */
@@ -4349,7 +4412,7 @@ This does code conversion according to the value of\n\
 {
   register int desc;
   int failure;
-  int save_errno;
+  int save_errno = 0;
   unsigned char *fn;
   struct stat st;
   int tem;
@@ -4362,7 +4425,8 @@ This does code conversion according to the value of\n\
   Lisp_Object visit_file;
   Lisp_Object annotations;
   Lisp_Object encoded_filename;
-  int visiting, quietly;
+  int visiting = (EQ (visit, Qt) || STRINGP (visit));
+  int quietly = !NILP (visit);
   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
   struct buffer *given_buffer;
 #ifdef DOS_NT
@@ -4370,7 +4434,7 @@ This does code conversion according to the value of\n\
 #endif /* DOS_NT */
   struct coding_system coding;
 
-  if (current_buffer->base_buffer && ! NILP (visit))
+  if (current_buffer->base_buffer && visiting)
     error ("Cannot do file visiting in an indirect buffer");
 
   if (!NILP (start) && !STRINGP (start))
@@ -4482,9 +4546,6 @@ This does code conversion according to the value of\n\
     visit_file = filename;
   UNGCPRO;
 
-  visiting = (EQ (visit, Qt) || STRINGP (visit));
-  quietly = !NILP (visit);
-
   annotations = Qnil;
 
   if (NILP (lockname))
@@ -4843,6 +4904,7 @@ build_annotations (start, end, pre_write_conversion)
   Lisp_Object p, res;
   struct gcpro gcpro1, gcpro2;
   Lisp_Object original_buffer;
+  int i;
 
   XSETBUFFER (original_buffer, current_buffer);
 
@@ -4875,21 +4937,26 @@ build_annotations (start, end, pre_write_conversion)
     p = Vauto_save_file_format;
   else
     p = current_buffer->file_format;
-  while (!NILP (p))
+  for (i = 0; !NILP (p); p = Fcdr (p), ++i)
     {
       struct buffer *given_buffer = current_buffer;
+      
       Vwrite_region_annotations_so_far = annotations;
-      res = call4 (Qformat_annotate_function, Fcar (p), start, end,
-                  original_buffer);
+
+      /* Value is either a list of annotations or nil if the function
+         has written annotations to a temporary buffer, which is now
+         current.  */
+      res = call5 (Qformat_annotate_function, Fcar (p), start, end,
+                  original_buffer, make_number (i));
       if (current_buffer != given_buffer)
        {
          XSETFASTINT (start, BEGV);
          XSETFASTINT (end, ZV);
          annotations = Qnil;
        }
-      Flength (res);
-      annotations = merge (annotations, res, Qcar_less_than_car);
-      p = Fcdr (p);
+      
+      if (CONSP (res))
+       annotations = merge (annotations, res, Qcar_less_than_car);
     }
 
   /* At last, do the same for the function PRE_WRITE_CONVERSION
@@ -4993,17 +5060,21 @@ e_write (desc, string, start, end, coding)
     {
       addr = XSTRING (string)->data;
       nbytes = STRING_BYTES (XSTRING (string));
+      coding->src_multibyte = STRING_MULTIBYTE (string);
     }
   else if (start < end)
     {
       /* It is assured that the gap is not in the range START and END-1.  */
       addr = CHAR_POS_ADDR (start);
       nbytes = CHAR_TO_BYTE (end) - CHAR_TO_BYTE (start);
+      coding->src_multibyte
+       = !NILP (current_buffer->enable_multibyte_characters);
     }
   else
     {
       addr = "";
       nbytes = 0;
+      coding->src_multibyte = 1;
     }
 
   /* We used to have a code for handling selective display here.  But,
@@ -5042,6 +5113,10 @@ e_write (desc, string, start, end, coding)
       if (coding->cmp_data)
        coding_adjust_composition_offset (coding, start);
     }
+
+  if (coding->cmp_data)
+    coding_free_composition_data (coding);
+
   return return_val;
 }
 \f
@@ -5148,15 +5223,32 @@ An argument specifies the modification time value to use\n\
 }
 \f
 Lisp_Object
-auto_save_error ()
+auto_save_error (error)
+     Lisp_Object error;
 {
+  Lisp_Object args[3], msg;
+  int i, nbytes;
+  struct gcpro gcpro1;
+  
   ring_bell ();
-  message_with_string ("Autosaving...error for %s", current_buffer->name, 1);
-  Fsleep_for (make_number (1), Qnil);
-  message_with_string ("Autosaving...error for %s", current_buffer->name, 0);
-  Fsleep_for (make_number (1), Qnil);
-  message_with_string ("Autosaving...error for %s", current_buffer->name, 0);
-  Fsleep_for (make_number (1), Qnil);
+  
+  args[0] = build_string ("Auto-saving %s: %s");
+  args[1] = current_buffer->name;
+  args[2] = Ferror_message_string (error);
+  msg = Fformat (3, args);
+  GCPRO1 (msg);
+  nbytes = STRING_BYTES (XSTRING (msg));
+
+  for (i = 0; i < 3; ++i)
+    {
+      if (i == 0)
+       message2 (XSTRING (msg)->data, nbytes, STRING_MULTIBYTE (msg));
+      else
+       message2_nolog (XSTRING (msg)->data, nbytes, STRING_MULTIBYTE (msg));
+      Fsleep_for (make_number (1), Qnil);
+    }
+
+  UNGCPRO;
   return Qnil;
 }
 
@@ -5187,6 +5279,7 @@ do_auto_save_unwind (stream)  /* used as unwind-protect function */
   if (!NILP (stream))
     fclose ((FILE *) (XFASTINT (XCAR (stream)) << 16
                      | XFASTINT (XCDR (stream))));
+  pop_message ();
   return Qnil;
 }
 
@@ -5382,7 +5475,6 @@ A non-nil CURRENT-ONLY argument means save only current buffer.")
 
   Vquit_flag = oquit;
 
-  pop_message ();
   unbind_to (count, Qnil);
   return Qnil;
 }
@@ -5537,7 +5629,11 @@ Default name to DEFAULT-FILENAME if user enters a null string.\n\
 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
  Non-nil and non-t means also require confirmation after completion.\n\
 Fifth arg INITIAL specifies text to start with.\n\
-DIR defaults to current buffer's directory default.")
+DIR defaults to current buffer's directory default.\n\
+\n\
+If this command was invoked with the mouse, use a file dialog box if\n\
+`use-dialog-box' is non-nil, and the window system or X toolkit in use\n\
+provides a file dialog box..")
   (prompt, dir, default_filename, mustmatch, initial)
      Lisp_Object prompt, dir, default_filename, mustmatch, initial;
 {
@@ -5561,8 +5657,13 @@ DIR defaults to current buffer's directory default.")
   /* If dir starts with user's homedir, change that to ~. */
   homedir = (char *) egetenv ("HOME");
 #ifdef DOS_NT
-  homedir = strcpy (alloca (strlen (homedir) + 1), homedir);
-  CORRECT_DIR_SEPS (homedir);
+  /* homedir can be NULL in temacs, since Vprocess_environment is not
+     yet set up.  We shouldn't crash in that case.  */
+  if (homedir != 0)
+    {
+      homedir = strcpy (alloca (strlen (homedir) + 1), homedir);
+      CORRECT_DIR_SEPS (homedir);
+    }
 #endif
   if (homedir != 0
       && STRINGP (dir)
@@ -5620,7 +5721,7 @@ DIR defaults to current buffer's directory default.")
 
   GCPRO2 (insdef, default_filename);
   
-#ifdef USE_MOTIF
+#if defined (USE_MOTIF) || defined (HAVE_NTGUI)
   if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
       && use_dialog_box
       && have_menus_p ())
@@ -5633,7 +5734,8 @@ DIR defaults to current buffer's directory default.")
          default_filename = file;
          dir = Ffile_name_directory (dir);
        }
-      default_filename = Fexpand_file_name (default_filename, dir);
+      if (!NILP(default_filename))
+        default_filename = Fexpand_file_name (default_filename, dir);
       val = Fx_file_dialog (prompt, dir, default_filename, mustmatch);
       add_to_history = 1;
     }