(Fread_file_name): Correct handling of dollars in file
[bpt/emacs.git] / src / fileio.c
index 05350aa..f5371e6 100644 (file)
@@ -149,6 +149,10 @@ extern char *strerror ();
 #define O_RDONLY 0
 #endif
 
+#ifndef S_ISLNK
+#  define lstat stat
+#endif
+
 #define min(a, b) ((a) < (b) ? (a) : (b))
 #define max(a, b) ((a) > (b) ? (a) : (b))
 
@@ -206,6 +210,10 @@ Lisp_Object Vdirectory_sep_char;
 
 extern Lisp_Object Vuser_login_name;
 
+#ifdef WINDOWSNT
+extern Lisp_Object Vw32_get_true_file_attributes;
+#endif
+
 extern int minibuf_level;
 
 extern int minibuffer_auto_raise;
@@ -2107,7 +2115,7 @@ duplicates what `expand-file-name' does.")
       xnm = p;
 #ifdef DOS_NT
     else if (IS_DRIVE (p[0]) && p[1] == ':'
-            && p > nm && IS_DIRECTORY_SEP (p[-1]))
+            && p > xnm && IS_DIRECTORY_SEP (p[-1]))
       xnm = p;
 #endif
 
@@ -3016,7 +3024,9 @@ Otherwise returns nil.")
 }
 
 DEFUN ("file-directory-p", Ffile_directory_p, Sfile_directory_p, 1, 1, 0,
-  "Return t if FILENAME names an existing directory.")
+  "Return t if FILENAME names an existing directory.\n\
+Symbolic links to directories count as directories.\n\
+See `file-symlink-p' to distinguish symlinks.")
   (filename)
      Lisp_Object filename;
 {
@@ -3092,9 +3102,25 @@ This is the sort of file that holds an ordinary stream of data bytes.")
 
   absname = ENCODE_FILE (absname);
 
+#ifdef WINDOWSNT
+  {
+    int result;
+    Lisp_Object tem = Vw32_get_true_file_attributes;
+
+    /* Tell stat to use expensive method to get accurate info.  */
+    Vw32_get_true_file_attributes = Qt;
+    result = stat (XSTRING (absname)->data, &st);
+    Vw32_get_true_file_attributes = tem;
+
+    if (result < 0)
+      return Qnil;
+    return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil;
+  }
+#else
   if (stat (XSTRING (absname)->data, &st) < 0)
     return Qnil;
   return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil;
+#endif
 }
 \f
 DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 1, 0,
@@ -3345,12 +3371,24 @@ actually used.")
 
   fd = -1;
 
+#ifdef WINDOWSNT
+  {
+    Lisp_Object tem = Vw32_get_true_file_attributes;
+
+    /* Tell stat to use expensive method to get accurate info.  */
+    Vw32_get_true_file_attributes = Qt;
+    total = stat (XSTRING (filename)->data, &st);
+    Vw32_get_true_file_attributes = tem;
+  }
+  if (total < 0)
+#else
 #ifndef APOLLO
   if (stat (XSTRING (filename)->data, &st) < 0)
 #else
   if ((fd = open (XSTRING (filename)->data, O_RDONLY)) < 0
       || fstat (fd, &st) < 0)
 #endif /* not APOLLO */
