Mercurial > hg > xemacs-beta
annotate src/filelock.c @ 5127:a9c41067dd88 ben-lisp-object
more cleanups, terminology clarification, lots of doc work
-------------------- ChangeLog entries follow: --------------------
man/ChangeLog addition:
2010-03-05 Ben Wing <ben@xemacs.org>
* internals/internals.texi (Introduction to Allocation):
* internals/internals.texi (Integers and Characters):
* internals/internals.texi (Allocation from Frob Blocks):
* internals/internals.texi (lrecords):
* internals/internals.texi (Low-level allocation):
Rewrite section on allocation of Lisp objects to reflect the new
reality. Remove references to nonexistent XSETINT and XSETCHAR.
modules/ChangeLog addition:
2010-03-05 Ben Wing <ben@xemacs.org>
* postgresql/postgresql.c (allocate_pgconn):
* postgresql/postgresql.c (allocate_pgresult):
* postgresql/postgresql.h (struct Lisp_PGconn):
* postgresql/postgresql.h (struct Lisp_PGresult):
* ldap/eldap.c (allocate_ldap):
* ldap/eldap.h (struct Lisp_LDAP):
Same changes as in src/ dir. See large log there in ChangeLog,
but basically:
ALLOC_LISP_OBJECT -> ALLOC_NORMAL_LISP_OBJECT
LISP_OBJECT_HEADER -> NORMAL_LISP_OBJECT_HEADER
../hlo/src/ChangeLog addition:
2010-03-05 Ben Wing <ben@xemacs.org>
* alloc.c:
* alloc.c (old_alloc_sized_lcrecord):
* alloc.c (very_old_free_lcrecord):
* alloc.c (copy_lisp_object):
* alloc.c (zero_sized_lisp_object):
* alloc.c (zero_nonsized_lisp_object):
* alloc.c (lisp_object_storage_size):
* alloc.c (free_normal_lisp_object):
* alloc.c (FREE_FIXED_TYPE_WHEN_NOT_IN_GC):
* alloc.c (ALLOC_FROB_BLOCK_LISP_OBJECT):
* alloc.c (Fcons):
* alloc.c (noseeum_cons):
* alloc.c (make_float):
* alloc.c (make_bignum):
* alloc.c (make_bignum_bg):
* alloc.c (make_ratio):
* alloc.c (make_ratio_bg):
* alloc.c (make_ratio_rt):
* alloc.c (make_bigfloat):
* alloc.c (make_bigfloat_bf):
* alloc.c (size_vector):
* alloc.c (make_compiled_function):
* alloc.c (Fmake_symbol):
* alloc.c (allocate_extent):
* alloc.c (allocate_event):
* alloc.c (make_key_data):
* alloc.c (make_button_data):
* alloc.c (make_motion_data):
* alloc.c (make_process_data):
* alloc.c (make_timeout_data):
* alloc.c (make_magic_data):
* alloc.c (make_magic_eval_data):
* alloc.c (make_eval_data):
* alloc.c (make_misc_user_data):
* alloc.c (Fmake_marker):
* alloc.c (noseeum_make_marker):
* alloc.c (size_string_direct_data):
* alloc.c (make_uninit_string):
* alloc.c (make_string_nocopy):
* alloc.c (mark_lcrecord_list):
* alloc.c (alloc_managed_lcrecord):
* alloc.c (free_managed_lcrecord):
* alloc.c (sweep_lcrecords_1):
* alloc.c (malloced_storage_size):
* buffer.c (allocate_buffer):
* buffer.c (compute_buffer_usage):
* buffer.c (DEFVAR_BUFFER_LOCAL_1):
* buffer.c (nuke_all_buffer_slots):
* buffer.c (common_init_complex_vars_of_buffer):
* buffer.h (struct buffer_text):
* buffer.h (struct buffer):
* bytecode.c:
* bytecode.c (make_compiled_function_args):
* bytecode.c (size_compiled_function_args):
* bytecode.h (struct compiled_function_args):
* casetab.c (allocate_case_table):
* casetab.h (struct Lisp_Case_Table):
* charset.h (struct Lisp_Charset):
* chartab.c (fill_char_table):
* chartab.c (Fmake_char_table):
* chartab.c (make_char_table_entry):
* chartab.c (copy_char_table_entry):
* chartab.c (Fcopy_char_table):
* chartab.c (put_char_table):
* chartab.h (struct Lisp_Char_Table_Entry):
* chartab.h (struct Lisp_Char_Table):
* console-gtk-impl.h (struct gtk_device):
* console-gtk-impl.h (struct gtk_frame):
* console-impl.h (struct console):
* console-msw-impl.h (struct Lisp_Devmode):
* console-msw-impl.h (struct mswindows_device):
* console-msw-impl.h (struct msprinter_device):
* console-msw-impl.h (struct mswindows_frame):
* console-msw-impl.h (struct mswindows_dialog_id):
* console-stream-impl.h (struct stream_console):
* console-stream.c (stream_init_console):
* console-tty-impl.h (struct tty_console):
* console-tty-impl.h (struct tty_device):
* console-tty.c (allocate_tty_console_struct):
* console-x-impl.h (struct x_device):
* console-x-impl.h (struct x_frame):
* console.c (allocate_console):
* console.c (nuke_all_console_slots):
* console.c (DEFVAR_CONSOLE_LOCAL_1):
* console.c (common_init_complex_vars_of_console):
* data.c (make_weak_list):
* data.c (make_weak_box):
* data.c (make_ephemeron):
* database.c:
* database.c (struct Lisp_Database):
* database.c (allocate_database):
* database.c (finalize_database):
* device-gtk.c (allocate_gtk_device_struct):
* device-impl.h (struct device):
* device-msw.c:
* device-msw.c (mswindows_init_device):
* device-msw.c (msprinter_init_device):
* device-msw.c (finalize_devmode):
* device-msw.c (allocate_devmode):
* device-tty.c (allocate_tty_device_struct):
* device-x.c (allocate_x_device_struct):
* device.c:
* device.c (nuke_all_device_slots):
* device.c (allocate_device):
* dialog-msw.c (handle_question_dialog_box):
* elhash.c:
* elhash.c (struct Lisp_Hash_Table):
* elhash.c (finalize_hash_table):
* elhash.c (make_general_lisp_hash_table):
* elhash.c (Fcopy_hash_table):
* elhash.h (htentry):
* emacs.c (main_1):
* eval.c:
* eval.c (size_multiple_value):
* event-stream.c (finalize_command_builder):
* event-stream.c (allocate_command_builder):
* event-stream.c (free_command_builder):
* event-stream.c (event_stream_generate_wakeup):
* event-stream.c (event_stream_resignal_wakeup):
* event-stream.c (event_stream_disable_wakeup):
* event-stream.c (event_stream_wakeup_pending_p):
* events.h (struct Lisp_Timeout):
* events.h (struct command_builder):
* extents-impl.h:
* extents-impl.h (struct extent_auxiliary):
* extents-impl.h (struct extent_info):
* extents-impl.h (set_extent_no_chase_aux_field):
* extents-impl.h (set_extent_no_chase_normal_field):
* extents.c:
* extents.c (gap_array_marker):
* extents.c (gap_array):
* extents.c (extent_list_marker):
* extents.c (extent_list):
* extents.c (stack_of_extents):
* extents.c (gap_array_make_marker):
* extents.c (extent_list_make_marker):
* extents.c (allocate_extent_list):
* extents.c (SLOT):
* extents.c (mark_extent_auxiliary):
* extents.c (allocate_extent_auxiliary):
* extents.c (attach_extent_auxiliary):
* extents.c (size_gap_array):
* extents.c (finalize_extent_info):
* extents.c (allocate_extent_info):
* extents.c (uninit_buffer_extents):
* extents.c (allocate_soe):
* extents.c (copy_extent):
* extents.c (vars_of_extents):
* extents.h:
* faces.c (allocate_face):
* faces.h (struct Lisp_Face):
* faces.h (struct face_cachel):
* file-coding.c:
* file-coding.c (finalize_coding_system):
* file-coding.c (sizeof_coding_system):
* file-coding.c (Fcopy_coding_system):
* file-coding.h (struct Lisp_Coding_System):
* file-coding.h (MARKED_SLOT):
* fns.c (size_bit_vector):
* font-mgr.c:
* font-mgr.c (finalize_fc_pattern):
* font-mgr.c (print_fc_pattern):
* font-mgr.c (Ffc_pattern_p):
* font-mgr.c (Ffc_pattern_create):
* font-mgr.c (Ffc_name_parse):
* font-mgr.c (Ffc_name_unparse):
* font-mgr.c (Ffc_pattern_duplicate):
* font-mgr.c (Ffc_pattern_add):
* font-mgr.c (Ffc_pattern_del):
* font-mgr.c (Ffc_pattern_get):
* font-mgr.c (fc_config_create_using):
* font-mgr.c (fc_strlist_to_lisp_using):
* font-mgr.c (fontset_to_list):
* font-mgr.c (Ffc_config_p):
* font-mgr.c (Ffc_config_up_to_date):
* font-mgr.c (Ffc_config_build_fonts):
* font-mgr.c (Ffc_config_get_cache):
* font-mgr.c (Ffc_config_get_fonts):
* font-mgr.c (Ffc_config_set_current):
* font-mgr.c (Ffc_config_get_blanks):
* font-mgr.c (Ffc_config_get_rescan_interval):
* font-mgr.c (Ffc_config_set_rescan_interval):
* font-mgr.c (Ffc_config_app_font_add_file):
* font-mgr.c (Ffc_config_app_font_add_dir):
* font-mgr.c (Ffc_config_app_font_clear):
* font-mgr.c (size):
* font-mgr.c (Ffc_config_substitute):
* font-mgr.c (Ffc_font_render_prepare):
* font-mgr.c (Ffc_font_match):
* font-mgr.c (Ffc_font_sort):
* font-mgr.c (finalize_fc_config):
* font-mgr.c (print_fc_config):
* font-mgr.h:
* font-mgr.h (struct fc_pattern):
* font-mgr.h (XFC_PATTERN):
* font-mgr.h (struct fc_config):
* font-mgr.h (XFC_CONFIG):
* frame-gtk.c (allocate_gtk_frame_struct):
* frame-impl.h (struct frame):
* frame-msw.c (mswindows_init_frame_1):
* frame-x.c (allocate_x_frame_struct):
* frame.c (nuke_all_frame_slots):
* frame.c (allocate_frame_core):
* gc.c:
* gc.c (GC_CHECK_NOT_FREE):
* glyphs.c (finalize_image_instance):
* glyphs.c (allocate_image_instance):
* glyphs.c (Fcolorize_image_instance):
* glyphs.c (allocate_glyph):
* glyphs.c (unmap_subwindow_instance_cache_mapper):
* glyphs.c (register_ignored_expose):
* glyphs.h (struct Lisp_Image_Instance):
* glyphs.h (struct Lisp_Glyph):
* glyphs.h (struct glyph_cachel):
* glyphs.h (struct expose_ignore):
* gui.c (allocate_gui_item):
* gui.h (struct Lisp_Gui_Item):
* keymap.c (struct Lisp_Keymap):
* keymap.c (make_keymap):
* lisp.h:
* lisp.h (struct Lisp_String_Direct_Data):
* lisp.h (struct Lisp_String_Indirect_Data):
* lisp.h (struct Lisp_Vector):
* lisp.h (struct Lisp_Bit_Vector):
* lisp.h (DECLARE_INLINE_LISP_BIT_VECTOR):
* lisp.h (struct weak_box):
* lisp.h (struct ephemeron):
* lisp.h (struct weak_list):
* lrecord.h:
* lrecord.h (struct lrecord_implementation):
* lrecord.h (MC_ALLOC_CALL_FINALIZER):
* lrecord.h (struct lcrecord_list):
* lstream.c (finalize_lstream):
* lstream.c (sizeof_lstream):
* lstream.c (Lstream_new):
* lstream.c (Lstream_delete):
* lstream.h (struct lstream):
* marker.c:
* marker.c (finalize_marker):
* marker.c (compute_buffer_marker_usage):
* mule-charset.c:
* mule-charset.c (make_charset):
* mule-charset.c (compute_charset_usage):
* objects-impl.h (struct Lisp_Color_Instance):
* objects-impl.h (struct Lisp_Font_Instance):
* objects-tty-impl.h (struct tty_color_instance_data):
* objects-tty-impl.h (struct tty_font_instance_data):
* objects-tty.c (tty_initialize_color_instance):
* objects-tty.c (tty_initialize_font_instance):
* objects.c (finalize_color_instance):
* objects.c (Fmake_color_instance):
* objects.c (finalize_font_instance):
* objects.c (Fmake_font_instance):
* objects.c (reinit_vars_of_objects):
* opaque.c:
* opaque.c (sizeof_opaque):
* opaque.c (make_opaque_ptr):
* opaque.c (free_opaque_ptr):
* opaque.h:
* opaque.h (Lisp_Opaque):
* opaque.h (Lisp_Opaque_Ptr):
* print.c (printing_unreadable_lcrecord):
* print.c (external_object_printer):
* print.c (debug_p4):
* process.c (finalize_process):
* process.c (make_process_internal):
* procimpl.h (struct Lisp_Process):
* rangetab.c (Fmake_range_table):
* rangetab.c (Fcopy_range_table):
* rangetab.h (struct Lisp_Range_Table):
* scrollbar.c:
* scrollbar.c (create_scrollbar_instance):
* scrollbar.c (compute_scrollbar_instance_usage):
* scrollbar.h (struct scrollbar_instance):
* specifier.c (finalize_specifier):
* specifier.c (sizeof_specifier):
* specifier.c (set_specifier_caching):
* specifier.h (struct Lisp_Specifier):
* specifier.h (struct specifier_caching):
* symeval.h:
* symeval.h (SYMBOL_VALUE_MAGIC_P):
* symeval.h (DEFVAR_SYMVAL_FWD):
* symsinit.h:
* syntax.c (init_buffer_syntax_cache):
* syntax.h (struct syntax_cache):
* toolbar.c:
* toolbar.c (allocate_toolbar_button):
* toolbar.c (update_toolbar_button):
* toolbar.h (struct toolbar_button):
* tooltalk.c (struct Lisp_Tooltalk_Message):
* tooltalk.c (make_tooltalk_message):
* tooltalk.c (struct Lisp_Tooltalk_Pattern):
* tooltalk.c (make_tooltalk_pattern):
* ui-gtk.c:
* ui-gtk.c (allocate_ffi_data):
* ui-gtk.c (emacs_gtk_object_finalizer):
* ui-gtk.c (allocate_emacs_gtk_object_data):
* ui-gtk.c (allocate_emacs_gtk_boxed_data):
* ui-gtk.h:
* window-impl.h (struct window):
* window-impl.h (struct window_mirror):
* window.c (finalize_window):
* window.c (allocate_window):
* window.c (new_window_mirror):
* window.c (mark_window_as_deleted):
* window.c (make_dummy_parent):
* window.c (compute_window_mirror_usage):
* window.c (compute_window_usage):
Overall point of this change and previous ones in this repository:
(1) Introduce new, clearer terminology: everything other than int
or char is a "record" object, which comes in two types: "normal
objects" and "frob-block objects". Fix up all places that
referred to frob-block objects as "simple", "basic", etc.
(2) Provide an advertised interface for doing operations on Lisp
objects, including creating new types, that is clean and
consistent in its naming, uses the above-referenced terms and
avoids referencing "lrecords", "old lcrecords", etc., which should
hide under the surface.
(3) Make the size_in_bytes and finalizer methods take a
Lisp_Object rather than a void * for consistency with other methods.
(4) Separate finalizer method into finalizer and disksaver, so
that normal finalize methods don't have to worry about disksaving.
Other specifics:
(1) Renaming:
LISP_OBJECT_HEADER -> NORMAL_LISP_OBJECT_HEADER
ALLOC_LISP_OBJECT -> ALLOC_NORMAL_LISP_OBJECT
implementation->basic_p -> implementation->frob_block_p
ALLOCATE_FIXED_TYPE_AND_SET_IMPL -> ALLOC_FROB_BLOCK_LISP_OBJECT
*FCCONFIG*, wrap_fcconfig -> *FC_CONFIG*, wrap_fc_config
*FCPATTERN*, wrap_fcpattern -> *FC_PATTERN*, wrap_fc_pattern
(the last two changes make the naming of these macros consistent
with the naming of all other macros, since the objects are named
fc-config and fc-pattern with a hyphen)
(2) Lots of documentation fixes in lrecord.h.
(3) Eliminate macros for copying, freeing, zeroing objects, getting
their storage size. Instead, new functions:
zero_sized_lisp_object()
zero_nonsized_lisp_object()
lisp_object_storage_size()
free_normal_lisp_object()
(copy_lisp_object() already exists)
LISP_OBJECT_FROB_BLOCK_P() (actually a macro)
Eliminated:
free_lrecord()
zero_lrecord()
copy_lrecord()
copy_sized_lrecord()
old_copy_lcrecord()
old_copy_sized_lcrecord()
old_zero_lcrecord()
old_zero_sized_lcrecord()
LISP_OBJECT_STORAGE_SIZE()
COPY_SIZED_LISP_OBJECT()
COPY_SIZED_LCRECORD()
COPY_LISP_OBJECT()
ZERO_LISP_OBJECT()
FREE_LISP_OBJECT()
(4) Catch the remaining places where lrecord stuff was used directly
and use the advertised interface, e.g. alloc_sized_lrecord() ->
ALLOC_SIZED_LISP_OBJECT().
(5) Make certain statically-declared pseudo-objects
(buffer_local_flags, console_local_flags) have their lheader
initialized correctly, so things like copy_lisp_object() can work
on them. Make extent_auxiliary_defaults a proper heap object
Vextent_auxiliary_defaults, and make extent auxiliaries dumpable
so that this object can be dumped. allocate_extent_auxiliary()
now just creates the object, and attach_extent_auxiliary()
creates an extent auxiliary and attaches to an extent, like the
old allocate_extent_auxiliary().
(6) Create EXTENT_AUXILIARY_SLOTS macro, similar to the foo-slots.h
files but in a macro instead of a file. The purpose is to avoid
duplication when iterating over all the slots in an extent auxiliary.
Use it.
(7) In lstream.c, don't zero out object after allocation because
allocation routines take care of this.
(8) In marker.c, fix a mistake in computing marker overhead.
(9) In print.c, clean up printing_unreadable_lcrecord(),
external_object_printer() to avoid lots of ifdef NEW_GC's.
(10) Separate toolbar-button allocation into a separate
allocate_toolbar_button() function for use in the example code
in lrecord.h.
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Fri, 05 Mar 2010 04:08:17 -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 */ |