Mercurial > emacs
annotate src/filelock.c @ 4413:5a00cec8e9b0
(fill-region-as-paragraph): When we take one word
after the fill column, don't stop at period with just one space.
When checking whether at beginning of line, if no fill prefix,
ignore intervening whitespace.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Mon, 02 Aug 1993 05:55:56 +0000 |
parents | 2ed300d36643 |
children | e4a5c21eb300 |
rev | line source |
---|---|
2961 | 1 /* Copyright (C) 1985, 1986, 1987, 1993 Free Software Foundation, Inc. |
163 | 2 |
3 This file is part of GNU Emacs. | |
4 | |
5 GNU Emacs is free software; you can redistribute it and/or modify | |
6 it under the terms of the GNU General Public License as published by | |
624 | 7 the Free Software Foundation; either version 2, or (at your option) |
163 | 8 any later version. |
9 | |
10 GNU Emacs is distributed in the hope that it will be useful, | |
11 but WITHOUT ANY WARRANTY; without even the implied warranty of | |
12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
13 GNU General Public License for more details. | |
14 | |
15 You should have received a copy of the GNU General Public License | |
16 along with GNU Emacs; see the file COPYING. If not, write to | |
17 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ | |
18 | |
19 | |
20 #include <sys/types.h> | |
21 #include <sys/stat.h> | |
22 #include "config.h" | |
372 | 23 |
24 #ifdef VMS | |
559 | 25 #include "vms-pwd.h" |
372 | 26 #else |
163 | 27 #include <pwd.h> |
372 | 28 #endif |
29 | |
163 | 30 #include <errno.h> |
31 #include <sys/file.h> | |
32 #ifdef USG | |
33 #include <fcntl.h> | |
34 #endif /* USG */ | |
35 | |
36 #include "lisp.h" | |
37 #include "paths.h" | |
38 #include "buffer.h" | |
39 | |
40 extern int errno; | |
41 | |
624 | 42 extern char *egetenv (); |
733 | 43 extern char *strcpy (); |
624 | 44 |
4275
2ed300d36643
Fix typo in previous change.
Richard M. Stallman <rms@gnu.org>
parents:
4272
diff
changeset
|
45 #ifndef __386bsd__ |
4272
41c85882768c
(getpwuid): Declare at top level, and not if __386bsd__.
Richard M. Stallman <rms@gnu.org>
parents:
3602
diff
changeset
|
46 extern struct passwd *getpwuid (); |
41c85882768c
(getpwuid): Declare at top level, and not if __386bsd__.
Richard M. Stallman <rms@gnu.org>
parents:
3602
diff
changeset
|
47 #endif |
41c85882768c
(getpwuid): Declare at top level, and not if __386bsd__.
Richard M. Stallman <rms@gnu.org>
parents:
3602
diff
changeset
|
48 |
163 | 49 #ifdef CLASH_DETECTION |
50 | |
51 /* If system does not have symbolic links, it does not have lstat. | |
52 In that case, use ordinary stat instead. */ | |
53 | |
54 #ifndef S_IFLNK | |
55 #define lstat stat | |
56 #endif | |
57 | |
624 | 58 |
59 /* The name of the directory in which we keep lock files, with a '/' | |
60 appended. */ | |
61 char *lock_path; | |
62 | |
63 /* The name of the file in the lock directory which is used to | |
64 arbitrate access to the entire directory. */ | |
65 #define SUPERLOCK_NAME "!!!SuperLock!!!" | |
66 | |
67 /* The path to the superlock file. This is SUPERLOCK_NAME appended to | |
68 lock_path. */ | |
69 char *superlock_path; | |
70 | |
71 /* Set LOCK to the name of the lock file for the filename FILE. | |
72 char *LOCK; Lisp_Object FILE; */ | |
3537
22055fd47b78
(MAKE_LOCK_PATH): If SHORT_FILE_NAMES allocates
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
73 |
3602
f71f3f167365
* filelock.c: Test HAVE_LONG_FILE_NAMES, not SHORT_FILE_NAMES, to
Jim Blandy <jimb@redhat.com>
parents:
3537
diff
changeset
|
74 #ifndef HAVE_LONG_FILE_NAMES |
3537
22055fd47b78
(MAKE_LOCK_PATH): If SHORT_FILE_NAMES allocates
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
75 |
22055fd47b78
(MAKE_LOCK_PATH): If SHORT_FILE_NAMES allocates
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
76 #define MAKE_LOCK_PATH(lock, file) \ |
22055fd47b78
(MAKE_LOCK_PATH): If SHORT_FILE_NAMES allocates
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
77 (lock = (char *) alloca (14 + strlen (lock_path) + 1), \ |
22055fd47b78
(MAKE_LOCK_PATH): If SHORT_FILE_NAMES allocates
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
78 fill_in_lock_short_file_name (lock, (file))) |
22055fd47b78
(MAKE_LOCK_PATH): If SHORT_FILE_NAMES allocates
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
79 |
22055fd47b78
(MAKE_LOCK_PATH): If SHORT_FILE_NAMES allocates
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
80 |
22055fd47b78
(MAKE_LOCK_PATH): If SHORT_FILE_NAMES allocates
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
81 fill_in_lock_short_file_name (lockfile, fn) |
22055fd47b78
(MAKE_LOCK_PATH): If SHORT_FILE_NAMES allocates
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
82 register char *lockfile; |
22055fd47b78
(MAKE_LOCK_PATH): If SHORT_FILE_NAMES allocates
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
83 register Lisp_Object fn; |
22055fd47b78
(MAKE_LOCK_PATH): If SHORT_FILE_NAMES allocates
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
84 { |
22055fd47b78
(MAKE_LOCK_PATH): If SHORT_FILE_NAMES allocates
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
85 register union |
22055fd47b78
(MAKE_LOCK_PATH): If SHORT_FILE_NAMES allocates
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
86 { |
22055fd47b78
(MAKE_LOCK_PATH): If SHORT_FILE_NAMES allocates
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
87 unsigned int word [2]; |
22055fd47b78
(MAKE_LOCK_PATH): If SHORT_FILE_NAMES allocates
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
88 unsigned char byte [8]; |
22055fd47b78
(MAKE_LOCK_PATH): If SHORT_FILE_NAMES allocates
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
89 } crc; |
22055fd47b78
(MAKE_LOCK_PATH): If SHORT_FILE_NAMES allocates
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
90 register unsigned char *p, new; |
22055fd47b78
(MAKE_LOCK_PATH): If SHORT_FILE_NAMES allocates
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
91 |
22055fd47b78
(MAKE_LOCK_PATH): If SHORT_FILE_NAMES allocates
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
92 /* 7-bytes cyclic code for burst correction on byte-by-byte basis. |
22055fd47b78
(MAKE_LOCK_PATH): If SHORT_FILE_NAMES allocates
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
93 the used polynomial is D^7 + D^6 + D^3 +1. pot@cnuce.cnr.it */ |
22055fd47b78
(MAKE_LOCK_PATH): If SHORT_FILE_NAMES allocates
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
94 |
22055fd47b78
(MAKE_LOCK_PATH): If SHORT_FILE_NAMES allocates
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
95 crc.word[0] = crc.word[1] = 0; |
22055fd47b78
(MAKE_LOCK_PATH): If SHORT_FILE_NAMES allocates
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
96 |
22055fd47b78
(MAKE_LOCK_PATH): If SHORT_FILE_NAMES allocates
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
97 for (p = XSTRING (fn)->data; new = *p++; ) |
22055fd47b78
(MAKE_LOCK_PATH): If SHORT_FILE_NAMES allocates
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
98 { |
22055fd47b78
(MAKE_LOCK_PATH): If SHORT_FILE_NAMES allocates
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
99 new += crc.byte[7]; |
22055fd47b78
(MAKE_LOCK_PATH): If SHORT_FILE_NAMES allocates
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
100 crc.byte[7] = crc.byte[6]; |
22055fd47b78
(MAKE_LOCK_PATH): If SHORT_FILE_NAMES allocates
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
101 crc.byte[6] = crc.byte[5] + new; |
22055fd47b78
(MAKE_LOCK_PATH): If SHORT_FILE_NAMES allocates
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
102 crc.byte[5] = crc.byte[4]; |
22055fd47b78
(MAKE_LOCK_PATH): If SHORT_FILE_NAMES allocates
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
103 crc.byte[4] = crc.byte[3]; |
22055fd47b78
(MAKE_LOCK_PATH): If SHORT_FILE_NAMES allocates
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
104 crc.byte[3] = crc.byte[2] + new; |
22055fd47b78
(MAKE_LOCK_PATH): If SHORT_FILE_NAMES allocates
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
105 crc.byte[2] = crc.byte[1]; |
22055fd47b78
(MAKE_LOCK_PATH): If SHORT_FILE_NAMES allocates
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
106 crc.byte[1] = crc.byte[0]; |
22055fd47b78
(MAKE_LOCK_PATH): If SHORT_FILE_NAMES allocates
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
107 crc.byte[0] = new; |
22055fd47b78
(MAKE_LOCK_PATH): If SHORT_FILE_NAMES allocates
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
108 } |
22055fd47b78
(MAKE_LOCK_PATH): If SHORT_FILE_NAMES allocates
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
109 sprintf (lockfile, "%s%.2x%.2x%.2x%.2x%.2x%.2x%.2x", lock_path, |
22055fd47b78
(MAKE_LOCK_PATH): If SHORT_FILE_NAMES allocates
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
110 crc.byte[0], crc.byte[1], crc.byte[2], crc.byte[3], |
22055fd47b78
(MAKE_LOCK_PATH): If SHORT_FILE_NAMES allocates
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
111 crc.byte[4], crc.byte[5], crc.byte[6]); |
22055fd47b78
(MAKE_LOCK_PATH): If SHORT_FILE_NAMES allocates
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
112 } |
22055fd47b78
(MAKE_LOCK_PATH): If SHORT_FILE_NAMES allocates
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
113 |
3602
f71f3f167365
* filelock.c: Test HAVE_LONG_FILE_NAMES, not SHORT_FILE_NAMES, to
Jim Blandy <jimb@redhat.com>
parents:
3537
diff
changeset
|
114 #else /* defined HAVE_LONG_FILE_NAMES */ |
3537
22055fd47b78
(MAKE_LOCK_PATH): If SHORT_FILE_NAMES allocates
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
115 |
638 | 116 #define MAKE_LOCK_PATH(lock, file) \ |
624 | 117 (lock = (char *) alloca (XSTRING (file)->size + strlen (lock_path) + 1), \ |
118 fill_in_lock_file_name (lock, (file))) | |
119 | |
3537
22055fd47b78
(MAKE_LOCK_PATH): If SHORT_FILE_NAMES allocates
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
120 |
624 | 121 fill_in_lock_file_name (lockfile, fn) |
122 register char *lockfile; | |
123 register Lisp_Object fn; | |
124 { | |
125 register char *p; | |
126 | |
127 strcpy (lockfile, lock_path); | |
128 | |
129 p = lockfile + strlen (lockfile); | |
130 | |
131 strcpy (p, XSTRING (fn)->data); | |
132 | |
133 for (; *p; p++) | |
134 { | |
135 if (*p == '/') | |
136 *p = '!'; | |
137 } | |
138 } | |
3602
f71f3f167365
* filelock.c: Test HAVE_LONG_FILE_NAMES, not SHORT_FILE_NAMES, to
Jim Blandy <jimb@redhat.com>
parents:
3537
diff
changeset
|
139 #endif /* !defined HAVE_LONG_FILE_NAMES */ |
624 | 140 |
163 | 141 static Lisp_Object |
142 lock_file_owner_name (lfname) | |
143 char *lfname; | |
144 { | |
145 struct stat s; | |
146 struct passwd *the_pw; | |
147 | |
148 if (lstat (lfname, &s) == 0) | |
149 the_pw = getpwuid (s.st_uid); | |
150 return (the_pw == 0 ? Qnil : build_string (the_pw->pw_name)); | |
151 } | |
152 | |
153 | |
154 /* lock_file locks file fn, | |
155 meaning it serves notice on the world that you intend to edit that file. | |
156 This should be done only when about to modify a file-visiting | |
157 buffer previously unmodified. | |
158 Do not (normally) call lock_buffer for a buffer already modified, | |
159 as either the file is already locked, or the user has already | |
160 decided to go ahead without locking. | |
161 | |
162 When lock_buffer returns, either the lock is locked for us, | |
163 or the user has said to go ahead without locking. | |
164 | |
165 If the file is locked by someone else, lock_buffer calls | |
166 ask-user-about-lock (a Lisp function) with two arguments, | |
167 the file name and the name of the user who did the locking. | |
168 This function can signal an error, or return t meaning | |
169 take away the lock, or return nil meaning ignore the lock. */ | |
170 | |
171 /* The lock file name is the file name with "/" replaced by "!" | |
172 and put in the Emacs lock directory. */ | |
173 /* (ie., /ka/king/junk.tex -> /!/!ka!king!junk.tex). */ | |
174 | |
3602
f71f3f167365
* filelock.c: Test HAVE_LONG_FILE_NAMES, not SHORT_FILE_NAMES, to
Jim Blandy <jimb@redhat.com>
parents:
3537
diff
changeset
|
175 /* If HAVE_LONG_FILE_NAMES is not defined, the lock file name is the hex |
3537
22055fd47b78
(MAKE_LOCK_PATH): If SHORT_FILE_NAMES allocates
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
176 representation of a 14-bytes CRC generated from the file name |
22055fd47b78
(MAKE_LOCK_PATH): If SHORT_FILE_NAMES allocates
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
177 and put in the Emacs lock directory (not very nice, but it works). |
22055fd47b78
(MAKE_LOCK_PATH): If SHORT_FILE_NAMES allocates
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
178 (ie., /ka/king/junk.tex -> /!/ec92d3ed24a8f0). */ |
22055fd47b78
(MAKE_LOCK_PATH): If SHORT_FILE_NAMES allocates
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
179 |
163 | 180 void |
181 lock_file (fn) | |
182 register Lisp_Object fn; | |
183 { | |
184 register Lisp_Object attack; | |
185 register char *lfname; | |
186 | |
624 | 187 MAKE_LOCK_PATH (lfname, fn); |
163 | 188 |
624 | 189 /* See if this file is visited and has changed on disk since it was |
190 visited. */ | |
163 | 191 { |
192 register Lisp_Object subject_buf = Fget_file_buffer (fn); | |
485 | 193 if (!NILP (subject_buf) |
194 && NILP (Fverify_visited_file_modtime (subject_buf)) | |
195 && !NILP (Ffile_exists_p (fn))) | |
163 | 196 call1 (intern ("ask-user-about-supersession-threat"), fn); |
197 } | |
198 | |
199 /* Try to lock the lock. */ | |
200 if (lock_if_free (lfname) <= 0) | |
201 /* Return now if we have locked it, or if lock dir does not exist */ | |
202 return; | |
203 | |
204 /* Else consider breaking the lock */ | |
205 attack = call2 (intern ("ask-user-about-lock"), fn, | |
206 lock_file_owner_name (lfname)); | |
485 | 207 if (!NILP (attack)) |
163 | 208 /* User says take the lock */ |
209 { | |
210 lock_superlock (lfname); | |
211 lock_file_1 (lfname, O_WRONLY) ; | |
624 | 212 unlink (superlock_path); |
163 | 213 return; |
214 } | |
215 /* User says ignore the lock */ | |
216 } | |
217 | |
218 /* Lock the lock file named LFNAME. | |
219 If MODE is O_WRONLY, we do so even if it is already locked. | |
220 If MODE is O_WRONLY | O_EXCL | O_CREAT, we do so only if it is free. | |
221 Return 1 if successful, 0 if not. */ | |
222 | |
223 int | |
224 lock_file_1 (lfname, mode) | |
225 int mode; char *lfname; | |
226 { | |
227 register int fd; | |
228 char buf[20]; | |
229 | |
230 if ((fd = open (lfname, mode, 0666)) >= 0) | |
231 { | |
232 #ifdef USG | |
233 chmod (lfname, 0666); | |
234 #else | |
235 fchmod (fd, 0666); | |
236 #endif | |
237 sprintf (buf, "%d ", getpid ()); | |
238 write (fd, buf, strlen (buf)); | |
239 close (fd); | |
240 return 1; | |
241 } | |
242 else | |
243 return 0; | |
244 } | |
245 | |
246 /* Lock the lock named LFNAME if possible. | |
247 Return 0 in that case. | |
248 Return positive if lock is really locked by someone else. | |
249 Return -1 if cannot lock for any other reason. */ | |
250 | |
251 int | |
252 lock_if_free (lfname) | |
253 register char *lfname; | |
254 { | |
255 register int clasher; | |
256 | |
257 while (lock_file_1 (lfname, O_WRONLY | O_EXCL | O_CREAT) == 0) | |
258 { | |
259 if (errno != EEXIST) | |
260 return -1; | |
261 clasher = current_lock_owner (lfname); | |
262 if (clasher != 0) | |
263 if (clasher != getpid ()) | |
264 return (clasher); | |
265 else return (0); | |
266 /* Try again to lock it */ | |
267 } | |
268 return 0; | |
269 } | |
270 | |
271 /* Return the pid of the process that claims to own the lock file LFNAME, | |
272 or 0 if nobody does or the lock is obsolete, | |
273 or -1 if something is wrong with the locking mechanism. */ | |
274 | |
275 int | |
276 current_lock_owner (lfname) | |
277 char *lfname; | |
278 { | |
279 int owner = current_lock_owner_1 (lfname); | |
280 if (owner == 0 && errno == ENOENT) | |
281 return (0); | |
282 /* Is it locked by a process that exists? */ | |
283 if (owner != 0 && (kill (owner, 0) >= 0 || errno == EPERM)) | |
284 return (owner); | |
285 if (unlink (lfname) < 0) | |
286 return (-1); | |
287 return (0); | |
288 } | |
289 | |
290 int | |
291 current_lock_owner_1 (lfname) | |
292 char *lfname; | |
293 { | |
294 register int fd; | |
295 char buf[20]; | |
296 int tem; | |
297 | |
298 fd = open (lfname, O_RDONLY, 0666); | |
299 if (fd < 0) | |
300 return 0; | |
301 tem = read (fd, buf, sizeof buf); | |
302 close (fd); | |
303 return (tem <= 0 ? 0 : atoi (buf)); | |
304 } | |
305 | |
306 | |
307 void | |
308 unlock_file (fn) | |
309 register Lisp_Object fn; | |
310 { | |
311 register char *lfname; | |
312 | |
624 | 313 MAKE_LOCK_PATH (lfname, fn); |
163 | 314 |
315 lock_superlock (lfname); | |
316 | |
317 if (current_lock_owner_1 (lfname) == getpid ()) | |
318 unlink (lfname); | |
319 | |
624 | 320 unlink (superlock_path); |
163 | 321 } |
322 | |
323 lock_superlock (lfname) | |
324 char *lfname; | |
325 { | |
326 register int i, fd; | |
327 | |
624 | 328 for (i = -20; i < 0 && (fd = open (superlock_path, |
163 | 329 O_WRONLY | O_EXCL | O_CREAT, 0666)) < 0; |
330 i++) | |
331 { | |
332 if (errno != EEXIST) | |
333 return; | |
334 sleep (1); | |
335 } | |
336 if (fd >= 0) | |
337 { | |
338 #ifdef USG | |
624 | 339 chmod (superlock_path, 0666); |
163 | 340 #else |
341 fchmod (fd, 0666); | |
342 #endif | |
343 write (fd, lfname, strlen (lfname)); | |
344 close (fd); | |
345 } | |
346 } | |
347 | |
348 void | |
349 unlock_all_files () | |
350 { | |
351 register Lisp_Object tail; | |
352 register struct buffer *b; | |
353 | |
354 for (tail = Vbuffer_alist; XGCTYPE (tail) == Lisp_Cons; | |
355 tail = XCONS (tail)->cdr) | |
356 { | |
357 b = XBUFFER (XCONS (XCONS (tail)->car)->cdr); | |
358 if (XTYPE (b->filename) == Lisp_String && | |
359 b->save_modified < BUF_MODIFF (b)) | |
360 unlock_file (b->filename); | |
361 } | |
362 } | |
363 | |
364 | |
365 DEFUN ("lock-buffer", Flock_buffer, Slock_buffer, | |
366 0, 1, 0, | |
367 "Lock FILE, if current buffer is modified.\n\ | |
368 FILE defaults to current buffer's visited file,\n\ | |
369 or else nothing is done if current buffer isn't visiting a file.") | |
370 (fn) | |
371 Lisp_Object fn; | |
372 { | |
485 | 373 if (NILP (fn)) |
163 | 374 fn = current_buffer->filename; |
375 else | |
376 CHECK_STRING (fn, 0); | |
377 if (current_buffer->save_modified < MODIFF | |
485 | 378 && !NILP (fn)) |
163 | 379 lock_file (fn); |
380 return Qnil; | |
381 } | |
382 | |
383 DEFUN ("unlock-buffer", Funlock_buffer, Sunlock_buffer, | |
384 0, 0, 0, | |
385 "Unlock the file visited in the current buffer,\n\ | |
386 if it should normally be locked.") | |
387 () | |
388 { | |
389 if (current_buffer->save_modified < MODIFF && | |
390 XTYPE (current_buffer->filename) == Lisp_String) | |
391 unlock_file (current_buffer->filename); | |
392 return Qnil; | |
393 } | |
394 | |
395 | |
396 /* Unlock the file visited in buffer BUFFER. */ | |
397 | |
398 unlock_buffer (buffer) | |
399 struct buffer *buffer; | |
400 { | |
401 if (buffer->save_modified < BUF_MODIFF (buffer) && | |
402 XTYPE (buffer->filename) == Lisp_String) | |
403 unlock_file (buffer->filename); | |
404 } | |
405 | |
406 DEFUN ("file-locked-p", Ffile_locked_p, Sfile_locked_p, 0, 1, 0, | |
407 "Return nil if the FILENAME is not locked,\n\ | |
408 t if it is locked by you, else a string of the name of the locker.") | |
409 (fn) | |
410 Lisp_Object fn; | |
411 { | |
412 register char *lfname; | |
413 int owner; | |
414 | |
415 fn = Fexpand_file_name (fn, Qnil); | |
416 | |
624 | 417 MAKE_LOCK_PATH (lfname, fn); |
163 | 418 |
419 owner = current_lock_owner (lfname); | |
420 if (owner <= 0) | |
421 return (Qnil); | |
422 else if (owner == getpid ()) | |
423 return (Qt); | |
424 | |
425 return (lock_file_owner_name (lfname)); | |
426 } | |
427 | |
624 | 428 |
429 /* Initialization functions. */ | |
430 | |
431 init_filelock () | |
432 { | |
433 lock_path = egetenv ("EMACSLOCKDIR"); | |
434 if (! lock_path) | |
435 lock_path = PATH_LOCK; | |
436 | |
437 /* Make sure it ends with a slash. */ | |
438 if (lock_path[strlen (lock_path) - 1] != '/') | |
439 { | |
440 lock_path = strcpy ((char *) xmalloc (strlen (lock_path) + 2), | |
441 lock_path); | |
442 strcat (lock_path, "/"); | |
443 } | |
444 | |
445 superlock_path = (char *) xmalloc ((strlen (lock_path) | |
446 + sizeof (SUPERLOCK_NAME))); | |
447 strcpy (superlock_path, lock_path); | |
448 strcat (superlock_path, SUPERLOCK_NAME); | |
449 } | |
450 | |
163 | 451 syms_of_filelock () |
452 { | |
453 defsubr (&Sunlock_buffer); | |
454 defsubr (&Slock_buffer); | |
455 defsubr (&Sfile_locked_p); | |
456 } | |
457 | |
458 #endif /* CLASH_DETECTION */ |