+#endif /* WINDOWSNT */
     {
       if (fd >= 0) close (fd);
     badopen:
@@ -3439,7 +3477,7 @@ actually used.")
              /* Find a coding system specified in the heading two
                 lines or in the tailing several lines of the file.
                 We assume that the 1K-byte and 3K-byte for heading
-                and tailing respectively are sufficient fot this
+                and tailing respectively are sufficient for this
                 purpose.  */
              int how_many, nread;
 
@@ -3471,7 +3509,8 @@ actually used.")
                  current_buffer->enable_multibyte_characters = Qnil;
                  insert_1_both (read_buf, nread, nread, 0, 0, 0);
                  TEMP_SET_PT_BOTH (BEG, BEG_BYTE);
-                 val = call1 (Vset_auto_coding_function, make_number (nread));
+                 val = call2 (Vset_auto_coding_function,
+                              filename, make_number (nread));
                  set_buffer_internal (prev);
                  /* Discard the unwind protect for recovering the
                      current buffer.  */
@@ -3666,7 +3705,14 @@ actually used.")
 
          /* We win!  We can handle REPLACE the optimized way.  */
 
-         /* Extends the end of non-matching text area to multibyte
+         /* Extend the start of non-matching text area to multibyte
+             character boundary.  */
+         if (! NILP (current_buffer->enable_multibyte_characters))
+           while (same_at_start > BEGV_BYTE
+                  && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start)))
+             same_at_start--;
+
+         /* Extend the end of non-matching text area to multibyte
              character boundary.  */
          if (! NILP (current_buffer->enable_multibyte_characters))
            while (same_at_end < ZV_BYTE
@@ -3722,7 +3768,7 @@ actually used.")
 
       if (lseek (fd, XINT (beg), 0) < 0)
        {
-         free (conversion_buffer);
+         xfree (conversion_buffer);
          report_file_error ("Setting file position",
                             Fcons (orig_filename, Qnil));
        }
@@ -3821,6 +3867,13 @@ actually used.")
          goto handled;
        }
 
+      /* Extend the start of non-matching text area to multibyte
+        character boundary.  */
+      if (! NILP (current_buffer->enable_multibyte_characters))
+       while (same_at_start > BEGV_BYTE
+              && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start)))
+         same_at_start--;
+
       /* Scan this bufferful from the end, comparing with
         the Emacs buffer.  */
       bufpos = inserted;
@@ -3831,6 +3884,13 @@ actually used.")
             && FETCH_BYTE (same_at_end - 1) == conversion_buffer[bufpos - 1])
        same_at_end--, bufpos--;
 
+      /* Extend the end of non-matching text area to multibyte
+        character boundary.  */
+      if (! NILP (current_buffer->enable_multibyte_characters))
+       while (same_at_end < ZV_BYTE
+              && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end)))
+         same_at_end++;
+
       /* Don't try to reuse the same piece of text twice.  */
       overlap = same_at_start - BEGV_BYTE - (same_at_end + inserted - ZV_BYTE);
       if (overlap > 0)
@@ -3956,73 +4016,73 @@ actually used.")
     error ("IO error reading %s: %s",
           XSTRING (orig_filename)->data, strerror (errno));
 
