Mercurial > hg > xemacs-beta
annotate src/filelock.c @ 5353:38e24b8be4ea
Improve the lexical scoping in #'block, #'return-from.
lisp/ChangeLog addition:
2011-02-07 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el:
* bytecomp.el (byte-compile-initial-macro-environment):
Shadow `block', `return-from' here, we implement them differently
when byte-compiling.
* bytecomp.el (byte-compile-active-blocks): New.
* bytecomp.el (byte-compile-block-1): New.
* bytecomp.el (byte-compile-return-from-1): New.
* bytecomp.el (return-from-1): New.
* bytecomp.el (block-1): New.
These are two aliases that exist to have their own associated
byte-compile functions, which functions implement `block' and
`return-from'.
* cl-extra.el (cl-macroexpand-all):
Fix a bug here when macros in the environment have been compiled.
* cl-macs.el (block):
* cl-macs.el (return):
* cl-macs.el (return-from):
Be more careful about lexical scope in these macros.
* cl.el:
* cl.el ('cl-block-wrapper): Removed.
* cl.el ('cl-block-throw): Removed.
These aren't needed in code generated by this XEmacs. They
shouldn't be needed in code generated by XEmacs 21.4, but if it
turns out the packages do need them, we can put them back.
2011-01-30 Mike Sperber <mike@xemacs.org>
* font-lock.el (font-lock-fontify-pending-extents): Don't fail if
`font-lock-mode' is unset, which can happen in the middle of
`revert-buffer'.
2011-01-23 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (delete):
* cl-macs.el (delq):
* cl-macs.el (remove):
* cl-macs.el (remq):
Don't use the compiler macro if these functions were given the
wrong number of arguments, as happens in lisp-tests.el.
* cl-seq.el (remove, remq): Removed.
I added these to subr.el, and forgot to remove them from here.
2011-01-22 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-setq, byte-compile-set):
Remove kludge allowing keywords' values to be set, all the code
that does that is gone.
* cl-compat.el (elt-satisfies-test-p):
* faces.el (set-face-parent):
* faces.el (face-doc-string):
* gtk-font-menu.el:
* gtk-font-menu.el (gtk-reset-device-font-menus):
* msw-font-menu.el:
* msw-font-menu.el (mswindows-reset-device-font-menus):
* package-get.el (package-get-installedp):
* select.el (select-convert-from-image-data):
* sound.el:
* sound.el (load-sound-file):
* x-font-menu.el (x-reset-device-font-menus-core):
Don't quote keywords, they're self-quoting, and the
win from backward-compatibility is sufficiently small now that the
style problem overrides it.
2011-01-22 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (block, return-from): Require that NAME be a symbol
in these macros, as always documented in the #'block docstring and
as required by Common Lisp.
* descr-text.el (unidata-initialize-unihan-database):
Correct the use of non-symbols in #'block and #'return-from in
this function.
2011-01-15 Aidan Kehoe <kehoea@parhasard.net>
* cl-extra.el (concatenate): Accept more complicated TYPEs in this
function, handing the sequences over to #'coerce if we don't
understand them here.
* cl-macs.el (inline): Don't proclaim #'concatenate as inline, its
compiler macro is more useful than doing that.
2011-01-11 Aidan Kehoe <kehoea@parhasard.net>
* subr.el (delete, delq, remove, remq): Move #'remove, #'remq
here, they don't belong in cl-seq.el; move #'delete, #'delq here
from fns.c, implement them in terms of #'delete*, allowing support
for sequences generally.
* update-elc.el (do-autoload-commands): Use #'delete*, not #'delq
here, now the latter's no longer dumped.
* cl-macs.el (delete, delq): Add compiler macros transforming
#'delete and #'delq to #'delete* calls.
2011-01-10 Aidan Kehoe <kehoea@parhasard.net>
* dialog.el (make-dialog-box): Correct a misplaced parenthesis
here, thank you Mats Lidell in 87zkr9gqrh.fsf@mail.contactor.se !
2011-01-02 Aidan Kehoe <kehoea@parhasard.net>
* dialog.el (make-dialog-box):
* list-mode.el (display-completion-list):
These functions used to use cl-parsing-keywords; change them to
use defun* instead, fixing the build. (Not sure what led to me
not including this change in d1b17a33450b!)
2011-01-02 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (define-star-compiler-macros):
Make sure the form has ITEM and LIST specified before attempting
to change to calls with explicit tests; necessary for some tests
in lisp-tests.el to compile correctly.
(stable-union, stable-intersection): Add compiler macros for these
functions, in the same way we do for most of the other functions
in cl-seq.el.
2011-01-01 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (dolist, dotimes, do-symbols, macrolet)
(symbol-macrolet):
Define these macros with defmacro* instead of parsing the argument
list by hand, for the sake of style and readability; use backquote
where appropriate, instead of calling #'list and and friends, for
the same reason.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* x-misc.el (device-x-display):
Provide this function, documented in the Lispref for years, but
not existing previously. Thank you Julian Bradfield, thank you
Jeff Mincy.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* cl-seq.el:
Move the heavy lifting from this file to C. Dump the
cl-parsing-keywords macro, but don't use defun* for the functions
we define that do take keywords, dynamic scope lossage makes that
not practical.
* subr.el (sort, fillarray): Move these aliases here.
(map-plist): #'nsublis is now built-in, but at this point #'eql
isn't necessarily available as a test; use #'eq.
* obsolete.el (cl-delete-duplicates): Make this available for old
compiler macros and old code.
(memql): Document that this is equivalent to #'member*, and worse.
* cl.el (adjoin, subst): Removed. These are in C.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* simple.el (assoc-ignore-case): Remove a duplicate definition of
this function (it's already in subr.el).
* iso8859-1.el (char-width):
On non-Mule, make this function equivalent to that produced by
(constantly 1), but preserve its docstring.
* subr.el (subst-char-in-string): Define this in terms of
#'substitute, #'nsubstitute.
(string-width): Define this using #'reduce and #'char-width.
(char-width): Give this a simpler definition, it makes far more
sense to check for mule at load time and redefine, as we do in
iso8859-1.el.
(store-substring): Implement this in terms of #'replace, now
#'replace is cheap.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* update-elc.el (lisp-files-needed-for-byte-compilation)
(lisp-files-needing-early-byte-compilation):
cl-macs belongs in the former, not the latter, it is as
fundamental as bytecomp.el.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* cl.el:
Provde the Common Lisp program-error, type-error as error
symbols. This doesn't nearly go far enough for anyone using the
Common Lisp errors.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (delete-duplicates):
If the form has an incorrect number of arguments, don't attempt a
compiler macroexpansion.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (cl-safe-expr-p):
Forms that start with the symbol lambda are also safe.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (= < > <= >=):
For these functions' compiler macros, the optimisation is safe
even if the first and the last arguments have side effects, since
they're only used the once.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (inline-side-effect-free-compiler-macros):
Unroll a loop here at macro-expansion time, so these compiler
macros are compiled. Use #'eql instead of #'eq in a couple of
places for better style.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-extra.el (notany, notevery): Avoid some dynamic scope
stupidity with local variable names in these functions, when they
weren't prefixed with cl-; go into some more detail in the doc
strings.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* byte-optimize.el (side-effect-free-fns): #'remove, #'remq are
free of side-effects.
(side-effect-and-error-free-fns):
Drop dot, dot-marker from the list.
2010-11-17 Aidan Kehoe <kehoea@parhasard.net>
* cl-extra.el (coerce):
In the argument list, name the first argument OBJECT, not X; the
former name was always used in the doc string and is clearer.
Handle vector type specifications which include the length of the
target sequence, error if there's a mismatch.
* cl-macs.el (cl-make-type-test): Handle type specifications
starting with the symbol 'eql.
2010-11-14 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (eql): Don't remove the byte-compile property of this
symbol. That was necessary to override a bug in bytecomp.el where
#'eql was confused with #'eq, which bug we no longer have.
If neither expression is constant, don't attempt to handle the
expression in this compiler macro, leave it to byte-compile-eql,
which produces better code anyway.
* bytecomp.el (eq): #'eql is not the function associated with the
byte-eq byte code.
(byte-compile-eql): Add an explicit compile method for this
function, for cases where the cl-macs compiler macro hasn't
reduced it to #'eq or #'equal.
2010-10-25 Aidan Kehoe <kehoea@parhasard.net>
Add compiler macros and compilation sanity-checking for various
functions that take keywords.
* byte-optimize.el (side-effect-free-fns): #'symbol-value is
side-effect free and not error free.
* bytecomp.el (byte-compile-normal-call): Check keyword argument
lists for sanity; store information about the positions where
keyword arguments start using the new byte-compile-keyword-start
property.
* cl-macs.el (cl-const-expr-val): Take a new optional argument,
cl-not-constant, defaulting to nil, in this function; return it if
the expression is not constant.
(cl-non-fixnum-number-p): Make this into a separate function, we
want to pass it to #'every.
(eql): Use it.
(define-star-compiler-macros): Use the same code to generate the
member*, assoc* and rassoc* compiler macros; special-case some
code in #'add-to-list in subr.el.
(remove, remq): Add compiler macros for these two functions, in
preparation for #'remove being in C.
(define-foo-if-compiler-macros): Transform (remove-if-not ...) calls to
(remove ... :if-not) at compile time, which will be a real win
once the latter is in C.
(define-substitute-if-compiler-macros)
(define-subst-if-compiler-macros): Similarly for these functions.
(delete-duplicates): Change this compiler macro to use
#'plists-equal; if we don't have information about the type of
SEQUENCE at compile time, don't bother attempting to inline the
call, the function will be in C soon enough.
(equalp): Remove an old commented-out compiler macro for this, if
we want to see it it's in version control.
(subst-char-in-string): Transform this to a call to nsubstitute or
nsubstitute, if that is appropriate.
* cl.el (ldiff): Don't call setf here, this makes for a load-time
dependency problem in cl-macs.el
2010-06-14 Stephen J. Turnbull <stephen@xemacs.org>
* term/vt100.el:
Refer to XEmacs, not GNU Emacs, in permissions.
* term/bg-mouse.el:
* term/sup-mouse.el:
Put copyright notice in canonical "Copyright DATE AUTHOR" form.
Refer to XEmacs, not GNU Emacs, in permissions.
* site-load.el:
Add permission boilerplate.
* mule/canna-leim.el:
* alist.el:
Refer to XEmacs, not APEL/this program, in permissions.
* mule/canna-leim.el:
Remove my copyright, I've assigned it to the FSF.
2010-06-14 Stephen J. Turnbull <stephen@xemacs.org>
* gtk.el:
* gtk-widget-accessors.el:
* gtk-package.el:
* gtk-marshal.el:
* gtk-compose.el:
* gnome.el:
Add copyright notice based on internal evidence.
2010-06-14 Stephen J. Turnbull <stephen@xemacs.org>
* easymenu.el: Add reference to COPYING to permission notice.
* gutter.el:
* gutter-items.el:
* menubar-items.el:
Fix typo "Xmacs" in permissions notice.
2010-06-14 Stephen J. Turnbull <stephen@xemacs.org>
* auto-save.el:
* font.el:
* fontconfig.el:
* mule/kinsoku.el:
Add "part of XEmacs" text to permission notice.
2010-10-14 Aidan Kehoe <kehoea@parhasard.net>
* byte-optimize.el (side-effect-free-fns):
* cl-macs.el (remf, getf):
* cl-extra.el (tailp, cl-set-getf, cl-do-remf):
* cl.el (ldiff, endp):
Tighten up Common Lisp compatibility for #'ldiff, #'endp, #'tailp;
add circularity checking for the first two.
#'cl-set-getf and #'cl-do-remf were Lisp implementations of
#'plist-put and #'plist-remprop; change the names to aliases,
changes the macros that use them to using #'plist-put and
#'plist-remprop directly.
2010-10-12 Aidan Kehoe <kehoea@parhasard.net>
* abbrev.el (fundamental-mode-abbrev-table, global-abbrev-table):
Create both these abbrev tables using the usual
#'define-abbrev-table calls, rather than attempting to
special-case them.
* cl-extra.el: Force cl-macs to be loaded here, if cl-extra.el is
being loaded interpreted. Previously other, later files would
redundantly call (load "cl-macs") when interpreted, it's more
reasonable to do it here, once.
* cmdloop.el (read-quoted-char-radix): Use defcustom here, we
don't have any dump-order dependencies that would prevent that.
* custom.el (eval-when-compile): Don't load cl-macs when
interpreted or when byte-compiling, rely on cl-extra.el in the
former case and the appropriate entry in bytecomp-load-hook in the
latter. Get rid of custom-declare-variable-list, we have no
dump-time dependencies that would require it.
* faces.el (eval-when-compile): Don't load cl-macs when
interpreted or when byte-compiling.
* packages.el: Remove some inaccurate comments.
* post-gc.el (cleanup-simple-finalizers): Use #'delete-if-not
here, now the order of preloaded-file-list has been changed to
make it available.
* subr.el (custom-declare-variable-list): Remove. No need for it.
Also remove a stub define-abbrev-table from this file, given the
current order of preloaded-file-list there's no need for it.
2010-10-10 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-constp) Forms quoted with FUNCTION are
also constant.
(byte-compile-initial-macro-environment): In #'the, if FORM is
constant and does not match TYPE, warn at byte-compile time.
2010-10-10 Aidan Kehoe <kehoea@parhasard.net>
* backquote.el (bq-vector-contents, bq-list*): Remove; the former
is equivalent to (append VECTOR nil), the latter to (list* ...).
(bq-process-2): Use (append VECTOR nil) instead of using
#'bq-vector-contents to convert to a list.
(bq-process-1): Now we use list* instead of bq-list
* subr.el (list*): Moved from cl.el, since it is now required to
be available the first time a backquoted form is encountered.
* cl.el (list*): Move to subr.el.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* test-harness.el (Check-Message):
Add an omitted comma here, thank you the buildbot.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* hash-table.el (hash-table-key-list, hash-table-value-list)
(hash-table-key-value-alist, hash-table-key-value-plist):
Remove some useless #'nreverse calls in these files; our hash
tables have no order, it's not helpful to pretend they do.
* behavior.el (read-behavior):
Do the same in this file, in some code evidently copied from
hash-table.el.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* info.el (Info-insert-dir):
* format.el (format-deannotate-region):
* files.el (cd, save-buffers-kill-emacs):
Use #'some, #'every and related functions for applying boolean
operations to lists, instead of rolling our own ones that cons and
don't short-circuit.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-initial-macro-environment):
* cl-macs.el (the):
Rephrase the docstring, make its implementation when compiling
files a little nicer.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* descr-text.el (unidata-initialize-unicodedata-database)
(unidata-initialize-unihan-database, describe-char-unicode-data)
(describe-char-unicode-data):
Wrap calls to the database functions with (with-fboundp ...),
avoiding byte compile warnings on builds without support for the
database functions.
(describe-char): (reduce #'max ...), not (apply #'max ...), no
need to cons needlessly.
(describe-char): Remove a redundant lambda wrapping
#'extent-properties.
(describe-char-unicode-data): Call #'nsubst when replacing "" with
nil in the result of #'split-string, instead of consing inside
mapcar.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* x-faces.el (x-available-font-sizes):
* specifier.el (let-specifier):
* package-ui.el (pui-add-required-packages):
* msw-faces.el (mswindows-available-font-sizes):
* modeline.el (modeline-minor-mode-menu):
* minibuf.el (minibuf-directory-files):
Replace the O2N (delq nil (mapcar (lambda (W) (and X Y)) Z)) with
the ON (mapcan (lambda (W) (and X (list Y))) Z) in these files.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (= < > <= >=):
When these functions are handed more than two arguments, and those
arguments have no side effects, transform to a series of two
argument calls, avoiding funcall in the byte-compiled code.
* mule/mule-cmds.el (finish-set-language-environment):
Take advantage of this change in a function called 256 times at
startup.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-function-form, byte-compile-quote)
(byte-compile-quote-form):
Warn at compile time, and error at runtime, if a (quote ...) or a
(function ...) form attempts to quote more than one object.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* byte-optimize.el (byte-optimize-apply): Transform (apply 'nconc
(mapcar ...)) to (mapcan ...); warn about use of the first idiom.
* update-elc.el (do-autoload-commands):
* packages.el (packages-find-package-library-path):
* frame.el (frame-list):
* extents.el (extent-descendants):
* etags.el (buffer-tag-table-files):
* dumped-lisp.el (preloaded-file-list):
* device.el (device-list):
* bytecomp-runtime.el (proclaim-inline, proclaim-notinline)
Use #'mapcan, not (apply #'nconc (mapcar ...) in all these files.
* bytecomp-runtime.el (eval-when-compile, eval-and-compile):
In passing, mention that these macros also evaluate the body when
interpreted.
tests/ChangeLog addition:
2011-02-07 Aidan Kehoe <kehoea@parhasard.net>
* automated/lisp-tests.el:
Test lexical scope for `block', `return-from'; add a
Known-Bug-Expect-Failure for a contorted example that fails when
byte-compiled.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Mon, 07 Feb 2011 12:01:24 +0000 |
| 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 */ |