Add support for large files, 64-bit Solaris, system locale codings.
[bpt/emacs.git] / src / filelock.c
index b671533..66f347b 100644 (file)
@@ -19,10 +19,11 @@ the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 Boston, MA 02111-1307, USA.  */
 
 
+#include <config.h>
 #include <sys/types.h>
 #include <sys/stat.h>
 #include <signal.h>
-#include <config.h>
+#include <stdio.h>
 
 #ifdef VMS
 #include "vms-pwd.h"
@@ -58,6 +59,10 @@ Boston, MA 02111-1307, USA.  */
 extern int errno;
 #endif
 
+/* The directory for writing temporary files.  */
+
+Lisp_Object Vtemporary_file_directory;
+
 #ifdef CLASH_DETECTION
 
 #include <utmp.h>
@@ -118,7 +123,9 @@ extern Lisp_Object Vshell_file_name;
 static time_t
 get_boot_time ()
 {
+#if defined (BOOT_TIME) && ! defined (NO_WTMP_FILE)
   int counter;
+#endif
 
   if (boot_time_initialized)
     return boot_time;
@@ -192,7 +199,9 @@ get_boot_time ()
          if (! NILP (Ffile_exists_p (tempname)))
            {
              Lisp_Object args[6];
-             tempname = Fmake_temp_name (build_string ("wtmp"));
+             tempname = Fexpand_file_name (build_string ("wtmp"),
+                                           Vtemporary_file_directory);
+             tempname = Fmake_temp_name (tempname);
              args[0] = Vshell_file_name;
              args[1] = Qnil;
              args[2] = Qnil;
@@ -243,11 +252,11 @@ get_boot_time_1 (filename, newest)
     {
       /* On some versions of IRIX, opening a nonexistent file name
         is likely to crash in the utmp routines.  */
-      desc = open (filename, O_RDONLY);
+      desc = emacs_open (filename, O_RDONLY, 0);
       if (desc < 0)
        return;
 
-      close (desc);
+      emacs_close (desc);
 
       utmpname (filename);
     }
@@ -388,7 +397,7 @@ current_lock_owner (owner, lfname)
 #ifndef index
   extern char *rindex (), *index ();
 #endif
-  int o, p, len, ret;
+  int len, ret;
   int local_owner = 0;
   char *at, *dot, *colon;
   char *lfinfo = 0;
@@ -514,6 +523,8 @@ lock_if_free (clasher, lfname)
         }
       else if (locker == 1)
         return 1;  /* Someone else has it.  */
+      else if (locker == -1)
+       return -1;   /* current_lock_owner returned strange error.  */
 
       /* We deleted a stale lock; try again to lock the file.  */
     }
@@ -544,8 +555,16 @@ lock_file (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);
 
@@ -556,18 +575,16 @@ lock_file (fn)
      visited.  */
   {
     register Lisp_Object subject_buf;
-    struct gcpro gcpro1;
 
     subject_buf = get_truename_buffer (orig_fn);
-    GCPRO1 (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;
   }
+  UNGCPRO;
 
   /* Try to lock the lock. */
   if (lock_if_free (&lock_info, lfname) <= 0)
@@ -612,9 +629,9 @@ unlock_all_files ()
   register Lisp_Object tail;
   register struct buffer *b;
 
-  for (tail = Vbuffer_alist; GC_CONSP (tail); tail = XCONS (tail)->cdr)
+  for (tail = Vbuffer_alist; GC_CONSP (tail); tail = XCDR (tail))
     {
-      b = XBUFFER (XCONS (XCONS (tail)->car)->cdr);
+      b = XBUFFER (XCDR (XCAR (tail)));
       if (STRINGP (b->file_truename) && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b))
        {
          register char *lfname;
@@ -709,6 +726,10 @@ init_filelock ()
 void
 syms_of_filelock ()
 {
+  DEFVAR_LISP ("temporary-file-directory", &Vtemporary_file_directory,
+    "The directory for writing temporary files.");
+  Vtemporary_file_directory = Qnil;
+
   defsubr (&Sunlock_buffer);
   defsubr (&Slock_buffer);
   defsubr (&Sfile_locked_p);