-  if (inserted > 0)
+  if (! coding_system_decided)
     {
-      if (! coding_system_decided)
-       {
-         /* The coding system is not yet decided.  Decide it by an
-            optimized method for handling `coding:' tag.  */
-         Lisp_Object val;
-         val = Qnil;
+      /* The coding system is not yet decided.  Decide it by an
+        optimized method for handling `coding:' tag.  */
+      Lisp_Object val;
+      val = Qnil;
 
-         if (!NILP (Vcoding_system_for_read))
-           val = Vcoding_system_for_read;
-         else
+      if (!NILP (Vcoding_system_for_read))
+       val = Vcoding_system_for_read;
+      else
+       {
+         if (inserted > 0 && ! NILP (Vset_auto_coding_function))
            {
-             if (! NILP (Vset_auto_coding_function))
-               {
-                 /* Since we are sure that the current buffer was
-                    empty before the insertion, we can toggle
-                    enable-multibyte-characters directly here without
-                    taking care of marker adjustment and byte
-                    combining problem.  */
-                 Lisp_Object prev_multibyte;
-                 int count = specpdl_ptr - specpdl;
+             /* Since we are sure that the current buffer was
+                empty before the insertion, we can toggle
+                enable-multibyte-characters directly here without
+                taking care of marker adjustment and byte
+                combining problem.  */
+             Lisp_Object prev_multibyte;
+             int count = specpdl_ptr - specpdl;
+
+             prev_multibyte = current_buffer->enable_multibyte_characters;
+             current_buffer->enable_multibyte_characters = Qnil;
+             record_unwind_protect (set_auto_coding_unwind,
+                                    prev_multibyte);
+             val = call2 (Vset_auto_coding_function,
+                          filename, make_number (inserted));
+             /* Discard the unwind protect for recovering the
+                error of Vset_auto_coding_function.  */
+             specpdl_ptr--;
+             current_buffer->enable_multibyte_characters = prev_multibyte;
+             TEMP_SET_PT_BOTH (BEG, BEG_BYTE);
+           }
 
-                 prev_multibyte = current_buffer->enable_multibyte_characters;
-                 current_buffer->enable_multibyte_characters = Qnil;
-                 record_unwind_protect (set_auto_coding_unwind,
-                                        prev_multibyte);
-                 val = call1 (Vset_auto_coding_function,
-                              make_number (inserted));
-                 /* Discard the unwind protect for recovering the
-                    error of Vset_auto_coding_function.  */
-                 specpdl_ptr--;
-                 current_buffer->enable_multibyte_characters = prev_multibyte;
-                 TEMP_SET_PT_BOTH (BEG, BEG_BYTE);
-               }
+         if (NILP (val))
+           {
+             /* If the coding system is not yet decided, check
+                file-coding-system-alist.  */
+             Lisp_Object args[6], coding_systems;
 
-             if (NILP (val))
-               {
-                 /* If the coding system is not yet decided, check
-                    file-coding-system-alist.  */
-                 Lisp_Object args[6], coding_systems;
-
-                 args[0] = Qinsert_file_contents, args[1] = orig_filename;
-                 args[2] = visit, args[3] = beg, args[4] = end, args[5] = Qnil;
-                 coding_systems = Ffind_operation_coding_system (6, args);
-                 if (CONSP (coding_systems))
-                   val = XCONS (coding_systems)->car;
-               }
+             args[0] = Qinsert_file_contents, args[1] = orig_filename;
+             args[2] = visit, args[3] = beg, args[4] = end, args[5] = Qnil;
+             coding_systems = Ffind_operation_coding_system (6, args);
+             if (CONSP (coding_systems))
+               val = XCONS (coding_systems)->car;
            }
+       }
 
-         /* The following kludgy code is to avoid some compiler bug.
-            We can't simply do
-               setup_coding_system (val, &coding);
-            on some system.  */
-         {
-           struct coding_system temp_coding;
-           setup_coding_system (val, &temp_coding);
-           bcopy (&temp_coding, &coding, sizeof coding);
-         }
+      /* The following kludgy code is to avoid some compiler bug.
+        We can't simply do
+        setup_coding_system (val, &coding);
+        on some system.  */
+      {
+       struct coding_system temp_coding;
+       setup_coding_system (val, &temp_coding);
+       bcopy (&temp_coding, &coding, sizeof coding);
+      }
 
-         if (NILP (Vcoding_system_for_read)
-             && NILP (current_buffer->enable_multibyte_characters))
-           /* We must suppress all text conversion except for
-              end-of-line conversion.  */
-           setup_raw_text_coding_system (&coding);
-       }
+      if (NILP (Vcoding_system_for_read)
+         && NILP (current_buffer->enable_multibyte_characters))
+       /* We must suppress all text conversion except for
+          end-of-line conversion.  */
+       setup_raw_text_coding_system (&coding);
+    }
 
+  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
@@ -4049,19 +4109,19 @@ actually used.")
       else
        adjust_after_insert (PT, PT_BYTE, PT + inserted, PT_BYTE + inserted,
                             inserted);
+    }
 
 #ifdef DOS_NT
