Mercurial > hg > xemacs-beta
annotate src/filelock.c @ 5781:0853e1ec8529
Use alloca_{rawbytes,ibytes} in #'copy-file, #'insert-file-contents-internal
src/ChangeLog addition:
2014-01-20 Aidan Kehoe <kehoea@parhasard.net>
* fileio.c (Fcopy_file, Finsert_file_contents_internal):
Use alloca_{rawbytes,ibytes} here instead of the implicit alloca
on the stack; doesn't change where the buffers are allocated for
these two functions, but does mean that decisions about alloca
vs. malloc based on buffer size are made in the same place
(ultimately, the ALLOCA() macro).
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Mon, 20 Jan 2014 17:53:07 +0000 |
| 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 */ |