import xemacs-21.2.37

[chise/xemacs-chise.git.1] / src / filelock.c

diff --git a/src/filelock.c b/src/filelock.c
index 44df999..308565b 100644 (file)
--- a/src/filelock.c
+++ b/src/filelock.c
@@ -32,6 +32,7 @@ Boston, MA 02111-1307, USA.  */
 
 Lisp_Object Qask_user_about_supersession_threat;
 Lisp_Object Qask_user_about_lock;
+int inhibit_clash_detection;
 
 #ifdef CLASH_DETECTION
 
@@ -123,6 +124,7 @@ fill_in_lock_file_name (Bufbyte *lockfile, Lisp_Object fn)
 static int
 lock_file_1 (char *lfname, int force)
 {
+  /* Does not GC. */
   int err;
   char *lock_info_str;
   char *host_name;
@@ -160,6 +162,7 @@ lock_file_1 (char *lfname, int force)
 static int
 current_lock_owner (lock_info_type *owner, char *lfname)
 {
+  /* Does not GC. */
   int len, ret;
   int local_owner = 0;
   char *at, *dot;
@@ -257,6 +260,7 @@ current_lock_owner (lock_info_type *owner, char *lfname)
 static int
 lock_if_free (lock_info_type *clasher, char *lfname)
 {
+  /* Does not GC. */
   if (lock_file_1 (lfname, 0) == 0)
     {
       int locker;
@@ -298,7 +302,7 @@ lock_if_free (lock_info_type *clasher, char *lfname)
 void
 lock_file (Lisp_Object fn)
 {
-  /* This function can GC. */
+  /* This function can GC.  GC checked 7-11-00 ben */
   /* dmoore - and can destroy current_buffer and all sorts of other
      mean nasty things with pointy teeth.  If you call this make sure
      you protect things right. */
@@ -308,10 +312,15 @@ lock_file (Lisp_Object fn)
   register Lisp_Object attack, orig_fn;
   register char *lfname, *locker;
   lock_info_type lock_info;
-  struct gcpro gcpro1,gcpro2;
+  struct gcpro gcpro1, gcpro2, gcpro3;
+  Lisp_Object old_current_buffer;
   Lisp_Object subject_buf;
 
-  GCPRO2 (fn, subject_buf);
+  if (inhibit_clash_detection)
+    return;
+
+  XSETBUFFER (old_current_buffer, current_buffer);
+  GCPRO3 (fn, subject_buf, old_current_buffer);
   orig_fn = fn;
   fn = Fexpand_file_name (fn, Qnil);
 
@@ -325,13 +334,15 @@ lock_file (Lisp_Object fn)
     if (!NILP (subject_buf)
        && NILP (Fverify_visited_file_modtime (subject_buf))
        && !NILP (Ffile_exists_p (fn)))
-      call1_in_buffer (XBUFFER(subject_buf),
+      call1_in_buffer (XBUFFER (subject_buf),
                       Qask_user_about_supersession_threat, fn);
   }
 
   /* 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 */
+  if (current_buffer != XBUFFER (old_current_buffer)
+      || lock_if_free (&lock_info, lfname) <= 0)
+    /* Return now if we have locked it, or if lock creation failed
+     or current buffer is killed. */
     goto done;
 
   /* Else consider breaking the lock */
@@ -344,7 +355,7 @@ lock_file (Lisp_Object fn)
   attack = call2_in_buffer (BUFFERP (subject_buf) ? XBUFFER (subject_buf) :
                            current_buffer, Qask_user_about_lock , fn,
                            build_string (locker));
-  if (!NILP (attack))
+  if (!NILP (attack) && current_buffer == XBUFFER (old_current_buffer))
     /* User says take the lock */
     {
       lock_file_1 (lfname, 1);
@@ -358,6 +369,7 @@ lock_file (Lisp_Object fn)
 void
 unlock_file (Lisp_Object fn)
 {
+  /* This can GC */
   register char *lfname;
   struct gcpro gcpro1;
 
@@ -484,5 +496,13 @@ syms_of_filelock (void)
   defsymbol (&Qask_user_about_lock, "ask-user-about-lock");
 }
 
+void
+vars_of_filelock (void)
+{
+  DEFVAR_BOOL ("inhibit-clash-detection", &inhibit_clash_detection /*
+Non-nil inhibits creation of lock file to detect clash.
+*/);
+  inhibit_clash_detection = 0;
+}
 
 #endif /* CLASH_DETECTION */