-      /* Use the conversion type to determine buffer-file-type
-        (find-buffer-file-type is now used to help determine the
-        conversion).  */
-      if ((coding.eol_type == CODING_EOL_UNDECIDED 
-          || coding.eol_type == CODING_EOL_LF)
-         && ! CODING_REQUIRE_DECODING (&coding))
-       current_buffer->buffer_file_type = Qt;
-      else
-       current_buffer->buffer_file_type = Qnil;
+  /* Use the conversion type to determine buffer-file-type
+     (find-buffer-file-type is now used to help determine the
+     conversion).  */
+  if ((coding.eol_type == CODING_EOL_UNDECIDED 
+       || coding.eol_type == CODING_EOL_LF)
+      && ! CODING_REQUIRE_DECODING (&coding))
+    current_buffer->buffer_file_type = Qt;
+  else
+    current_buffer->buffer_file_type = Qnil;
 #endif
-    }
 
  notfound:
  handled:
@@ -4117,7 +4177,7 @@ actually used.")
       && (NILP (visit) || !NILP (replace)))
     signal_after_change (PT, 0, inserted);
 
-  if (set_coding_system && inserted > 0)
+  if (set_coding_system)
     Vlast_coding_system_used = coding.symbol;
 
   if (inserted > 0)
@@ -4238,7 +4298,7 @@ This does code conversion according to the value of\n\
       val = Qnil;
     else if (!NILP (Vcoding_system_for_write))
       val = Vcoding_system_for_write;
-    else if (NILP (current_buffer->enable_multibyte_characters))
+    else
       {
        /* If the variable `buffer-file-coding-system' is set locally,
           it means that the file was read with some kind of code
@@ -4249,38 +4309,72 @@ This does code conversion according to the value of\n\
           If it is not set locally, we anyway have to convert EOL
           format if the default value of `buffer-file-coding-system'
           tells that it is not Unix-like (LF only) format.  */
+       int using_default_coding = 0;
+       int force_raw_text = 0;
+
        val = current_buffer->buffer_file_coding_system;
-       if (NILP (Flocal_variable_p (Qbuffer_file_coding_system, Qnil)))
+       if (NILP (val)
+           || NILP (Flocal_variable_p (Qbuffer_file_coding_system, Qnil)))
+         {
+           val = Qnil;
+           if (NILP (current_buffer->enable_multibyte_characters))
+             force_raw_text = 1;
+         }
+       
+       if (NILP (val))
+         {
+           /* Check file-coding-system-alist.  */
+           Lisp_Object args[7], coding_systems;
+
+           args[0] = Qwrite_region; args[1] = start; args[2] = end;
+           args[3] = filename; args[4] = append; args[5] = visit;
+           args[6] = lockname;
+           coding_systems = Ffind_operation_coding_system (7, args);
+           if (CONSP (coding_systems) && !NILP (XCONS (coding_systems)->cdr))
+             val = XCONS (coding_systems)->cdr;
+         }
+
+       if (NILP (val)
+           && !NILP (current_buffer->buffer_file_coding_system))
          {
-           struct coding_system coding_temp;
+           /* If we still have not decided a coding system, use the
+              default value of buffer-file-coding-system.  */
+           val = current_buffer->buffer_file_coding_system;
+           using_default_coding = 1;
+         }
+           
+       if (!force_raw_text
+           && !NILP (Ffboundp (Vselect_safe_coding_system_function)))
+         /* Confirm that VAL can surely encode the current region.  */
+         val = call3 (Vselect_safe_coding_system_function, start, end, val);
 
-           setup_coding_system (Fcheck_coding_system (val), &coding_temp);
-           if (coding_temp.eol_type == CODING_EOL_CRLF
-               || coding_temp.eol_type == CODING_EOL_CR)
+       setup_coding_system (Fcheck_coding_system (val), &coding);
+       if (coding.eol_type == CODING_EOL_UNDECIDED
+           && !using_default_coding)
+         {
+           if (! EQ (default_buffer_file_coding.symbol,
+                     buffer_defaults.buffer_file_coding_system))
+             setup_coding_system (buffer_defaults.buffer_file_coding_system,
+                                  &default_buffer_file_coding);
+           if (default_buffer_file_coding.eol_type != CODING_EOL_UNDECIDED)
              {
-               setup_coding_system (Qraw_text, &coding);
-               coding.eol_type = coding_temp.eol_type;
-               goto done_setup_coding;
+               Lisp_Object subsidiaries;
+
+               coding.eol_type = default_buffer_file_coding.eol_type;
+               subsidiaries = Fget (coding.symbol, Qeol_type);
+               if (VECTORP (subsidiaries)
+                   && XVECTOR (subsidiaries)->size == 3)
+                 coding.symbol
+                   = XVECTOR (subsidiaries)->contents[coding.eol_type];
              }
-           val = Qnil;
          }
+
+       if (force_raw_text)
+         setup_raw_text_coding_system (&coding);
+       goto done_setup_coding;
       }
