Mercurial > hg > xemacs-beta
annotate src/filelock.c @ 5586:d8a11d5ebc9f
Merge refactored Xaw3d configure.ac.
| author | Stephen J. Turnbull <stephen@xemacs.org> |
|---|---|
| date | Fri, 28 Oct 2011 23:52:26 +0900 |
| parents | 308d34e9f07d |
| children |
| rev | line source |
|---|---|
| 428 | 1 /* Copyright (C) 1985, 86, 87, 93, 94, 96 Free Software Foundation, Inc. |
|
4972
c448f4c38d65
change name of lock file to avoid problems with etags, byte-recompile-directory, etc.
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
2 Copyright (C) 2001, 2010 Ben Wing. |
| 428 | 3 |
| 613 | 4 This file is part of XEmacs. |
| 428 | 5 |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4976
diff
changeset
|
6 XEmacs is free software: you can redistribute it and/or modify it |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4976
diff
changeset
|
7 under the terms of the GNU General Public License as published by the |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4976
diff
changeset
|
8 Free Software Foundation, either version 3 of the License, or (at your |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4976
diff
changeset
|
9 option) any later version. |
| 428 | 10 |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4976
diff
changeset
|
11 XEmacs is distributed in the hope that it will be useful, but WITHOUT |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4976
diff
changeset
|
12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4976
diff
changeset
|
13 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4976
diff
changeset
|
14 for more details. |
| 428 | 15 |
| 16 You should have received a copy of the GNU General Public License | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4976
diff
changeset
|
17 along with XEmacs. If not, see <http://www.gnu.org/licenses/>. */ |
| 428 | 18 |
| 19 /* Synced with FSF 20.2 */ | |
| 20 | |
| 21 #include <config.h> | |
| 22 #include "lisp.h" | |
| 23 | |
| 24 #include "buffer.h" | |
| 25 #include <paths.h> | |
| 26 | |
| 859 | 27 #include "sysdir.h" |
| 428 | 28 #include "sysfile.h" |
| 859 | 29 #include "sysproc.h" /* for qxe_getpid() */ |
| 428 | 30 #include "syspwd.h" |
| 859 | 31 #include "syssignal.h" /* for kill. */ |
| 428 | 32 |
| 33 Lisp_Object Qask_user_about_supersession_threat; | |
| 34 Lisp_Object Qask_user_about_lock; | |
| 444 | 35 int inhibit_clash_detection; |
| 428 | 36 |
| 37 #ifdef CLASH_DETECTION | |
| 442 | 38 |
|
4972
c448f4c38d65
change name of lock file to avoid problems with etags, byte-recompile-directory, etc.
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
39 /* The strategy: to lock a file FN, create a symlink .#FN# in FN's |
| 428 | 40 directory, with link data `user@host.pid'. This avoids a single |
| 41 mount (== failure) point for lock files. | |
| 42 | |
| 43 When the host in the lock data is the current host, we can check if | |
| 44 the pid is valid with kill. | |
| 442 | 45 |
| 428 | 46 Otherwise, we could look at a separate file that maps hostnames to |
| 47 reboot times to see if the remote pid can possibly be valid, since we | |
| 48 don't want Emacs to have to communicate via pipes or sockets or | |
| 49 whatever to other processes, either locally or remotely; rms says | |
| 50 that's too unreliable. Hence the separate file, which could | |
| 51 theoretically be updated by daemons running separately -- but this | |
| 52 whole idea is unimplemented; in practice, at least in our | |
| 53 environment, it seems such stale locks arise fairly infrequently, and | |
| 54 Emacs' standard methods of dealing with clashes suffice. | |
| 55 | |
| 56 We use symlinks instead of normal files because (1) they can be | |
| 57 stored more efficiently on the filesystem, since the kernel knows | |
| 58 they will be small, and (2) all the info about the lock can be read | |
| 59 in a single system call (readlink). Although we could use regular | |
| 60 files to be useful on old systems lacking symlinks, nowadays | |
| 61 virtually all such systems are probably single-user anyway, so it | |
| 62 didn't seem worth the complication. | |
| 63 | |
| 64 Similarly, we don't worry about a possible 14-character limit on | |
| 65 file names, because those are all the same systems that don't have | |
| 66 symlinks. | |
| 442 | 67 |
|
4972
c448f4c38d65
change name of lock file to avoid problems with etags, byte-recompile-directory, etc.
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
68 Originally we used a name .#FN without the final #; this may have been |
|
c448f4c38d65
change name of lock file to avoid problems with etags, byte-recompile-directory, etc.
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
69 compatible with the locking scheme used by Interleaf (which has |
|
c448f4c38d65
change name of lock file to avoid problems with etags, byte-recompile-directory, etc.
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
70 contributed this implementation for Emacs), and was designed by Ethan |
|
c448f4c38d65
change name of lock file to avoid problems with etags, byte-recompile-directory, etc.
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
71 Jacobson, Kimbo Mundy, and others. |
| 442 | 72 |
| 428 | 73 --karl@cs.umb.edu/karl@hq.ileaf.com. */ |
| 74 | |
|
4972
c448f4c38d65
change name of lock file to avoid problems with etags, byte-recompile-directory, etc.
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
75 /* NOTE: We added the final # in the name .#FN# so that programs |
|
c448f4c38d65
change name of lock file to avoid problems with etags, byte-recompile-directory, etc.
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
76 that e.g. search for all .c files, such as etags, or try to |
|
c448f4c38d65
change name of lock file to avoid problems with etags, byte-recompile-directory, etc.
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
77 byte-compile all .el files in a directory (byte-recompile-directory), |
|
c448f4c38d65
change name of lock file to avoid problems with etags, byte-recompile-directory, etc.
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
78 won't get tripped up by the bogus symlink file. --ben */ |
|
c448f4c38d65
change name of lock file to avoid problems with etags, byte-recompile-directory, etc.
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
79 |
| 428 | 80 |
| 81 /* Here is the structure that stores information about a lock. */ | |
| 82 | |
| 83 typedef struct | |
| 84 { | |
| 867 | 85 Ibyte *user; |
| 86 Ibyte *host; | |
| 647 | 87 pid_t pid; |
| 428 | 88 } lock_info_type; |
| 89 | |
| 90 /* When we read the info back, we might need this much more, | |
| 91 enough for decimal representation plus null. */ | |
| 647 | 92 #define LOCK_PID_MAX (4 * sizeof (pid_t)) |
| 428 | 93 |
| 94 /* Free the two dynamically-allocated pieces in PTR. */ | |
| 1726 | 95 #define FREE_LOCK_INFO(i) do { \ |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4972
diff
changeset
|
96 xfree ((i).user); \ |
|
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4972
diff
changeset
|
97 xfree ((i).host); \ |
| 1726 | 98 } while (0) |
| 428 | 99 |
|
4972
c448f4c38d65
change name of lock file to avoid problems with etags, byte-recompile-directory, etc.
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
100 /* Write the name of the lock file for FN into LFNAME. Length will be that |
|
c448f4c38d65
change name of lock file to avoid problems with etags, byte-recompile-directory, etc.
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
101 of FN plus two more for the leading `.#' plus one for the trailing # |
|
c448f4c38d65
change name of lock file to avoid problems with etags, byte-recompile-directory, etc.
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
102 plus one for the null. */ |
| 428 | 103 #define MAKE_LOCK_NAME(lock, file) \ |
|
4972
c448f4c38d65
change name of lock file to avoid problems with etags, byte-recompile-directory, etc.
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
104 (lock = alloca_ibytes (XSTRING_LENGTH (file) + 2 + 1 + 1), \ |
| 771 | 105 fill_in_lock_file_name (lock, file)) |
| 428 | 106 |
| 107 static void | |
| 867 | 108 fill_in_lock_file_name (Ibyte *lockfile, Lisp_Object fn) |
| 428 | 109 { |
| 867 | 110 Ibyte *file_name = XSTRING_DATA (fn); |
| 111 Ibyte *p; | |
| 647 | 112 Bytecount dirlen; |
| 428 | 113 |
| 442 | 114 for (p = file_name + XSTRING_LENGTH (fn) - 1; |
| 115 p > file_name && !IS_ANY_SEP (p[-1]); | |
| 116 p--) | |
| 117 ; | |
| 118 dirlen = p - file_name; | |
| 428 | 119 |
| 442 | 120 memcpy (lockfile, file_name, dirlen); |
| 121 p = lockfile + dirlen; | |
| 122 *(p++) = '.'; | |
| 123 *(p++) = '#'; | |
|
4972
c448f4c38d65
change name of lock file to avoid problems with etags, byte-recompile-directory, etc.
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
124 memcpy (p, file_name + dirlen, XSTRING_LENGTH (fn) - dirlen); |
|
c448f4c38d65
change name of lock file to avoid problems with etags, byte-recompile-directory, etc.
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
125 p += XSTRING_LENGTH (fn) - dirlen; |
|
c448f4c38d65
change name of lock file to avoid problems with etags, byte-recompile-directory, etc.
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
126 *(p++) = '#'; |
|
c448f4c38d65
change name of lock file to avoid problems with etags, byte-recompile-directory, etc.
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
127 *p = '\0'; |
| 428 | 128 } |
| 129 | |
| 130 /* Lock the lock file named LFNAME. | |
| 131 If FORCE is nonzero, we do so even if it is already locked. | |
| 132 Return 1 if successful, 0 if not. */ | |
| 133 | |
| 134 static int | |
| 867 | 135 lock_file_1 (Ibyte *lfname, int force) |
| 428 | 136 { |
| 442 | 137 /* Does not GC. */ |
| 138 int err; | |
| 867 | 139 Ibyte *lock_info_str; |
| 140 Ibyte *host_name; | |
| 141 Ibyte *user_name = user_login_name (NULL); | |
| 428 | 142 |
| 442 | 143 if (user_name == NULL) |
| 867 | 144 user_name = (Ibyte *) ""; |
| 442 | 145 |
| 146 if (STRINGP (Vsystem_name)) | |
| 771 | 147 host_name = XSTRING_DATA (Vsystem_name); |
| 428 | 148 else |
| 867 | 149 host_name = (Ibyte *) ""; |
| 442 | 150 |
| 771 | 151 lock_info_str = |
| 2367 | 152 alloca_ibytes (qxestrlen (user_name) + qxestrlen (host_name) |
| 153 + LOCK_PID_MAX + 5); | |
| 428 | 154 |
| 771 | 155 qxesprintf (lock_info_str, "%s@%s.%d", user_name, host_name, qxe_getpid ()); |
| 428 | 156 |
| 771 | 157 err = qxe_symlink (lock_info_str, lfname); |
| 442 | 158 if (err != 0 && errno == EEXIST && force) |
| 428 | 159 { |
| 771 | 160 qxe_unlink (lfname); |
| 161 err = qxe_symlink (lock_info_str, lfname); | |
| 428 | 162 } |
| 163 | |
| 164 return err == 0; | |
| 165 } | |
| 166 | |
| 167 /* Return 0 if nobody owns the lock file LFNAME or the lock is obsolete, | |
| 168 1 if another process owns it (and set OWNER (if non-null) to info), | |
| 169 2 if the current process owns it, | |
| 170 or -1 if something is wrong with the locking mechanism. */ | |
| 171 | |
| 172 static int | |
| 867 | 173 current_lock_owner (lock_info_type *owner, Ibyte *lfname) |
| 428 | 174 { |
| 442 | 175 /* Does not GC. */ |
| 176 int len, ret; | |
| 428 | 177 int local_owner = 0; |
| 867 | 178 Ibyte *at, *dot; |
| 179 Ibyte *lfinfo = 0; | |
| 428 | 180 int bufsize = 50; |
| 181 /* Read arbitrarily-long contents of symlink. Similar code in | |
| 182 file-symlink-p in fileio.c. */ | |
| 183 do | |
| 184 { | |
| 185 bufsize *= 2; | |
| 867 | 186 lfinfo = (Ibyte *) xrealloc (lfinfo, bufsize); |
| 771 | 187 len = qxe_readlink (lfname, lfinfo, bufsize); |
| 428 | 188 } |
| 189 while (len >= bufsize); | |
| 442 | 190 |
| 428 | 191 /* If nonexistent lock file, all is well; otherwise, got strange error. */ |
| 192 if (len == -1) | |
| 193 { | |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4972
diff
changeset
|
194 xfree (lfinfo); |
| 428 | 195 return errno == ENOENT ? 0 : -1; |
| 196 } | |
| 197 | |
| 198 /* Link info exists, so `len' is its length. Null terminate. */ | |
| 199 lfinfo[len] = 0; | |
| 442 | 200 |
| 428 | 201 /* Even if the caller doesn't want the owner info, we still have to |
| 202 read it to determine return value, so allocate it. */ | |
| 203 if (!owner) | |
| 204 { | |
| 2367 | 205 owner = alloca_new (lock_info_type); |
| 428 | 206 local_owner = 1; |
| 207 } | |
| 442 | 208 |
| 428 | 209 /* Parse USER@HOST.PID. If can't parse, return -1. */ |
| 210 /* The USER is everything before the first @. */ | |
| 771 | 211 at = qxestrchr (lfinfo, '@'); |
| 212 dot = qxestrrchr (lfinfo, '.'); | |
| 428 | 213 if (!at || !dot) { |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4972
diff
changeset
|
214 xfree (lfinfo); |
| 428 | 215 return -1; |
| 216 } | |
| 217 len = at - lfinfo; | |
| 2367 | 218 owner->user = xnew_ibytes (len + 1); |
| 771 | 219 qxestrncpy (owner->user, lfinfo, len); |
| 428 | 220 owner->user[len] = 0; |
| 442 | 221 |
| 428 | 222 /* The PID is everything after the last `.'. */ |
| 867 | 223 owner->pid = atoi ((CIbyte *) dot + 1); |
| 428 | 224 |
| 225 /* The host is everything in between. */ | |
| 226 len = dot - at - 1; | |
| 2367 | 227 owner->host = xnew_ibytes (len + 1); |
| 771 | 228 qxestrncpy (owner->host, at + 1, len); |
| 428 | 229 owner->host[len] = 0; |
| 230 | |
| 231 /* We're done looking at the link info. */ | |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4972
diff
changeset
|
232 xfree (lfinfo); |
| 442 | 233 |
| 428 | 234 /* On current host? */ |
| 442 | 235 if (STRINGP (Fsystem_name ()) |
| 771 | 236 && qxestrcmp (owner->host, XSTRING_DATA (Fsystem_name ())) == 0) |
| 428 | 237 { |
| 771 | 238 if (owner->pid == qxe_getpid ()) |
| 428 | 239 ret = 2; /* We own it. */ |
| 240 else if (owner->pid > 0 | |
| 241 && (kill (owner->pid, 0) >= 0 || errno == EPERM)) | |
| 242 ret = 1; /* An existing process on this machine owns it. */ | |
| 243 /* The owner process is dead or has a strange pid (<=0), so try to | |
| 244 zap the lockfile. */ | |
| 771 | 245 else if (qxe_unlink (lfname) < 0) |
| 428 | 246 ret = -1; |
| 247 else | |
| 248 ret = 0; | |
| 249 } | |
| 250 else | |
| 251 { /* If we wanted to support the check for stale locks on remote machines, | |
| 252 here's where we'd do it. */ | |
| 253 ret = 1; | |
| 254 } | |
| 442 | 255 |
| 428 | 256 /* Avoid garbage. */ |
| 257 if (local_owner || ret <= 0) | |
| 258 { | |
| 259 FREE_LOCK_INFO (*owner); | |
| 260 } | |
| 261 return ret; | |
| 262 } | |
| 263 | |
| 264 /* Lock the lock named LFNAME if possible. | |
| 265 Return 0 in that case. | |
| 266 Return positive if some other process owns the lock, and info about | |
| 267 that process in CLASHER. | |
| 268 Return -1 if cannot lock for any other reason. */ | |
| 269 | |
| 270 static int | |
| 867 | 271 lock_if_free (lock_info_type *clasher, Ibyte *lfname) |
| 428 | 272 { |
| 442 | 273 /* Does not GC. */ |
| 867 | 274 if (lock_file_1 ((Ibyte *) lfname, 0) == 0) |
| 428 | 275 { |
| 276 int locker; | |
| 277 | |
| 278 if (errno != EEXIST) | |
| 279 return -1; | |
| 442 | 280 |
| 428 | 281 locker = current_lock_owner (clasher, lfname); |
| 282 if (locker == 2) | |
| 283 { | |
| 284 FREE_LOCK_INFO (*clasher); | |
| 285 return 0; /* We ourselves locked it. */ | |
| 286 } | |
| 287 else if (locker == 1) | |
| 288 return 1; /* Someone else has it. */ | |
| 289 | |
| 290 return -1; /* Something's wrong. */ | |
| 291 } | |
| 292 return 0; | |
| 293 } | |
| 294 | |
| 295 /* lock_file locks file FN, | |
| 296 meaning it serves notice on the world that you intend to edit that file. | |
| 297 This should be done only when about to modify a file-visiting | |
| 298 buffer previously unmodified. | |
| 299 Do not (normally) call this for a buffer already modified, | |
| 300 as either the file is already locked, or the user has already | |
| 301 decided to go ahead without locking. | |
| 302 | |
| 303 When this returns, either the lock is locked for us, | |
| 304 or the user has said to go ahead without locking. | |
| 305 | |
| 306 If the file is locked by someone else, this calls | |
| 307 ask-user-about-lock (a Lisp function) with two arguments, | |
| 308 the file name and info about the user who did the locking. | |
| 309 This function can signal an error, or return t meaning | |
| 310 take away the lock, or return nil meaning ignore the lock. */ | |
| 311 | |
| 312 void | |
| 313 lock_file (Lisp_Object fn) | |
| 314 { | |
| 442 | 315 /* This function can GC. GC checked 7-11-00 ben */ |
| 428 | 316 /* dmoore - and can destroy current_buffer and all sorts of other |
| 317 mean nasty things with pointy teeth. If you call this make sure | |
| 318 you protect things right. */ | |
| 442 | 319 /* Somebody updated the code in this function and removed the previous |
| 428 | 320 comment. -slb */ |
| 321 | |
| 322 register Lisp_Object attack, orig_fn; | |
| 867 | 323 register Ibyte *lfname, *locker; |
| 428 | 324 lock_info_type lock_info; |
| 444 | 325 struct gcpro gcpro1, gcpro2, gcpro3; |
| 326 Lisp_Object old_current_buffer; | |
| 428 | 327 Lisp_Object subject_buf; |
| 328 | |
| 444 | 329 if (inhibit_clash_detection) |
| 330 return; | |
| 331 | |
| 793 | 332 old_current_buffer = wrap_buffer (current_buffer); |
| 446 | 333 subject_buf = Qnil; |
| 444 | 334 GCPRO3 (fn, subject_buf, old_current_buffer); |
| 428 | 335 orig_fn = fn; |
| 336 fn = Fexpand_file_name (fn, Qnil); | |
| 337 | |
| 338 /* Create the name of the lock-file for file fn */ | |
| 339 MAKE_LOCK_NAME (lfname, fn); | |
| 340 | |
| 341 /* See if this file is visited and has changed on disk since it was | |
| 342 visited. */ | |
| 343 { | |
| 344 subject_buf = get_truename_buffer (orig_fn); | |
| 345 if (!NILP (subject_buf) | |
| 346 && NILP (Fverify_visited_file_modtime (subject_buf)) | |
| 347 && !NILP (Ffile_exists_p (fn))) | |
| 442 | 348 call1_in_buffer (XBUFFER (subject_buf), |
| 349 Qask_user_about_supersession_threat, fn); | |
| 428 | 350 } |
| 351 | |
| 352 /* Try to lock the lock. */ | |
| 444 | 353 if (current_buffer != XBUFFER (old_current_buffer) |
| 354 || lock_if_free (&lock_info, lfname) <= 0) | |
| 355 /* Return now if we have locked it, or if lock creation failed | |
| 356 or current buffer is killed. */ | |
| 428 | 357 goto done; |
| 358 | |
| 359 /* Else consider breaking the lock */ | |
| 2367 | 360 locker = alloca_ibytes (qxestrlen (lock_info.user) |
| 361 + qxestrlen (lock_info.host) | |
| 362 + LOCK_PID_MAX + 9); | |
| 771 | 363 qxesprintf (locker, "%s@%s (pid %d)", lock_info.user, lock_info.host, |
| 364 lock_info.pid); | |
| 428 | 365 FREE_LOCK_INFO (lock_info); |
| 442 | 366 |
| 428 | 367 attack = call2_in_buffer (BUFFERP (subject_buf) ? XBUFFER (subject_buf) : |
| 368 current_buffer, Qask_user_about_lock , fn, | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
2367
diff
changeset
|
369 build_istring (locker)); |
| 444 | 370 if (!NILP (attack) && current_buffer == XBUFFER (old_current_buffer)) |
| 428 | 371 /* User says take the lock */ |
| 372 { | |
| 373 lock_file_1 (lfname, 1); | |
| 374 goto done; | |
| 375 } | |
| 376 /* User says ignore the lock */ | |
| 377 done: | |
| 378 UNGCPRO; | |
| 379 } | |
| 380 | |
| 381 void | |
| 382 unlock_file (Lisp_Object fn) | |
| 383 { | |
| 442 | 384 /* This can GC */ |
| 867 | 385 register Ibyte *lfname; |
| 442 | 386 struct gcpro gcpro1; |
| 387 | |
| 388 GCPRO1 (fn); | |
| 428 | 389 |
| 390 fn = Fexpand_file_name (fn, Qnil); | |
| 391 | |
| 392 MAKE_LOCK_NAME (lfname, fn); | |
| 393 | |
| 394 if (current_lock_owner (0, lfname) == 2) | |
| 771 | 395 qxe_unlink (lfname); |
| 442 | 396 |
| 397 UNGCPRO; | |
| 428 | 398 } |
| 399 | |
| 400 void | |
| 442 | 401 unlock_all_files (void) |
| 428 | 402 { |
| 403 register Lisp_Object tail; | |
| 404 | |
| 434 | 405 for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail)) |
| 428 | 406 { |
| 442 | 407 struct buffer *b = XBUFFER (XCDR (XCAR (tail))); |
| 428 | 408 if (STRINGP (b->file_truename) && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)) |
| 409 unlock_file (b->file_truename); | |
| 410 } | |
| 411 } | |
| 412 | |
| 413 DEFUN ("lock-buffer", Flock_buffer, 0, 1, 0, /* | |
| 442 | 414 Lock FILE, if current buffer is modified. |
| 415 FILE defaults to current buffer's visited file, | |
| 428 | 416 or else nothing is done if current buffer isn't visiting a file. |
| 417 */ | |
| 442 | 418 (file)) |
| 428 | 419 { |
| 420 if (NILP (file)) | |
| 421 file = current_buffer->file_truename; | |
| 422 CHECK_STRING (file); | |
| 423 if (BUF_SAVE_MODIFF (current_buffer) < BUF_MODIFF (current_buffer) | |
| 424 && !NILP (file)) | |
| 425 lock_file (file); | |
| 426 return Qnil; | |
| 427 } | |
| 428 | |
| 429 DEFUN ("unlock-buffer", Funlock_buffer, 0, 0, 0, /* | |
| 430 Unlock the file visited in the current buffer, | |
| 431 if it should normally be locked. | |
| 432 */ | |
| 433 ()) | |
| 434 { | |
| 435 /* This function can GC */ | |
| 436 /* dmoore - and can destroy current_buffer and all sorts of other | |
| 437 mean nasty things with pointy teeth. If you call this make sure | |
| 438 you protect things right. */ | |
| 439 | |
| 440 if (BUF_SAVE_MODIFF (current_buffer) < BUF_MODIFF (current_buffer) | |
| 441 && STRINGP (current_buffer->file_truename)) | |
| 442 unlock_file (current_buffer->file_truename); | |
| 443 return Qnil; | |
| 444 } | |
| 445 | |
| 446 /* Unlock the file visited in buffer BUFFER. */ | |
| 447 | |
| 448 | |
| 449 void | |
| 450 unlock_buffer (struct buffer *buffer) | |
| 451 { | |
| 452 /* This function can GC */ | |
| 453 /* dmoore - and can destroy current_buffer and all sorts of other | |
| 454 mean nasty things with pointy teeth. If you call this make sure | |
| 455 you protect things right. */ | |
| 456 if (BUF_SAVE_MODIFF (buffer) < BUF_MODIFF (buffer) | |
| 457 && STRINGP (buffer->file_truename)) | |
| 458 unlock_file (buffer->file_truename); | |
| 459 } | |
| 460 | |
| 461 DEFUN ("file-locked-p", Ffile_locked_p, 0, 1, 0, /* | |
| 442 | 462 Return nil if the FILENAME is not locked, |
| 428 | 463 t if it is locked by you, else a string of the name of the locker. |
| 464 */ | |
| 442 | 465 (filename)) |
| 428 | 466 { |
| 467 Lisp_Object ret; | |
| 867 | 468 register Ibyte *lfname; |
| 428 | 469 int owner; |
| 470 lock_info_type locker; | |
| 442 | 471 struct gcpro gcpro1; |
| 472 | |
| 473 GCPRO1 (filename); | |
| 428 | 474 |
| 475 filename = Fexpand_file_name (filename, Qnil); | |
| 476 | |
| 477 MAKE_LOCK_NAME (lfname, filename); | |
| 478 | |
| 479 owner = current_lock_owner (&locker, lfname); | |
| 480 if (owner <= 0) | |
| 481 ret = Qnil; | |
| 482 else if (owner == 2) | |
| 483 ret = Qt; | |
| 484 else | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
2367
diff
changeset
|
485 ret = build_istring (locker.user); |
| 428 | 486 |
| 487 if (owner > 0) | |
| 488 FREE_LOCK_INFO (locker); | |
| 489 | |
| 442 | 490 UNGCPRO; |
| 491 | |
| 428 | 492 return ret; |
| 493 } | |
| 494 | |
| 495 | |
| 496 /* Initialization functions. */ | |
| 497 | |
| 498 void | |
| 499 syms_of_filelock (void) | |
| 500 { | |
| 501 /* This function can GC */ | |
| 502 DEFSUBR (Funlock_buffer); | |
| 503 DEFSUBR (Flock_buffer); | |
| 504 DEFSUBR (Ffile_locked_p); | |
| 505 | |
| 563 | 506 DEFSYMBOL (Qask_user_about_supersession_threat); |
| 507 DEFSYMBOL (Qask_user_about_lock); | |
| 428 | 508 } |
| 509 | |
| 444 | 510 void |
| 511 vars_of_filelock (void) | |
| 512 { | |
| 513 DEFVAR_BOOL ("inhibit-clash-detection", &inhibit_clash_detection /* | |
| 514 Non-nil inhibits creation of lock file to detect clash. | |
| 515 */); | |
| 516 inhibit_clash_detection = 0; | |
| 517 } | |
| 428 | 518 |
| 519 #endif /* CLASH_DETECTION */ |