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