-    else
-      {
-       Lisp_Object args[7], coding_systems;
-
-       args[0] = Qwrite_region; args[1] = start; args[2] = end;
-       args[3] = filename; args[4] = append; args[5] = visit;
-       args[6] = lockname;
-       coding_systems = Ffind_operation_coding_system (7, args);
-       val = (CONSP (coding_systems) && !NILP (XCONS (coding_systems)->cdr)
-              ? XCONS (coding_systems)->cdr
-              : current_buffer->buffer_file_coding_system);
-       /* Confirm that VAL can surely encode the current region.  */
-       if (!NILP (Ffboundp (Vselect_safe_coding_system_function)))
-         val = call3 (Vselect_safe_coding_system_function, start, end, val);
-      }
-    setup_coding_system (Fcheck_coding_system (val), &coding); 
+
+    setup_coding_system (Fcheck_coding_system (val), &coding);
 
   done_setup_coding:
     if (!STRINGP (start) && !NILP (current_buffer->selective_display))
@@ -4446,7 +4540,7 @@ This does code conversion according to the value of\n\
 
   record_unwind_protect (close_file_unwind, make_number (desc));
 
-  if (!NILP (append))
+  if (!NILP (append) && !NILP (Ffile_regular_p (filename)))
     if (lseek (desc, 0, 2) < 0)
       {
 #ifdef CLASH_DETECTION
@@ -5307,7 +5401,7 @@ DIR defaults to current buffer's directory default.")
   (prompt, dir, default_filename, mustmatch, initial)
      Lisp_Object prompt, dir, default_filename, mustmatch, initial;
 {
-  Lisp_Object val, insdef, insdef1, tem;
+  Lisp_Object val, insdef, tem;
   struct gcpro gcpro1, gcpro2;
   register char *homedir;
   int replace_in_history = 0;
@@ -5339,6 +5433,19 @@ DIR defaults to current buffer's directory default.")
                         STRING_BYTES (XSTRING (dir)) - strlen (homedir) + 1);
       XSTRING (dir)->data[0] = '~';
     }
+  /* Likewise for default_filename.  */
+  if (homedir != 0
+      && STRINGP (default_filename)
+      && !strncmp (homedir, XSTRING (default_filename)->data, strlen (homedir))
+      && IS_DIRECTORY_SEP (XSTRING (default_filename)->data[strlen (homedir)]))
+    {
+      default_filename
+       = make_string (XSTRING (default_filename)->data + strlen (homedir) - 1,
+                      STRING_BYTES (XSTRING (default_filename)) - strlen (homedir) + 1);
+      XSTRING (default_filename)->data[0] = '~';
+    }
+  if (!NILP (default_filename))
+    default_filename = double_dollars (default_filename);
 
   if (insert_default_directory && STRINGP (dir))
     {
@@ -5351,18 +5458,15 @@ DIR defaults to current buffer's directory default.")
          args[1] = initial;
          insdef = Fconcat (2, args);
          pos = make_number (XSTRING (double_dollars (dir))->size);
-         insdef1 = Fcons (double_dollars (insdef), pos);
+         insdef = Fcons (double_dollars (insdef), pos);
        }
       else
-       insdef1 = double_dollars (insdef);
+       insdef = double_dollars (insdef);
     }
   else if (STRINGP (initial))
-    {
-      insdef = initial;
-      insdef1 = Fcons (double_dollars (insdef), make_number (0));
-    }
+    insdef = Fcons (double_dollars (initial), make_number (0));
   else
-    insdef = Qnil, insdef1 = Qnil;
+    insdef = Qnil;
 
   count = specpdl_ptr - specpdl;
 #ifdef VMS
@@ -5373,7 +5477,7 @@ DIR defaults to current buffer's directory default.")
 
   GCPRO2 (insdef, default_filename);
   val = Fcompleting_read (prompt, intern ("read-file-name-internal"),
-                         dir, mustmatch, insdef1,
+                         dir, mustmatch, insdef,
                          Qfile_name_history, default_filename, Qnil);
 
   tem = Fsymbol_value (Qfile_name_history);
@@ -5400,7 +5504,7 @@ DIR defaults to current buffer's directory default.")
   if (NILP (val))
     error ("No file name specified");
 
-  tem = Fstring_equal (val, insdef);
+  tem = Fstring_equal (val, CONSP (insdef) ? XCAR (insdef) : insdef);
 
   if (!NILP (tem) && !NILP (default_filename))
     val = default_filename;
@@ -5416,19 +5520,27 @@ DIR defaults to current buffer's directory default.")
   if (replace_in_history)
     /* Replace what Fcompleting_read added to the history
        with what we will actually return.  */
-    XCONS (Fsymbol_value (Qfile_name_history))->car = val;
+    XCONS (Fsymbol_value (Qfile_name_history))->car = double_dollars (val);
   else if (add_to_history)
     {
       /* Add the value to the history--but not if it matches
         the last value already there.  */
+      Lisp_Object val1 = double_dollars (val);
       tem = Fsymbol_value (Qfile_name_history);
-      if (! CONSP (tem) || NILP (Fequal (XCONS (tem)->car, val)))
+      if (! CONSP (tem) || NILP (Fequal (XCONS (tem)->car, val1)))
        Fset (Qfile_name_history,
-             Fcons (val, tem));
+             Fcons (val1, tem));
     }
   return val;
 }
 \f
+void
+init_fileio_once ()
+{
+  /* Must be set before any path manipulation is performed.  */
+  XSETFASTINT (Vdirectory_sep_char, '/');
+}
+
 void
 syms_of_fileio ()
 {
@@ -5573,7 +5685,6 @@ The value should be either ?/ or ?\\ (any other value is treated as ?\\).\n\
 This variable affects the built-in functions only on Windows,\n\
 on other platforms, it is initialized so that Lisp code can find out\n\
 what the normal separator is.");
-  XSETFASTINT (Vdirectory_sep_char, '/');
 
   DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist,
     "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
@@ -5593,9 +5704,11 @@ for its argument.");
   DEFVAR_LISP ("set-auto-coding-function",
               &Vset_auto_coding_function,
     "If non-nil, a function to call to decide a coding system of file.\n\
-One argument is passed to this function: the length of a file contents\n\
-following the point.\n\
-This function should return a coding system to decode the file contents\n\
+Two arguments are passed to this function: the file name\n\
+and the length of a file contents following the point.\n\
+This function should return a coding system to decode the file contents.\n\
+It should check the file name against `auto-coding-alist'.\n\
+If no coding system is decided, it should check a coding system\n\
 specified in the heading lines with the format:\n\
        -*- ... coding: CODING-SYSTEM; ... -*-\n\
 or local variable spec of the tailing lines with `coding:' tag.");