Mercurial > hg > xemacs-beta
annotate src/fileio.c @ 4952:19a72041c5ed
Mule-izing, various fixes related to char * arguments
-------------------- ChangeLog entries follow: --------------------
modules/ChangeLog addition:
2010-01-26 Ben Wing <ben@xemacs.org>
* postgresql/postgresql.c:
* postgresql/postgresql.c (CHECK_LIVE_CONNECTION):
* postgresql/postgresql.c (print_pgresult):
* postgresql/postgresql.c (Fpq_conn_defaults):
* postgresql/postgresql.c (Fpq_connectdb):
* postgresql/postgresql.c (Fpq_connect_start):
* postgresql/postgresql.c (Fpq_result_status):
* postgresql/postgresql.c (Fpq_res_status):
Mule-ize large parts of it.
2010-01-26 Ben Wing <ben@xemacs.org>
* ldap/eldap.c (print_ldap):
* ldap/eldap.c (allocate_ldap):
Use write_ascstring().
src/ChangeLog addition:
2010-01-26 Ben Wing <ben@xemacs.org>
* alloc.c:
* alloc.c (build_ascstring):
* alloc.c (build_msg_cistring):
* alloc.c (staticpro_1):
* alloc.c (staticpro_name):
* alloc.c (staticpro_nodump_1):
* alloc.c (staticpro_nodump_name):
* alloc.c (unstaticpro_nodump_1):
* alloc.c (mcpro_1):
* alloc.c (mcpro_name):
* alloc.c (object_memory_usage_stats):
* alloc.c (common_init_alloc_early):
* alloc.c (init_alloc_once_early):
* buffer.c (print_buffer):
* buffer.c (vars_of_buffer):
* buffer.c (common_init_complex_vars_of_buffer):
* buffer.c (init_initial_directory):
* bytecode.c (invalid_byte_code):
* bytecode.c (print_compiled_function):
* bytecode.c (mark_compiled_function):
* chartab.c (print_table_entry):
* chartab.c (print_char_table):
* config.h.in:
* console-gtk.c:
* console-gtk.c (gtk_device_to_console_connection):
* console-gtk.c (gtk_semi_canonicalize_console_connection):
* console-gtk.c (gtk_canonicalize_console_connection):
* console-gtk.c (gtk_semi_canonicalize_device_connection):
* console-gtk.c (gtk_canonicalize_device_connection):
* console-stream.c (stream_init_frame_1):
* console-stream.c (vars_of_console_stream):
* console-stream.c (init_console_stream):
* console-x.c (x_semi_canonicalize_console_connection):
* console-x.c (x_semi_canonicalize_device_connection):
* console-x.c (x_canonicalize_device_connection):
* console-x.h:
* data.c (eq_with_ebola_notice):
* data.c (Fsubr_interactive):
* data.c (Fnumber_to_string):
* data.c (digit_to_number):
* device-gtk.c (gtk_init_device):
* device-msw.c (print_devmode):
* device-x.c (x_event_name):
* dialog-msw.c (handle_directory_dialog_box):
* dialog-msw.c (handle_file_dialog_box):
* dialog-msw.c (vars_of_dialog_mswindows):
* doc.c (weird_doc):
* doc.c (Fsnarf_documentation):
* doc.c (vars_of_doc):
* dumper.c (pdump):
* dynarr.c:
* dynarr.c (Dynarr_realloc):
* editfns.c (Fuser_real_login_name):
* editfns.c (get_home_directory):
* elhash.c (print_hash_table_data):
* elhash.c (print_hash_table):
* emacs.c (main_1):
* emacs.c (vars_of_emacs):
* emodules.c:
* emodules.c (_emodules_list):
* emodules.c (Fload_module):
* emodules.c (Funload_module):
* emodules.c (Flist_modules):
* emodules.c (find_make_module):
* emodules.c (attempt_module_delete):
* emodules.c (emodules_load):
* emodules.c (emodules_doc_subr):
* emodules.c (emodules_doc_sym):
* emodules.c (syms_of_module):
* emodules.c (vars_of_module):
* emodules.h:
* eval.c (print_subr):
* eval.c (signal_call_debugger):
* eval.c (build_error_data):
* eval.c (signal_error):
* eval.c (maybe_signal_error):
* eval.c (signal_continuable_error):
* eval.c (maybe_signal_continuable_error):
* eval.c (signal_error_2):
* eval.c (maybe_signal_error_2):
* eval.c (signal_continuable_error_2):
* eval.c (maybe_signal_continuable_error_2):
* eval.c (signal_ferror):
* eval.c (maybe_signal_ferror):
* eval.c (signal_continuable_ferror):
* eval.c (maybe_signal_continuable_ferror):
* eval.c (signal_ferror_with_frob):
* eval.c (maybe_signal_ferror_with_frob):
* eval.c (signal_continuable_ferror_with_frob):
* eval.c (maybe_signal_continuable_ferror_with_frob):
* eval.c (syntax_error):
* eval.c (syntax_error_2):
* eval.c (maybe_syntax_error):
* eval.c (sferror):
* eval.c (sferror_2):
* eval.c (maybe_sferror):
* eval.c (invalid_argument):
* eval.c (invalid_argument_2):
* eval.c (maybe_invalid_argument):
* eval.c (invalid_constant):
* eval.c (invalid_constant_2):
* eval.c (maybe_invalid_constant):
* eval.c (invalid_operation):
* eval.c (invalid_operation_2):
* eval.c (maybe_invalid_operation):
* eval.c (invalid_change):
* eval.c (invalid_change_2):
* eval.c (maybe_invalid_change):
* eval.c (invalid_state):
* eval.c (invalid_state_2):
* eval.c (maybe_invalid_state):
* eval.c (wtaerror):
* eval.c (stack_overflow):
* eval.c (out_of_memory):
* eval.c (print_multiple_value):
* eval.c (issue_call_trapping_problems_warning):
* eval.c (backtrace_specials):
* eval.c (backtrace_unevalled_args):
* eval.c (Fbacktrace):
* eval.c (warn_when_safe):
* event-Xt.c (modwarn):
* event-Xt.c (modbarf):
* event-Xt.c (check_modifier):
* event-Xt.c (store_modifier):
* event-Xt.c (emacs_Xt_format_magic_event):
* event-Xt.c (describe_event):
* event-gtk.c (dragndrop_data_received):
* event-gtk.c (store_modifier):
* event-gtk.c (gtk_reset_modifier_mapping):
* event-msw.c (dde_eval_string):
* event-msw.c (Fdde_alloc_advise_item):
* event-msw.c (mswindows_dde_callback):
* event-msw.c (FROB):
* event-msw.c (emacs_mswindows_format_magic_event):
* event-stream.c (external_debugging_print_event):
* event-stream.c (execute_help_form):
* event-stream.c (vars_of_event_stream):
* events.c (print_event_1):
* events.c (print_event):
* events.c (event_equal):
* extents.c (print_extent_1):
* extents.c (print_extent):
* extents.c (vars_of_extents):
* faces.c (print_face):
* faces.c (complex_vars_of_faces):
* file-coding.c:
* file-coding.c (print_coding_system):
* file-coding.c (print_coding_system_in_print_method):
* file-coding.c (default_query_method):
* file-coding.c (find_coding_system):
* file-coding.c (make_coding_system_1):
* file-coding.c (chain_print):
* file-coding.c (undecided_print):
* file-coding.c (gzip_print):
* file-coding.c (vars_of_file_coding):
* file-coding.c (complex_vars_of_file_coding):
* fileio.c:
* fileio.c (report_file_type_error):
* fileio.c (report_error_with_errno):
* fileio.c (report_file_error):
* fileio.c (barf_or_query_if_file_exists):
* fileio.c (vars_of_fileio):
* floatfns.c (matherr):
* fns.c (print_bit_vector):
* fns.c (Fmapconcat):
* fns.c (add_suffix_to_symbol):
* fns.c (add_prefix_to_symbol):
* frame-gtk.c:
* frame-gtk.c (Fgtk_window_id):
* frame-x.c (def):
* frame-x.c (x_cde_transfer_callback):
* frame.c:
* frame.c (Fmake_frame):
* gc.c (show_gc_cursor_and_message):
* gc.c (vars_of_gc):
* glyphs-eimage.c (png_instantiate):
* glyphs-eimage.c (tiff_instantiate):
* glyphs-gtk.c (gtk_print_image_instance):
* glyphs-msw.c (mswindows_print_image_instance):
* glyphs-x.c (x_print_image_instance):
* glyphs-x.c (update_widget_face):
* glyphs.c (make_string_from_file):
* glyphs.c (print_image_instance):
* glyphs.c (signal_image_error):
* glyphs.c (signal_image_error_2):
* glyphs.c (signal_double_image_error):
* glyphs.c (signal_double_image_error_2):
* glyphs.c (xbm_mask_file_munging):
* glyphs.c (pixmap_to_lisp_data):
* glyphs.h:
* gui.c (gui_item_display_flush_left):
* hpplay.c (player_error_internal):
* hpplay.c (myHandler):
* intl-win32.c:
* intl-win32.c (langcode_to_lang):
* intl-win32.c (sublangcode_to_lang):
* intl-win32.c (Fmswindows_get_locale_info):
* intl-win32.c (lcid_to_locale_mule_or_no):
* intl-win32.c (mswindows_multibyte_to_unicode_print):
* intl-win32.c (complex_vars_of_intl_win32):
* keymap.c:
* keymap.c (print_keymap):
* keymap.c (ensure_meta_prefix_char_keymapp):
* keymap.c (Fkey_description):
* keymap.c (Ftext_char_description):
* lisp.h:
* lisp.h (struct):
* lisp.h (DECLARE_INLINE_HEADER):
* lread.c (Fload_internal):
* lread.c (locate_file):
* lread.c (read_escape):
* lread.c (read_raw_string):
* lread.c (read1):
* lread.c (read_list):
* lread.c (read_compiled_function):
* lread.c (init_lread):
* lrecord.h:
* marker.c (print_marker):
* marker.c (marker_equal):
* menubar-msw.c (displayable_menu_item):
* menubar-x.c (command_builder_operate_menu_accelerator):
* menubar.c (vars_of_menubar):
* minibuf.c (reinit_complex_vars_of_minibuf):
* minibuf.c (complex_vars_of_minibuf):
* mule-charset.c (Fmake_charset):
* mule-charset.c (complex_vars_of_mule_charset):
* mule-coding.c (iso2022_print):
* mule-coding.c (fixed_width_query):
* number.c (bignum_print):
* number.c (ratio_print):
* number.c (bigfloat_print):
* number.c (bigfloat_finalize):
* objects-msw.c:
* objects-msw.c (mswindows_color_to_string):
* objects-msw.c (mswindows_color_list):
* objects-tty.c:
* objects-tty.c (tty_font_list):
* objects-tty.c (tty_find_charset_font):
* objects-xlike-inc.c (xft_find_charset_font):
* objects-xlike-inc.c (endif):
* print.c:
* print.c (write_istring):
* print.c (write_ascstring):
* print.c (Fterpri):
* print.c (Fprint):
* print.c (print_error_message):
* print.c (print_vector_internal):
* print.c (print_cons):
* print.c (print_string):
* print.c (printing_unreadable_object):
* print.c (print_internal):
* print.c (print_float):
* print.c (print_symbol):
* process-nt.c (mswindows_report_winsock_error):
* process-nt.c (nt_canonicalize_host_name):
* process-unix.c (unix_canonicalize_host_name):
* process.c (print_process):
* process.c (report_process_error):
* process.c (report_network_error):
* process.c (make_process_internal):
* process.c (Fstart_process_internal):
* process.c (status_message):
* process.c (putenv_internal):
* process.c (vars_of_process):
* process.h:
* profile.c (vars_of_profile):
* rangetab.c (print_range_table):
* realpath.c (vars_of_realpath):
* redisplay.c (vars_of_redisplay):
* search.c (wordify):
* search.c (Freplace_match):
* sheap.c (sheap_adjust_h):
* sound.c (report_sound_error):
* sound.c (Fplay_sound_file):
* specifier.c (print_specifier):
* symbols.c (Fsubr_name):
* symbols.c (do_symval_forwarding):
* symbols.c (set_default_buffer_slot_variable):
* symbols.c (set_default_console_slot_variable):
* symbols.c (store_symval_forwarding):
* symbols.c (default_value):
* symbols.c (defsymbol_massage_name_1):
* symbols.c (defsymbol_massage_name_nodump):
* symbols.c (defsymbol_massage_name):
* symbols.c (defsymbol_massage_multiword_predicate_nodump):
* symbols.c (defsymbol_massage_multiword_predicate):
* symbols.c (defsymbol_nodump):
* symbols.c (defsymbol):
* symbols.c (defkeyword):
* symbols.c (defkeyword_massage_name):
* symbols.c (check_module_subr):
* symbols.c (deferror_1):
* symbols.c (deferror):
* symbols.c (deferror_massage_name):
* symbols.c (deferror_massage_name_and_message):
* symbols.c (defvar_magic):
* symeval.h:
* symeval.h (DEFVAR_SYMVAL_FWD):
* sysdep.c:
* sysdep.c (init_system_name):
* sysdll.c:
* sysdll.c (MAYBE_PREPEND_UNDERSCORE):
* sysdll.c (dll_function):
* sysdll.c (dll_variable):
* sysdll.c (dll_error):
* sysdll.c (dll_open):
* sysdll.c (dll_close):
* sysdll.c (image_for_address):
* sysdll.c (my_find_image):
* sysdll.c (search_linked_libs):
* sysdll.h:
* sysfile.h:
* sysfile.h (DEFAULT_DIRECTORY_FALLBACK):
* syswindows.h:
* tests.c (DFC_CHECK_LENGTH):
* tests.c (DFC_CHECK_CONTENT):
* tests.c (Ftest_hash_tables):
* text.c (vars_of_text):
* text.h:
* tooltalk.c (tt_opnum_string):
* tooltalk.c (tt_message_arg_ival_string):
* tooltalk.c (Ftooltalk_default_procid):
* tooltalk.c (Ftooltalk_default_session):
* tooltalk.c (init_tooltalk):
* tooltalk.c (vars_of_tooltalk):
* ui-gtk.c (Fdll_load):
* ui-gtk.c (type_to_marshaller_type):
* ui-gtk.c (Fgtk_import_function_internal):
* ui-gtk.c (emacs_gtk_object_printer):
* ui-gtk.c (emacs_gtk_boxed_printer):
* unicode.c (unicode_to_ichar):
* unicode.c (unicode_print):
* unicode.c (unicode_query):
* unicode.c (vars_of_unicode):
* unicode.c (complex_vars_of_unicode):
* win32.c:
* win32.c (mswindows_report_process_error):
* window.c (print_window):
* xemacs.def.in.in:
BASIC IDEA: Further fixing up uses of char * and CIbyte *
to reflect their actual semantics; Mule-izing some code;
redoing of the not-yet-working code to handle message translation.
Clean up code to handle message-translation (not yet working).
Create separate versions of build_msg_string() for working with
Ibyte *, CIbyte *, and Ascbyte * arguments. Assert that Ascbyte *
arguments are pure-ASCII. Make build_msg_string() be the same
as build_msg_ascstring(). Create same three versions of GETTEXT()
and DEFER_GETTEXT(). Also create build_defer_string() and
variants for the equivalent of DEFER_GETTEXT() when building a
string. Remove old CGETTEXT(). Clean up code where GETTEXT(),
DEFER_GETTEXT(), build_msg_string(), etc. was being called and
introduce some new calls to build_msg_string(), etc. Remove
GETTEXT() from calls to weird_doc() -- we assume that the
message snarfer knows about weird_doc(). Remove uses of
DEFER_GETTEXT() from error messages in sysdep.c and instead use
special comments /* @@@begin-snarf@@@ */ and /* @@@end-snarf@@@ */
that the message snarfer presumably knows about.
Create build_ascstring() and use it in many instances in place
of build_string(). The purpose of having Ascbyte * variants is
to make the code more self-documenting in terms of what sort of
semantics is expected for char * strings. In fact in the process
of looking for uses of build_string(), much improperly Mule-ized
was discovered.
Mule-ize a lot of code as described in previous paragraph,
e.g. in sysdep.c.
Make the error functions take Ascbyte * strings and fix up a
couple of places where non-pure-ASCII strings were being passed in
(file-coding.c, mule-coding.c, unicode.c). (It's debatable whether
we really need to make the error functions work this way. It
helps catch places where code is written in a way that message
translation won't work, but we may well never implement message
translation.)
Make staticpro() and friends take Ascbyte * strings instead of
raw char * strings. Create a const_Ascbyte_ptr dynarr type
to describe what's held by staticpro_names[] and friends,
create pdump descriptions for const_Ascbyte_ptr dynarrs, and
use them in place of specially-crafted staticpro descriptions.
Mule-ize certain other functions (e.g. x_event_name) by correcting
raw use of char * to Ascbyte *, Rawbyte * or another such type,
and raw use of char[] buffers to another type (usually Ascbyte[]).
Change many uses of write_c_string() to write_msg_string(),
write_ascstring(), etc.
Mule-ize emodules.c, emodules.h, sysdll.h.
Fix some un-Mule-ized code in intl-win32.c.
A comment in event-Xt.c and the limitations of the message
snarfer (make-msgfile or whatever) is presumably incorrect --
it should be smart enough to handle function calls spread over
more than one line. Clean up code in event-Xt.c that was
written awkwardly for this reason.
In config.h.in, instead of NEED_ERROR_CHECK_TYPES_INLINES,
create a more general XEMACS_DEFS_NEEDS_INLINE_DECLS to
indicate when inlined functions need to be declared in
xemacs.defs.in.in, and make use of it in xemacs.defs.in.in.
We need to do this because postgresql.c now calls qxestrdup(),
which is an inline function.
Make nconc2() and other such functions MODULE_API and put
them in xemacs.defs.in.in since postgresql.c now uses them.
Clean up indentation in lread.c and a few other places.
In text.h, document ASSERT_ASCTEXT_ASCII() and
ASSERT_ASCTEXT_ASCII_LEN(), group together the stand-in
encodings and add some more for DLL symbols, function and
variable names, etc.
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Tue, 26 Jan 2010 23:22:30 -0600 |
| parents | 7822019c5d98 |
| children | 304aebb79cd3 |
| rev | line source |
|---|---|
| 428 | 1 /* File IO for XEmacs. |
| 2 Copyright (C) 1985-1988, 1992-1995 Free Software Foundation, Inc. | |
|
4834
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
3 Copyright (C) 1996, 2001, 2002, 2003, 2004, 2010 Ben Wing. |
| 428 | 4 |
| 5 This file is part of XEmacs. | |
| 6 | |
| 7 XEmacs is free software; you can redistribute it and/or modify it | |
| 8 under the terms of the GNU General Public License as published by the | |
| 9 Free Software Foundation; either version 2, or (at your option) any | |
| 10 later version. | |
| 11 | |
| 12 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 15 for more details. | |
| 16 | |
| 17 You should have received a copy of the GNU General Public License | |
| 18 along with XEmacs; see the file COPYING. If not, write to | |
| 19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
| 20 Boston, MA 02111-1307, USA. */ | |
| 21 | |
| 22 /* Synched up with: Mule 2.0, FSF 19.30. */ | |
| 771 | 23 /* More syncing: FSF Emacs 19.34.6 by Marc Paquette <marcpa@cam.org> |
| 24 (Note: Sync messages from Marc Paquette may indicate | |
| 25 incomplete synching, so beware.) */ | |
| 2526 | 26 /* Some functions synched with FSF 21.0.103. */ |
| 771 | 27 /* Mule-ized completely except for the #if 0-code including decrypt-string |
| 28 and encrypt-string. --ben 7-2-00 */ | |
| 1333 | 29 /* #if 0-code Mule-ized, 2-22-03. --ben */ |
| 771 | 30 |
| 428 | 31 |
| 32 #include <config.h> | |
| 33 #include "lisp.h" | |
| 34 | |
| 35 #include "buffer.h" | |
| 800 | 36 #include "device.h" |
| 428 | 37 #include "events.h" |
| 800 | 38 #include "file-coding.h" |
| 428 | 39 #include "frame.h" |
| 40 #include "insdel.h" | |
| 41 #include "lstream.h" | |
| 2526 | 42 #include "profile.h" |
| 872 | 43 #include "process.h" |
| 428 | 44 #include "redisplay.h" |
| 45 #include "sysdep.h" | |
| 872 | 46 #include "window-impl.h" |
| 771 | 47 |
| 428 | 48 #include "sysfile.h" |
| 49 #include "sysproc.h" | |
| 50 #include "syspwd.h" | |
| 51 #include "systime.h" | |
| 52 #include "sysdir.h" | |
| 53 | |
| 54 #ifdef HPUX | |
| 55 #include <netio.h> | |
| 56 #endif /* HPUX */ | |
| 57 | |
| 1315 | 58 #ifdef WIN32_ANY |
| 657 | 59 #define WIN32_FILENAMES |
| 771 | 60 #include "syswindows.h" |
| 428 | 61 #define IS_DRIVE(x) isalpha (x) |
| 62 /* Need to lower-case the drive letter, or else expanded | |
| 63 filenames will sometimes compare inequal, because | |
| 64 `expand-file-name' doesn't always down-case the drive letter. */ | |
| 65 #define DRIVE_LETTER(x) tolower (x) | |
| 657 | 66 #endif /* WIN32_NATIVE || CYGWIN */ |
| 428 | 67 |
| 68 int lisp_to_time (Lisp_Object, time_t *); | |
| 69 Lisp_Object time_to_lisp (time_t); | |
| 70 | |
| 71 /* Nonzero during writing of auto-save files */ | |
| 72 static int auto_saving; | |
| 73 | |
| 74 /* Set by auto_save_1 to mode of original file so Fwrite_region_internal | |
| 75 will create a new file with the same mode as the original */ | |
| 76 static int auto_save_mode_bits; | |
| 77 | |
| 78 /* Alist of elements (REGEXP . HANDLER) for file names | |
| 79 whose I/O is done with a special handler. */ | |
| 80 Lisp_Object Vfile_name_handler_alist; | |
| 81 | |
| 82 /* Format for auto-save files */ | |
| 83 Lisp_Object Vauto_save_file_format; | |
| 84 | |
| 85 /* Lisp functions for translating file formats */ | |
| 86 Lisp_Object Qformat_decode, Qformat_annotate_function; | |
| 87 | |
| 88 /* Functions to be called to process text properties in inserted file. */ | |
| 89 Lisp_Object Vafter_insert_file_functions; | |
| 90 | |
| 91 /* Functions to be called to create text property annotations for file. */ | |
| 92 Lisp_Object Vwrite_region_annotate_functions; | |
| 93 | |
| 94 /* During build_annotations, each time an annotation function is called, | |
| 95 this holds the annotations made by the previous functions. */ | |
| 96 Lisp_Object Vwrite_region_annotations_so_far; | |
| 97 | |
| 98 /* File name in which we write a list of all our auto save files. */ | |
| 99 Lisp_Object Vauto_save_list_file_name; | |
| 100 | |
| 444 | 101 /* Prefix used to construct Vauto_save_list_file_name. */ |
| 102 Lisp_Object Vauto_save_list_file_prefix; | |
| 103 | |
| 104 /* When non-nil, it prevents auto-save list file creation. */ | |
| 105 int inhibit_auto_save_session; | |
| 106 | |
| 428 | 107 int disable_auto_save_when_buffer_shrinks; |
| 108 | |
| 109 Lisp_Object Vdirectory_sep_char; | |
| 110 | |
|
4499
eb82259f265d
Port write-region-inhibit-sync, allowing avoidance of bad FS performance.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4465
diff
changeset
|
111 #ifdef HAVE_FSYNC |
|
eb82259f265d
Port write-region-inhibit-sync, allowing avoidance of bad FS performance.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4465
diff
changeset
|
112 /* Nonzero means skip the call to fsync in Fwrite-region. */ |
|
eb82259f265d
Port write-region-inhibit-sync, allowing avoidance of bad FS performance.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4465
diff
changeset
|
113 int write_region_inhibit_fsync; |
|
eb82259f265d
Port write-region-inhibit-sync, allowing avoidance of bad FS performance.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4465
diff
changeset
|
114 #endif |
|
eb82259f265d
Port write-region-inhibit-sync, allowing avoidance of bad FS performance.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4465
diff
changeset
|
115 |
| 428 | 116 /* These variables describe handlers that have "already" had a chance |
| 117 to handle the current operation. | |
| 118 | |
| 119 Vinhibit_file_name_handlers is a list of file name handlers. | |
| 120 Vinhibit_file_name_operation is the operation being handled. | |
| 121 If we try to handle that operation, we ignore those handlers. */ | |
| 122 | |
| 123 static Lisp_Object Vinhibit_file_name_handlers; | |
| 124 static Lisp_Object Vinhibit_file_name_operation; | |
| 125 | |
| 563 | 126 Lisp_Object Qfile_already_exists; |
| 4266 | 127 Lisp_Object Qexcl; |
| 428 | 128 |
| 129 Lisp_Object Qauto_save_hook; | |
| 130 Lisp_Object Qauto_save_error; | |
| 131 Lisp_Object Qauto_saving; | |
| 132 | |
| 133 Lisp_Object Qcar_less_than_car; | |
| 134 | |
| 135 Lisp_Object Qcompute_buffer_file_truename; | |
| 136 | |
| 2526 | 137 Lisp_Object QSin_expand_file_name; |
| 138 | |
| 428 | 139 EXFUN (Frunning_temacs_p, 0); |
| 140 | |
| 563 | 141 /* DATA can be anything acceptable to signal_error (). |
| 142 */ | |
| 143 | |
| 144 DOESNT_RETURN | |
| 145 report_file_type_error (Lisp_Object errtype, Lisp_Object oserrmess, | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4867
diff
changeset
|
146 const Ascbyte *reason, Lisp_Object data) |
| 563 | 147 { |
| 148 struct gcpro gcpro1; | |
| 149 Lisp_Object errdata = build_error_data (NULL, data); | |
| 150 | |
| 151 GCPRO1 (errdata); | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4867
diff
changeset
|
152 errdata = Fcons (build_msg_string (reason), |
| 563 | 153 Fcons (oserrmess, errdata)); |
| 154 signal_error_1 (errtype, errdata); | |
| 801 | 155 /* UNGCPRO; not reached */ |
| 563 | 156 } |
| 157 | |
| 158 DOESNT_RETURN | |
| 159 report_error_with_errno (Lisp_Object errtype, | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4867
diff
changeset
|
160 const Ascbyte *reason, Lisp_Object data) |
| 563 | 161 { |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4867
diff
changeset
|
162 report_file_type_error (errtype, lisp_strerror (errno), reason, data); |
| 563 | 163 } |
| 164 | |
| 428 | 165 /* signal a file error when errno contains a meaningful value. */ |
| 166 | |
| 167 DOESNT_RETURN | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4867
diff
changeset
|
168 report_file_error (const Ascbyte *reason, Lisp_Object data) |
| 428 | 169 { |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4867
diff
changeset
|
170 report_error_with_errno (Qfile_error, reason, data); |
| 428 | 171 } |
| 172 | |
| 173 | |
| 174 /* Just like strerror(3), except return a lisp string instead of char *. | |
| 175 The string needs to be converted since it may be localized. | |
| 771 | 176 */ |
| 428 | 177 Lisp_Object |
| 178 lisp_strerror (int errnum) | |
| 179 { | |
| 771 | 180 Extbyte *ret = strerror (errnum); |
| 181 if (!ret) | |
| 182 { | |
| 867 | 183 Ibyte ffff[99]; |
| 771 | 184 qxesprintf (ffff, "Unknown error %d", errnum); |
| 185 return build_intstring (ffff); | |
| 186 } | |
| 187 return build_ext_string (ret, Qstrerror_encoding); | |
| 428 | 188 } |
| 189 | |
| 190 static Lisp_Object | |
| 191 close_file_unwind (Lisp_Object fd) | |
| 192 { | |
| 193 if (CONSP (fd)) | |
| 194 { | |
| 195 if (INTP (XCAR (fd))) | |
| 771 | 196 retry_close (XINT (XCAR (fd))); |
| 428 | 197 |
| 853 | 198 free_cons (fd); |
| 428 | 199 } |
| 200 else | |
| 771 | 201 retry_close (XINT (fd)); |
| 428 | 202 |
| 203 return Qnil; | |
| 204 } | |
| 205 | |
| 206 static Lisp_Object | |
| 207 delete_stream_unwind (Lisp_Object stream) | |
| 208 { | |
| 209 Lstream_delete (XLSTREAM (stream)); | |
| 210 return Qnil; | |
| 211 } | |
| 212 | |
| 213 /* Restore point, having saved it as a marker. */ | |
| 214 | |
| 215 static Lisp_Object | |
| 216 restore_point_unwind (Lisp_Object point_marker) | |
| 217 { | |
| 218 BUF_SET_PT (current_buffer, marker_position (point_marker)); | |
| 219 return Fset_marker (point_marker, Qnil, Qnil); | |
| 220 } | |
| 221 | |
| 222 | |
| 223 Lisp_Object Qexpand_file_name; | |
| 224 Lisp_Object Qfile_truename; | |
| 225 Lisp_Object Qsubstitute_in_file_name; | |
| 226 Lisp_Object Qdirectory_file_name; | |
| 227 Lisp_Object Qfile_name_directory; | |
| 228 Lisp_Object Qfile_name_nondirectory; | |
| 996 | 229 Lisp_Object Qfile_name_sans_extension; |
| 428 | 230 Lisp_Object Qunhandled_file_name_directory; |
| 231 Lisp_Object Qfile_name_as_directory; | |
| 232 Lisp_Object Qcopy_file; | |
| 233 Lisp_Object Qmake_directory_internal; | |
| 234 Lisp_Object Qdelete_directory; | |
| 235 Lisp_Object Qdelete_file; | |
| 236 Lisp_Object Qrename_file; | |
| 237 Lisp_Object Qadd_name_to_file; | |
| 238 Lisp_Object Qmake_symbolic_link; | |
| 844 | 239 Lisp_Object Qmake_temp_name; |
| 428 | 240 Lisp_Object Qfile_exists_p; |
| 241 Lisp_Object Qfile_executable_p; | |
| 242 Lisp_Object Qfile_readable_p; | |
| 243 Lisp_Object Qfile_symlink_p; | |
| 244 Lisp_Object Qfile_writable_p; | |
| 245 Lisp_Object Qfile_directory_p; | |
| 246 Lisp_Object Qfile_regular_p; | |
| 247 Lisp_Object Qfile_accessible_directory_p; | |
| 248 Lisp_Object Qfile_modes; | |
| 249 Lisp_Object Qset_file_modes; | |
| 250 Lisp_Object Qfile_newer_than_file_p; | |
| 251 Lisp_Object Qinsert_file_contents; | |
| 252 Lisp_Object Qwrite_region; | |
| 253 Lisp_Object Qverify_visited_file_modtime; | |
| 254 Lisp_Object Qset_visited_file_modtime; | |
| 255 | |
| 256 /* If FILENAME is handled specially on account of its syntax, | |
| 257 return its handler function. Otherwise, return nil. */ | |
| 258 | |
| 259 DEFUN ("find-file-name-handler", Ffind_file_name_handler, 1, 2, 0, /* | |
| 260 Return FILENAME's handler function for OPERATION, if it has one. | |
| 261 Otherwise, return nil. | |
| 262 A file name is handled if one of the regular expressions in | |
| 263 `file-name-handler-alist' matches it. | |
| 264 | |
| 265 If OPERATION equals `inhibit-file-name-operation', then we ignore | |
| 266 any handlers that are members of `inhibit-file-name-handlers', | |
| 267 but we still do run any other handlers. This lets handlers | |
| 268 use the standard functions without calling themselves recursively. | |
| 751 | 269 |
| 270 Otherwise, OPERATION is the name of a funcall'able function. | |
| 428 | 271 */ |
| 272 (filename, operation)) | |
| 273 { | |
| 274 /* This function does not GC */ | |
| 275 /* This function can be called during GC */ | |
| 276 /* This function must not munge the match data. */ | |
| 2367 | 277 Lisp_Object inhibited_handlers; |
| 428 | 278 |
| 279 CHECK_STRING (filename); | |
| 280 | |
| 281 if (EQ (operation, Vinhibit_file_name_operation)) | |
| 282 inhibited_handlers = Vinhibit_file_name_handlers; | |
| 283 else | |
| 284 inhibited_handlers = Qnil; | |
| 285 | |
| 2367 | 286 { |
| 287 EXTERNAL_LIST_LOOP_2 (elt, Vfile_name_handler_alist) | |
| 288 { | |
| 289 if (CONSP (elt)) | |
| 290 { | |
| 291 Lisp_Object string = XCAR (elt); | |
| 292 if (STRINGP (string) | |
| 293 && (fast_lisp_string_match (string, filename) >= 0)) | |
| 294 { | |
| 295 Lisp_Object handler = XCDR (elt); | |
| 296 if (NILP (Fmemq (handler, inhibited_handlers))) | |
| 297 return handler; | |
| 298 } | |
| 299 } | |
| 300 } | |
| 301 } | |
| 428 | 302 return Qnil; |
| 303 } | |
| 304 | |
| 305 static Lisp_Object | |
| 306 call2_check_string (Lisp_Object fn, Lisp_Object arg0, Lisp_Object arg1) | |
| 307 { | |
| 308 /* This function can call lisp */ | |
| 309 Lisp_Object result = call2 (fn, arg0, arg1); | |
| 310 CHECK_STRING (result); | |
| 311 return result; | |
| 312 } | |
| 313 | |
| 314 static Lisp_Object | |
| 315 call2_check_string_or_nil (Lisp_Object fn, Lisp_Object arg0, Lisp_Object arg1) | |
| 316 { | |
| 317 /* This function can call lisp */ | |
| 318 Lisp_Object result = call2 (fn, arg0, arg1); | |
| 319 if (!NILP (result)) | |
| 320 CHECK_STRING (result); | |
| 321 return result; | |
| 322 } | |
| 323 | |
| 324 static Lisp_Object | |
| 325 call3_check_string (Lisp_Object fn, Lisp_Object arg0, | |
| 326 Lisp_Object arg1, Lisp_Object arg2) | |
| 327 { | |
| 328 /* This function can call lisp */ | |
| 329 Lisp_Object result = call3 (fn, arg0, arg1, arg2); | |
| 330 CHECK_STRING (result); | |
| 331 return result; | |
| 332 } | |
| 333 | |
| 334 | |
| 2526 | 335 |
| 336 Ibyte * | |
| 337 find_end_of_directory_component (const Ibyte *path, Bytecount len) | |
| 338 { | |
| 339 const Ibyte *p = path + len; | |
| 340 | |
| 341 while (p != path && !IS_DIRECTORY_SEP (p[-1]) | |
| 342 #ifdef WIN32_FILENAMES | |
| 343 /* only recognise drive specifier at the beginning */ | |
| 344 && !(p[-1] == ':' | |
| 345 /* handle the "/:d:foo" and "/:foo" cases correctly */ | |
| 346 && ((p == path + 2 && !IS_DIRECTORY_SEP (*path)) | |
| 347 || (p == path + 4 && IS_DIRECTORY_SEP (*path)))) | |
| 348 #endif | |
| 349 ) p--; | |
| 350 | |
| 351 return (Ibyte *) p; | |
| 352 } | |
| 353 | |
| 428 | 354 DEFUN ("file-name-directory", Ffile_name_directory, 1, 1, 0, /* |
| 444 | 355 Return the directory component in file name FILENAME. |
| 356 Return nil if FILENAME does not include a directory. | |
| 428 | 357 Otherwise return a directory spec. |
| 358 Given a Unix syntax file name, returns a string ending in slash. | |
| 359 */ | |
| 444 | 360 (filename)) |
| 428 | 361 { |
| 442 | 362 /* This function can GC. GC checked 2000-07-28 ben */ |
| 771 | 363 /* This function synched with Emacs 21.0.103. */ |
| 867 | 364 Ibyte *beg; |
| 365 Ibyte *p; | |
| 428 | 366 Lisp_Object handler; |
| 367 | |
| 444 | 368 CHECK_STRING (filename); |
| 428 | 369 |
| 370 /* If the file name has special constructs in it, | |
| 371 call the corresponding file handler. */ | |
| 444 | 372 handler = Ffind_file_name_handler (filename, Qfile_name_directory); |
| 428 | 373 if (!NILP (handler)) |
| 444 | 374 return call2_check_string_or_nil (handler, Qfile_name_directory, filename); |
| 428 | 375 |
| 376 #ifdef FILE_SYSTEM_CASE | |
| 444 | 377 filename = FILE_SYSTEM_CASE (filename); |
| 428 | 378 #endif |
| 444 | 379 beg = XSTRING_DATA (filename); |
| 771 | 380 /* XEmacs: no need to alloca-copy here */ |
| 2526 | 381 p = find_end_of_directory_component (beg, XSTRING_LENGTH (filename)); |
| 428 | 382 |
| 383 if (p == beg) | |
| 384 return Qnil; | |
| 442 | 385 #ifdef WIN32_NATIVE |
| 428 | 386 /* Expansion of "c:" to drive and default directory. */ |
| 771 | 387 if (p[-1] == ':') |
| 428 | 388 { |
| 867 | 389 Ibyte *res; |
| 390 Ibyte *wd = mswindows_getdcwd (toupper (*beg) - 'A' + 1); | |
| 771 | 391 |
| 2367 | 392 res = alloca_ibytes ((wd ? qxestrlen (wd) : 0) + 10); /* go overboard */ |
| 1116 | 393 res[0] = '\0'; |
| 771 | 394 if (p == beg + 4 && IS_DIRECTORY_SEP (*beg) && beg[1] == ':') |
| 395 { | |
| 396 qxestrncpy (res, beg, 2); | |
| 397 beg += 2; | |
| 1116 | 398 res[2] = '\0'; |
| 771 | 399 } |
| 400 | |
| 401 if (wd) | |
| 428 | 402 { |
| 3648 | 403 int size; |
| 771 | 404 qxestrcat (res, wd); |
| 3648 | 405 size = qxestrlen (res); |
| 406 if (!IS_DIRECTORY_SEP (res[size - 1])) | |
| 407 { | |
| 408 res[size] = DIRECTORY_SEP; | |
| 409 res[size + 1] = '\0'; | |
| 410 } | |
| 428 | 411 beg = res; |
| 771 | 412 p = beg + qxestrlen (beg); |
| 428 | 413 } |
| 3648 | 414 else |
| 415 { | |
| 416 return Qnil; | |
| 417 } | |
| 771 | 418 if (wd) |
| 1726 | 419 xfree (wd, Ibyte *); |
| 428 | 420 } |
| 771 | 421 |
| 422 #if 0 /* No! This screws up efs, which calls file-name-directory on URL's | |
| 423 and expects the slashes to be left alone. This is here because of | |
| 424 an analogous call in FSF 21. */ | |
| 425 { | |
| 426 Bytecount len = p - beg; | |
| 867 | 427 Ibyte *newbeg = alloca_ibytes (len + 1); |
| 771 | 428 |
| 429 qxestrncpy (newbeg, beg, len); | |
| 430 newbeg[len] = '\0'; | |
| 431 newbeg = mswindows_canonicalize_filename (newbeg); | |
| 1726 | 432 return build_intstring (newbeg); |
| 771 | 433 } |
| 434 #endif | |
| 435 #endif /* not WIN32_NATIVE */ | |
| 428 | 436 return make_string (beg, p - beg); |
| 437 } | |
| 438 | |
| 439 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory, 1, 1, 0, /* | |
| 444 | 440 Return file name FILENAME sans its directory. |
| 428 | 441 For example, in a Unix-syntax file name, |
| 442 this is everything after the last slash, | |
| 443 or the entire name if it contains no slash. | |
| 444 */ | |
| 444 | 445 (filename)) |
| 428 | 446 { |
| 442 | 447 /* This function can GC. GC checked 2000-07-28 ben */ |
| 771 | 448 /* This function synched with Emacs 21.0.103. */ |
| 867 | 449 Ibyte *beg, *p, *end; |
| 428 | 450 Lisp_Object handler; |
| 451 | |
| 444 | 452 CHECK_STRING (filename); |
| 428 | 453 |
| 454 /* If the file name has special constructs in it, | |
| 455 call the corresponding file handler. */ | |
| 444 | 456 handler = Ffind_file_name_handler (filename, Qfile_name_nondirectory); |
| 428 | 457 if (!NILP (handler)) |
| 444 | 458 return call2_check_string (handler, Qfile_name_nondirectory, filename); |
| 459 | |
| 460 beg = XSTRING_DATA (filename); | |
| 461 end = p = beg + XSTRING_LENGTH (filename); | |
| 428 | 462 |
| 771 | 463 while (p != beg && !IS_DIRECTORY_SEP (p[-1]) |
| 657 | 464 #ifdef WIN32_FILENAMES |
| 771 | 465 /* only recognise drive specifier at beginning */ |
| 466 && !(p[-1] == ':' | |
| 467 /* handle the "/:d:foo" case correctly */ | |
| 468 && (p == beg + 2 || (p == beg + 4 && IS_DIRECTORY_SEP (*beg)))) | |
| 428 | 469 #endif |
| 771 | 470 ) |
| 471 p--; | |
| 428 | 472 |
| 473 return make_string (p, end - p); | |
| 474 } | |
| 475 | |
| 476 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory, 1, 1, 0, /* | |
| 477 Return a directly usable directory name somehow associated with FILENAME. | |
| 478 A `directly usable' directory name is one that may be used without the | |
| 479 intervention of any file handler. | |
| 480 If FILENAME is a directly usable file itself, return | |
| 481 \(file-name-directory FILENAME). | |
| 482 The `call-process' and `start-process' functions use this function to | |
| 483 get a current directory to run processes in. | |
| 484 */ | |
| 444 | 485 (filename)) |
| 428 | 486 { |
| 442 | 487 /* This function can GC. GC checked 2000-07-28 ben */ |
| 428 | 488 Lisp_Object handler; |
| 489 | |
| 490 /* If the file name has special constructs in it, | |
| 491 call the corresponding file handler. */ | |
| 492 handler = Ffind_file_name_handler (filename, Qunhandled_file_name_directory); | |
| 493 if (!NILP (handler)) | |
| 494 return call2 (handler, Qunhandled_file_name_directory, | |
| 495 filename); | |
| 496 | |
| 497 return Ffile_name_directory (filename); | |
| 498 } | |
| 499 | |
| 500 | |
| 867 | 501 static Ibyte * |
| 502 file_name_as_directory (Ibyte *out, Ibyte *in) | |
| 428 | 503 { |
| 442 | 504 /* This function cannot GC */ |
| 771 | 505 int size = qxestrlen (in); |
| 428 | 506 |
| 507 if (size == 0) | |
| 508 { | |
| 509 out[0] = '.'; | |
| 510 out[1] = DIRECTORY_SEP; | |
| 511 out[2] = '\0'; | |
| 512 } | |
| 513 else | |
| 514 { | |
| 771 | 515 qxestrcpy (out, in); |
| 428 | 516 /* Append a slash if necessary */ |
| 517 if (!IS_ANY_SEP (out[size-1])) | |
| 518 { | |
| 519 out[size] = DIRECTORY_SEP; | |
| 520 out[size + 1] = '\0'; | |
| 521 } | |
| 522 } | |
| 523 return out; | |
| 524 } | |
| 525 | |
| 526 DEFUN ("file-name-as-directory", Ffile_name_as_directory, 1, 1, 0, /* | |
| 527 Return a string representing file FILENAME interpreted as a directory. | |
| 528 This operation exists because a directory is also a file, but its name as | |
| 529 a directory is different from its name as a file. | |
| 530 The result can be used as the value of `default-directory' | |
| 531 or passed as second argument to `expand-file-name'. | |
| 532 For a Unix-syntax file name, just appends a slash, | |
| 533 except for (file-name-as-directory \"\") => \"./\". | |
| 534 */ | |
| 444 | 535 (filename)) |
| 428 | 536 { |
| 442 | 537 /* This function can GC. GC checked 2000-07-28 ben */ |
| 867 | 538 Ibyte *buf; |
| 428 | 539 Lisp_Object handler; |
| 540 | |
| 444 | 541 CHECK_STRING (filename); |
| 428 | 542 |
| 543 /* If the file name has special constructs in it, | |
| 544 call the corresponding file handler. */ | |
| 444 | 545 handler = Ffind_file_name_handler (filename, Qfile_name_as_directory); |
| 428 | 546 if (!NILP (handler)) |
| 444 | 547 return call2_check_string (handler, Qfile_name_as_directory, filename); |
| 548 | |
| 867 | 549 buf = alloca_ibytes (XSTRING_LENGTH (filename) + 10); |
| 2526 | 550 file_name_as_directory (buf, XSTRING_DATA (filename)); |
| 551 if (qxestrcmp (buf, XSTRING_DATA (filename))) | |
| 552 return build_intstring (buf); | |
| 553 else | |
| 554 return filename; | |
| 428 | 555 } |
| 556 | |
| 557 /* | |
| 558 * Convert from directory name to filename. | |
| 559 * On UNIX, it's simple: just make sure there isn't a terminating / | |
| 560 * | |
| 561 * Value is nonzero if the string output is different from the input. | |
| 562 */ | |
| 563 | |
| 564 static int | |
| 867 | 565 directory_file_name (const Ibyte *src, Ibyte *dst) |
| 428 | 566 { |
| 442 | 567 /* This function cannot GC */ |
| 771 | 568 long slen = qxestrlen (src); |
| 428 | 569 /* Process as Unix format: just remove any final slash. |
| 570 But leave "/" unchanged; do not change it to "". */ | |
| 771 | 571 qxestrcpy (dst, src); |
| 428 | 572 if (slen > 1 |
| 573 && IS_DIRECTORY_SEP (dst[slen - 1]) | |
| 657 | 574 #ifdef WIN32_FILENAMES |
| 428 | 575 && !IS_ANY_SEP (dst[slen - 2]) |
| 657 | 576 #endif /* WIN32_FILENAMES */ |
| 428 | 577 ) |
| 578 dst[slen - 1] = 0; | |
| 579 return 1; | |
| 580 } | |
| 581 | |
| 582 DEFUN ("directory-file-name", Fdirectory_file_name, 1, 1, 0, /* | |
| 444 | 583 Return the file name of the directory named DIRECTORY. |
| 584 This is the name of the file that holds the data for the directory. | |
| 428 | 585 This operation exists because a directory is also a file, but its name as |
| 586 a directory is different from its name as a file. | |
| 587 In Unix-syntax, this function just removes the final slash. | |
| 588 */ | |
| 589 (directory)) | |
| 590 { | |
| 442 | 591 /* This function can GC. GC checked 2000-07-28 ben */ |
| 867 | 592 Ibyte *buf; |
| 428 | 593 Lisp_Object handler; |
| 594 | |
| 595 CHECK_STRING (directory); | |
| 596 | |
| 597 #if 0 /* #### WTF? */ | |
| 598 if (NILP (directory)) | |
| 599 return Qnil; | |
| 600 #endif | |
| 601 | |
| 602 /* If the file name has special constructs in it, | |
| 603 call the corresponding file handler. */ | |
| 604 handler = Ffind_file_name_handler (directory, Qdirectory_file_name); | |
| 605 if (!NILP (handler)) | |
| 606 return call2_check_string (handler, Qdirectory_file_name, directory); | |
| 2367 | 607 buf = alloca_ibytes (XSTRING_LENGTH (directory) + 20); |
| 771 | 608 directory_file_name (XSTRING_DATA (directory), buf); |
| 609 return build_intstring (buf); | |
| 428 | 610 } |
| 611 | |
| 612 /* Fmake_temp_name used to be a simple wrapper around mktemp(), but it | |
| 613 proved too broken for our purposes (it supported only 26 or 62 | |
| 614 unique names under some implementations). For example, this | |
| 615 arbitrary limit broke generation of Gnus Incoming* files. | |
| 616 | |
| 617 This implementation is better than what one usually finds in libc. | |
| 618 --hniksic */ | |
| 619 | |
| 442 | 620 static unsigned int temp_name_rand; |
| 621 | |
| 428 | 622 DEFUN ("make-temp-name", Fmake_temp_name, 1, 1, 0, /* |
| 442 | 623 Generate a temporary file name starting with PREFIX. |
| 428 | 624 The Emacs process number forms part of the result, so there is no |
| 625 danger of generating a name being used by another process. | |
| 626 | |
| 627 In addition, this function makes an attempt to choose a name that | |
| 628 does not specify an existing file. To make this work, PREFIX should | |
| 4266 | 629 be an absolute file name. |
| 630 | |
| 631 This function is analagous to mktemp(3) under POSIX, and as with it, there | |
| 632 exists a race condition between the test for the existence of the new file | |
|
4383
1e04b9c8125b
Correct the make-temp-name docstring.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4324
diff
changeset
|
633 and its creation. See `make-temp-file' for a function which avoids this |
| 4266 | 634 race condition by specifying the appropriate flags to `write-region'. |
| 428 | 635 */ |
| 636 (prefix)) | |
| 637 { | |
| 442 | 638 static const char tbl[64] = |
| 639 { | |
| 428 | 640 'A','B','C','D','E','F','G','H', |
| 641 'I','J','K','L','M','N','O','P', | |
| 642 'Q','R','S','T','U','V','W','X', | |
| 643 'Y','Z','a','b','c','d','e','f', | |
| 644 'g','h','i','j','k','l','m','n', | |
| 645 'o','p','q','r','s','t','u','v', | |
| 646 'w','x','y','z','0','1','2','3', | |
| 442 | 647 '4','5','6','7','8','9','-','_' |
| 648 }; | |
| 428 | 649 |
| 650 Bytecount len; | |
| 867 | 651 Ibyte *p, *data; |
| 844 | 652 Lisp_Object handler; |
| 428 | 653 |
| 654 CHECK_STRING (prefix); | |
| 844 | 655 handler = Ffind_file_name_handler (prefix, Qmake_temp_name); |
| 656 if (!NILP (handler)) | |
| 657 return call2_check_string (handler, Qmake_temp_name, prefix); | |
| 428 | 658 |
| 659 /* I was tempted to apply Fexpand_file_name on PREFIX here, but it's | |
| 660 a bad idea because: | |
| 661 | |
| 662 1) It might change the prefix, so the resulting string might not | |
| 663 begin with PREFIX. This violates the principle of least | |
| 664 surprise. | |
| 665 | |
| 666 2) It breaks under many unforeseeable circumstances, such as with | |
| 667 the code that uses (make-temp-name "") instead of | |
| 668 (make-temp-name "./"). | |
| 669 | |
| 844 | 670 [[ 3) It might yield unexpected (to stat(2)) results in the presence |
| 671 of EFS and file name handlers.]] Now that we check for a handler, | |
| 672 that's less of a concern. --ben */ | |
| 428 | 673 |
| 674 len = XSTRING_LENGTH (prefix); | |
| 867 | 675 data = alloca_ibytes (len + 7); |
| 428 | 676 memcpy (data, XSTRING_DATA (prefix), len); |
| 677 p = data + len; | |
| 771 | 678 p[6] = '\0'; |
| 428 | 679 |
| 680 /* VAL is created by adding 6 characters to PREFIX. The first three | |
| 681 are the PID of this process, in base 64, and the second three are | |
| 442 | 682 a pseudo-random number seeded from process startup time. This |
| 683 ensures 262144 unique file names per PID per PREFIX per machine. */ | |
| 684 | |
| 685 { | |
| 771 | 686 unsigned int pid = (unsigned int) qxe_getpid (); |
| 442 | 687 *p++ = tbl[(pid >> 0) & 63]; |
| 688 *p++ = tbl[(pid >> 6) & 63]; | |
| 689 *p++ = tbl[(pid >> 12) & 63]; | |
| 690 } | |
| 428 | 691 |
| 692 /* Here we try to minimize useless stat'ing when this function is | |
| 693 invoked many times successively with the same PREFIX. We achieve | |
| 442 | 694 this by using a very pseudo-random number generator to generate |
| 695 file names unique to this process, with a very long cycle. */ | |
| 428 | 696 |
| 697 while (1) | |
| 698 { | |
| 699 struct stat ignored; | |
| 442 | 700 |
| 701 p[0] = tbl[(temp_name_rand >> 0) & 63]; | |
| 702 p[1] = tbl[(temp_name_rand >> 6) & 63]; | |
| 703 p[2] = tbl[(temp_name_rand >> 12) & 63]; | |
| 428 | 704 |
| 705 /* Poor man's congruential RN generator. Replace with ++count | |
| 706 for debugging. */ | |
| 442 | 707 temp_name_rand += 25229; |
| 708 temp_name_rand %= 225307; | |
| 428 | 709 |
| 710 QUIT; | |
| 711 | |
| 771 | 712 if (qxe_stat (data, &ignored) < 0) |
| 428 | 713 { |
| 714 /* We want to return only if errno is ENOENT. */ | |
| 715 if (errno == ENOENT) | |
| 771 | 716 return make_string (data, len + 6); |
| 428 | 717 |
| 718 /* The error here is dubious, but there is little else we | |
| 719 can do. The alternatives are to return nil, which is | |
| 720 as bad as (and in many cases worse than) throwing the | |
| 721 error, or to ignore the error, which will likely result | |
| 722 in inflooping. */ | |
| 723 report_file_error ("Cannot create temporary name for prefix", | |
| 563 | 724 prefix); |
| 428 | 725 return Qnil; /* not reached */ |
| 726 } | |
| 727 } | |
| 728 } | |
| 729 | |
| 730 | |
| 771 | 731 |
| 428 | 732 DEFUN ("expand-file-name", Fexpand_file_name, 1, 2, 0, /* |
| 733 Convert filename NAME to absolute, and canonicalize it. | |
| 734 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative | |
| 735 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing, | |
| 444 | 736 the current buffer's value of `default-directory' is used. |
| 428 | 737 File name components that are `.' are removed, and |
| 738 so are file name components followed by `..', along with the `..' itself; | |
| 739 note that these simplifications are done without checking the resulting | |
| 740 file names in the file system. | |
| 741 An initial `~/' expands to your home directory. | |
| 742 An initial `~USER/' expands to USER's home directory. | |
| 743 See also the function `substitute-in-file-name'. | |
| 744 */ | |
| 745 (name, default_directory)) | |
| 746 { | |
| 771 | 747 /* This function can GC. GC-checked 2000-11-18. |
| 748 This function synched with Emacs 21.0.103. */ | |
| 867 | 749 Ibyte *nm; |
| 750 | |
| 751 Ibyte *newdir, *p, *o; | |
| 428 | 752 int tlen; |
| 867 | 753 Ibyte *target; |
| 657 | 754 #ifdef WIN32_FILENAMES |
| 428 | 755 int drive = 0; |
| 756 int collapse_newdir = 1; | |
| 771 | 757 /* XEmacs note: This concerns the special '/:' syntax for preventing |
| 758 wildcards and such. We don't support this currently but I'm | |
| 759 keeping the code here in case we do. */ | |
| 760 int is_escaped = 0; | |
| 657 | 761 #endif |
| 762 #ifndef WIN32_NATIVE | |
| 428 | 763 struct passwd *pw; |
| 771 | 764 #endif |
| 428 | 765 int length; |
| 446 | 766 Lisp_Object handler = Qnil; |
| 767 struct gcpro gcpro1, gcpro2, gcpro3; | |
| 2526 | 768 PROFILE_DECLARE (); |
| 769 | |
| 770 PROFILE_RECORD_ENTERING_SECTION (QSin_expand_file_name); | |
| 442 | 771 |
| 772 /* both of these get set below */ | |
| 446 | 773 GCPRO3 (name, default_directory, handler); |
| 428 | 774 |
| 775 CHECK_STRING (name); | |
| 776 | |
| 777 /* If the file name has special constructs in it, | |
| 778 call the corresponding file handler. */ | |
| 779 handler = Ffind_file_name_handler (name, Qexpand_file_name); | |
| 780 if (!NILP (handler)) | |
| 2526 | 781 RETURN_UNGCPRO_EXIT_PROFILING (QSin_expand_file_name, |
| 782 call3_check_string | |
| 783 (handler, Qexpand_file_name, | |
| 784 name, default_directory)); | |
| 428 | 785 |
| 786 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */ | |
| 787 if (NILP (default_directory)) | |
| 788 default_directory = current_buffer->directory; | |
| 789 if (! STRINGP (default_directory)) | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4867
diff
changeset
|
790 default_directory = build_ascstring (DEFAULT_DIRECTORY_FALLBACK); |
| 428 | 791 |
| 792 if (!NILP (default_directory)) | |
| 793 { | |
| 794 handler = Ffind_file_name_handler (default_directory, Qexpand_file_name); | |
| 795 if (!NILP (handler)) | |
| 2526 | 796 RETURN_UNGCPRO_EXIT_PROFILING (QSin_expand_file_name, |
|
4826
780bb5441c14
use call3_check_string on all invocations of external handlers in expand-file-name
Ben Wing <ben@xemacs.org>
parents:
4824
diff
changeset
|
797 call3_check_string |
|
780bb5441c14
use call3_check_string on all invocations of external handlers in expand-file-name
Ben Wing <ben@xemacs.org>
parents:
4824
diff
changeset
|
798 (handler, Qexpand_file_name, |
|
780bb5441c14
use call3_check_string on all invocations of external handlers in expand-file-name
Ben Wing <ben@xemacs.org>
parents:
4824
diff
changeset
|
799 name, default_directory)); |
| 428 | 800 } |
| 801 | |
| 802 o = XSTRING_DATA (default_directory); | |
| 803 | |
| 804 /* Make sure DEFAULT_DIRECTORY is properly expanded. | |
| 805 It would be better to do this down below where we actually use | |
| 806 default_directory. Unfortunately, calling Fexpand_file_name recursively | |
| 807 could invoke GC, and the strings might be relocated. This would | |
| 808 be annoying because we have pointers into strings lying around | |
| 809 that would need adjusting, and people would add new pointers to | |
| 810 the code and forget to adjust them, resulting in intermittent bugs. | |
| 811 Putting this call here avoids all that crud. | |
| 812 | |
| 813 The EQ test avoids infinite recursion. */ | |
| 814 if (! NILP (default_directory) && !EQ (default_directory, name) | |
| 815 /* Save time in some common cases - as long as default_directory | |
| 816 is not relative, it can be canonicalized with name below (if it | |
| 817 is needed at all) without requiring it to be expanded now. */ | |
| 657 | 818 #ifdef WIN32_FILENAMES |
| 442 | 819 /* Detect Windows file names with drive specifiers. */ |
| 428 | 820 && ! (IS_DRIVE (o[0]) && (IS_DEVICE_SEP (o[1]) && IS_DIRECTORY_SEP (o[2]))) |
| 821 /* Detect Windows file names in UNC format. */ | |
| 822 && ! (IS_DIRECTORY_SEP (o[0]) && IS_DIRECTORY_SEP (o[1])) | |
| 657 | 823 #endif /* not WIN32_FILENAMES */ |
| 824 #ifndef WIN32_NATIVE | |
| 428 | 825 /* Detect Unix absolute file names (/... alone is not absolute on |
| 442 | 826 Windows). */ |
| 428 | 827 && ! (IS_DIRECTORY_SEP (o[0])) |
| 442 | 828 #endif /* not WIN32_NATIVE */ |
| 428 | 829 ) |
| 442 | 830 |
| 831 default_directory = Fexpand_file_name (default_directory, Qnil); | |
| 428 | 832 |
| 833 #ifdef FILE_SYSTEM_CASE | |
| 834 name = FILE_SYSTEM_CASE (name); | |
| 835 #endif | |
| 836 | |
| 837 /* #### dmoore - this is ugly, clean this up. Looks like nm pointing | |
| 838 into name should be safe during all of this, though. */ | |
| 839 nm = XSTRING_DATA (name); | |
| 840 | |
| 657 | 841 #ifdef WIN32_FILENAMES |
| 428 | 842 /* We will force directory separators to be either all \ or /, so make |
| 843 a local copy to modify, even if there ends up being no change. */ | |
| 867 | 844 nm = qxestrcpy (alloca_ibytes (qxestrlen (nm) + 1), nm); |
| 771 | 845 |
| 846 /* Note if special escape prefix is present, but remove for now. */ | |
| 847 if (nm[0] == '/' && nm[1] == ':') | |
| 848 { | |
| 849 is_escaped = 1; | |
| 850 nm += 2; | |
| 851 } | |
| 428 | 852 |
| 853 /* Find and remove drive specifier if present; this makes nm absolute | |
| 854 even if the rest of the name appears to be relative. */ | |
| 855 { | |
| 867 | 856 Ibyte *colon = qxestrrchr (nm, ':'); |
| 428 | 857 |
| 858 if (colon) | |
| 657 | 859 { |
| 428 | 860 /* Only recognize colon as part of drive specifier if there is a |
| 861 single alphabetic character preceding the colon (and if the | |
| 862 character before the drive letter, if present, is a directory | |
| 863 separator); this is to support the remote system syntax used by | |
| 864 ange-ftp, and the "po:username" syntax for POP mailboxes. */ | |
| 865 look_again: | |
| 866 if (nm == colon) | |
| 867 nm++; | |
| 868 else if (IS_DRIVE (colon[-1]) | |
| 869 && (colon == nm + 1 || IS_DIRECTORY_SEP (colon[-2]))) | |
| 870 { | |
| 871 drive = colon[-1]; | |
| 872 nm = colon + 1; | |
| 873 } | |
| 874 else | |
| 875 { | |
| 876 while (--colon >= nm) | |
| 877 if (colon[0] == ':') | |
| 878 goto look_again; | |
| 879 } | |
| 657 | 880 } |
| 428 | 881 } |
| 882 | |
| 883 /* If we see "c://somedir", we want to strip the first slash after the | |
| 884 colon when stripping the drive letter. Otherwise, this expands to | |
| 885 "//somedir". */ | |
| 886 if (drive && IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1])) | |
| 887 nm++; | |
| 657 | 888 #endif /* WIN32_FILENAMES */ |
| 428 | 889 |
| 771 | 890 #ifdef WIN32_FILENAMES |
| 891 /* Discard any previous drive specifier if nm is now in UNC format. */ | |
| 892 if (IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1])) | |
| 893 { | |
| 894 drive = 0; | |
| 895 } | |
| 896 #endif | |
| 897 | |
| 428 | 898 /* If nm is absolute, look for /./ or /../ sequences; if none are |
| 899 found, we can probably return right away. We will avoid allocating | |
| 900 a new string if name is already fully expanded. */ | |
| 901 if ( | |
| 902 IS_DIRECTORY_SEP (nm[0]) | |
| 442 | 903 #ifdef WIN32_NATIVE |
| 771 | 904 && (drive || IS_DIRECTORY_SEP (nm[1])) && !is_escaped |
| 428 | 905 #endif |
| 906 ) | |
| 907 { | |
| 908 /* If it turns out that the filename we want to return is just a | |
| 909 suffix of FILENAME, we don't need to go through and edit | |
| 910 things; we just need to construct a new string using data | |
| 911 starting at the middle of FILENAME. If we set lose to a | |
| 912 non-zero value, that means we've discovered that we can't do | |
| 913 that cool trick. */ | |
| 914 int lose = 0; | |
| 915 | |
| 916 p = nm; | |
| 917 while (*p) | |
| 918 { | |
| 919 /* Since we know the name is absolute, we can assume that each | |
| 920 element starts with a "/". */ | |
| 921 | |
| 922 /* "." and ".." are hairy. */ | |
| 923 if (IS_DIRECTORY_SEP (p[0]) | |
| 924 && p[1] == '.' | |
| 925 && (IS_DIRECTORY_SEP (p[2]) | |
| 926 || p[2] == 0 | |
| 927 || (p[2] == '.' && (IS_DIRECTORY_SEP (p[3]) | |
| 928 || p[3] == 0)))) | |
| 929 lose = 1; | |
| 771 | 930 /* We want to replace multiple `/' in a row with a single |
| 931 slash. */ | |
| 932 else if (p > nm | |
| 933 && IS_DIRECTORY_SEP (p[0]) | |
| 934 && IS_DIRECTORY_SEP (p[1])) | |
| 935 lose = 1; | |
| 428 | 936 p++; |
| 937 } | |
| 938 if (!lose) | |
| 939 { | |
| 657 | 940 #ifdef WIN32_FILENAMES |
| 941 if (drive || IS_DIRECTORY_SEP (nm[1])) | |
| 428 | 942 { |
| 867 | 943 Ibyte *newnm; |
| 771 | 944 |
| 657 | 945 if (IS_DIRECTORY_SEP (nm[1])) |
| 946 { | |
| 771 | 947 newnm = mswindows_canonicalize_filename (nm); |
| 948 if (qxestrcmp (newnm, XSTRING_DATA (name)) != 0) | |
| 949 name = build_intstring (newnm); | |
| 657 | 950 } |
| 771 | 951 else |
| 657 | 952 { |
| 771 | 953 /* drive must be set, so this is okay */ |
| 954 newnm = mswindows_canonicalize_filename (nm - 2); | |
| 955 if (qxestrcmp (newnm, XSTRING_DATA (name)) != 0) | |
| 956 { | |
| 957 name = build_intstring (newnm); | |
| 958 XSTRING_DATA (name)[0] = DRIVE_LETTER (drive); | |
| 959 XSTRING_DATA (name)[1] = ':'; | |
| 960 } | |
| 657 | 961 } |
| 1726 | 962 xfree (newnm, Ibyte *); |
| 2526 | 963 RETURN_UNGCPRO_EXIT_PROFILING (QSin_expand_file_name, name); |
| 428 | 964 } |
| 771 | 965 #endif /* WIN32_FILENAMES */ |
| 657 | 966 #ifndef WIN32_NATIVE |
| 428 | 967 if (nm == XSTRING_DATA (name)) |
| 2526 | 968 RETURN_UNGCPRO_EXIT_PROFILING (QSin_expand_file_name, name); |
| 969 RETURN_UNGCPRO_EXIT_PROFILING (QSin_expand_file_name, | |
| 970 build_intstring (nm)); | |
| 442 | 971 #endif /* not WIN32_NATIVE */ |
| 428 | 972 } |
| 973 } | |
| 974 | |
| 975 /* At this point, nm might or might not be an absolute file name. We | |
| 976 need to expand ~ or ~user if present, otherwise prefix nm with | |
| 977 default_directory if nm is not absolute, and finally collapse /./ | |
| 978 and /foo/../ sequences. | |
| 979 | |
| 980 We set newdir to be the appropriate prefix if one is needed: | |
| 981 - the relevant user directory if nm starts with ~ or ~user | |
| 982 - the specified drive's working dir (DOS/NT only) if nm does not | |
| 983 start with / | |
| 984 - the value of default_directory. | |
| 985 | |
| 986 Note that these prefixes are not guaranteed to be absolute (except | |
| 987 for the working dir of a drive). Therefore, to ensure we always | |
| 988 return an absolute name, if the final prefix is not absolute we | |
| 989 append it to the current working directory. */ | |
| 990 | |
| 991 newdir = 0; | |
| 992 | |
| 993 if (nm[0] == '~') /* prefix ~ */ | |
| 994 { | |
| 995 if (IS_DIRECTORY_SEP (nm[1]) | |
| 996 || nm[1] == 0) /* ~ by itself */ | |
| 997 { | |
| 867 | 998 Ibyte *homedir = get_home_directory (); |
| 771 | 999 |
| 1000 if (!homedir) | |
| 867 | 1001 newdir = (Ibyte *) ""; |
| 428 | 1002 else |
| 771 | 1003 newdir = homedir; |
| 428 | 1004 |
| 1005 nm++; | |
| 657 | 1006 #ifdef WIN32_FILENAMES |
| 428 | 1007 collapse_newdir = 0; |
| 1008 #endif | |
| 1009 } | |
| 1010 else /* ~user/filename */ | |
| 1011 { | |
| 1012 for (p = nm; *p && (!IS_DIRECTORY_SEP (*p)); p++) | |
| 1013 DO_NOTHING; | |
| 2367 | 1014 o = alloca_ibytes (p - nm + 1); |
| 771 | 1015 memcpy (o, nm, p - nm); |
| 428 | 1016 o [p - nm] = 0; |
| 1017 | |
| 558 | 1018 /* #### While NT is single-user (for the moment) you still |
| 1019 can have multiple user profiles users defined, each with | |
| 1020 its HOME. So maybe possibly we should think about handling | |
| 1021 ~user. --ben */ | |
| 1022 #ifndef WIN32_NATIVE | |
| 442 | 1023 #ifdef CYGWIN |
| 771 | 1024 { |
| 867 | 1025 Ibyte *user; |
| 771 | 1026 |
| 1027 if ((user = user_login_name (NULL)) != NULL) | |
| 1028 { | |
| 1029 /* Does the user login name match the ~name? */ | |
| 1030 if (qxestrcmp (user, o + 1) == 0) | |
| 1031 { | |
| 1032 newdir = get_home_directory (); | |
| 1033 nm = p; | |
| 1034 } | |
| 1035 } | |
| 1036 } | |
| 1037 if (!newdir) | |
| 428 | 1038 { |
| 442 | 1039 #endif /* CYGWIN */ |
| 428 | 1040 /* Jamie reports that getpwnam() can get wedged by SIGIO/SIGALARM |
| 1041 occurring in it. (It can call select()). */ | |
| 1042 slow_down_interrupts (); | |
| 771 | 1043 pw = (struct passwd *) qxe_getpwnam (o + 1); |
| 428 | 1044 speed_up_interrupts (); |
| 1045 if (pw) | |
| 1046 { | |
| 867 | 1047 newdir = (Ibyte *) pw->pw_dir; |
| 428 | 1048 nm = p; |
| 771 | 1049 /* FSF: if WIN32_NATIVE, collapse_newdir = 0; |
| 1050 not possible here. */ | |
| 428 | 1051 } |
| 442 | 1052 #ifdef CYGWIN |
| 428 | 1053 } |
| 1054 #endif | |
| 442 | 1055 #endif /* not WIN32_NATIVE */ |
| 428 | 1056 |
| 1057 /* If we don't find a user of that name, leave the name | |
| 1058 unchanged; don't move nm forward to p. */ | |
| 1059 } | |
| 1060 } | |
| 1061 | |
| 657 | 1062 #ifdef WIN32_FILENAMES |
| 428 | 1063 /* On DOS and Windows, nm is absolute if a drive name was specified; |
| 1064 use the drive's current directory as the prefix if needed. */ | |
| 1065 if (!newdir && drive) | |
| 1066 { | |
| 657 | 1067 #ifdef WIN32_NATIVE |
| 428 | 1068 /* Get default directory if needed to make nm absolute. */ |
| 1069 if (!IS_DIRECTORY_SEP (nm[0])) | |
| 1070 { | |
| 867 | 1071 Ibyte *newcwd = mswindows_getdcwd (toupper (drive) - 'A' + 1); |
| 771 | 1072 if (newcwd) |
| 1073 { | |
| 867 | 1074 IBYTE_STRING_TO_ALLOCA (newcwd, newdir); |
| 1726 | 1075 xfree (newcwd, Ibyte *); |
| 771 | 1076 } |
| 1077 else | |
| 428 | 1078 newdir = NULL; |
| 1079 } | |
| 657 | 1080 #endif /* WIN32_NATIVE */ |
| 428 | 1081 if (!newdir) |
| 1082 { | |
| 1083 /* Either nm starts with /, or drive isn't mounted. */ | |
| 2367 | 1084 newdir = alloca_ibytes (4); |
| 428 | 1085 newdir[0] = DRIVE_LETTER (drive); |
| 1086 newdir[1] = ':'; | |
| 1087 newdir[2] = '/'; | |
| 1088 newdir[3] = 0; | |
| 1089 } | |
| 1090 } | |
| 657 | 1091 #endif /* WIN32_FILENAMES */ |
| 428 | 1092 |
| 1093 /* Finally, if no prefix has been specified and nm is not absolute, | |
| 1094 then it must be expanded relative to default_directory. */ | |
| 1095 | |
| 1096 if (1 | |
| 442 | 1097 #ifndef WIN32_NATIVE |
| 428 | 1098 /* /... alone is not absolute on DOS and Windows. */ |
| 1099 && !IS_DIRECTORY_SEP (nm[0]) | |
| 657 | 1100 #endif |
| 1101 #ifdef WIN32_FILENAMES | |
| 428 | 1102 && !(IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1])) |
| 1103 #endif | |
| 1104 && !newdir) | |
| 1105 { | |
| 1106 newdir = XSTRING_DATA (default_directory); | |
| 771 | 1107 #ifdef WIN32_FILENAMES |
| 1108 /* Note if special escape prefix is present, but remove for now. */ | |
| 1109 if (newdir[0] == '/' && newdir[1] == ':') | |
| 1110 { | |
| 1111 is_escaped = 1; | |
| 1112 newdir += 2; | |
| 1113 } | |
| 1114 #endif | |
| 428 | 1115 } |
| 1116 | |
| 657 | 1117 #ifdef WIN32_FILENAMES |
| 428 | 1118 if (newdir) |
| 1119 { | |
| 1120 /* First ensure newdir is an absolute name. */ | |
| 1121 if ( | |
| 442 | 1122 /* Detect Windows file names with drive specifiers. */ |
| 428 | 1123 ! (IS_DRIVE (newdir[0]) |
| 1124 && IS_DEVICE_SEP (newdir[1]) && IS_DIRECTORY_SEP (newdir[2])) | |
| 1125 /* Detect Windows file names in UNC format. */ | |
| 1126 && ! (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1])) | |
| 771 | 1127 /* XEmacs: added these two lines: Detect drive spec by itself */ |
| 428 | 1128 && ! (IS_DEVICE_SEP (newdir[1]) && newdir[2] == 0) |
| 657 | 1129 /* Detect unix format. */ |
| 1130 #ifndef WIN32_NATIVE | |
| 1131 && ! (IS_DIRECTORY_SEP (newdir[0])) | |
| 1132 #endif | |
| 428 | 1133 ) |
| 1134 { | |
| 1135 /* Effectively, let newdir be (expand-file-name newdir cwd). | |
| 1136 Because of the admonition against calling expand-file-name | |
| 1137 when we have pointers into lisp strings, we accomplish this | |
| 1138 indirectly by prepending newdir to nm if necessary, and using | |
| 1139 cwd (or the wd of newdir's drive) as the new newdir. */ | |
| 1140 | |
| 1141 if (IS_DRIVE (newdir[0]) && newdir[1] == ':') | |
| 1142 { | |
| 1143 drive = newdir[0]; | |
| 1144 newdir += 2; | |
| 1145 } | |
| 1146 if (!IS_DIRECTORY_SEP (nm[0])) | |
| 1147 { | |
| 2367 | 1148 Ibyte *tmp = alloca_ibytes (qxestrlen (newdir) + |
| 1149 qxestrlen (nm) + 2); | |
| 771 | 1150 file_name_as_directory (tmp, newdir); |
| 1151 qxestrcat (tmp, nm); | |
| 428 | 1152 nm = tmp; |
| 1153 } | |
| 1154 if (drive) | |
| 1155 { | |
| 657 | 1156 #ifdef WIN32_NATIVE |
| 867 | 1157 Ibyte *newcwd = mswindows_getdcwd (toupper (drive) - 'A' + 1); |
| 771 | 1158 if (newcwd) |
| 1159 { | |
| 867 | 1160 IBYTE_STRING_TO_ALLOCA (newcwd, newdir); |
| 1726 | 1161 xfree (newcwd, Ibyte *); |
| 771 | 1162 } |
| 1163 else | |
| 657 | 1164 #endif |
| 867 | 1165 IBYTE_STRING_TO_ALLOCA ((Ibyte *) "/", newdir); |
| 428 | 1166 } |
| 1167 else | |
| 867 | 1168 IBYTE_STRING_TO_ALLOCA (get_initial_directory (0, 0), newdir); |
| 428 | 1169 } |
| 1170 | |
| 1171 /* Strip off drive name from prefix, if present. */ | |
| 1172 if (IS_DRIVE (newdir[0]) && newdir[1] == ':') | |
| 1173 { | |
| 1174 drive = newdir[0]; | |
| 1175 newdir += 2; | |
| 1176 } | |
| 1177 | |
| 1178 /* Keep only a prefix from newdir if nm starts with slash | |
| 771 | 1179 (//server/share for UNC, nothing otherwise). */ |
| 657 | 1180 if (IS_DIRECTORY_SEP (nm[0]) |
| 1181 #ifndef WIN32_NATIVE | |
| 1182 && IS_DIRECTORY_SEP (nm[1]) | |
| 1183 #endif | |
| 1184 && collapse_newdir) | |
| 428 | 1185 { |
| 1186 if (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1])) | |
| 1187 { | |
| 2367 | 1188 /* !!#### Use ei API */ |
| 1189 newdir = qxestrcpy (alloca_ibytes (qxestrlen (newdir) + 1), | |
| 1190 newdir); | |
| 428 | 1191 p = newdir + 2; |
| 1192 while (*p && !IS_DIRECTORY_SEP (*p)) p++; | |
| 1193 p++; | |
| 1194 while (*p && !IS_DIRECTORY_SEP (*p)) p++; | |
| 1195 *p = 0; | |
| 1196 } | |
| 1197 else | |
| 867 | 1198 newdir = (Ibyte *) ""; |
| 428 | 1199 } |
| 1200 } | |
| 657 | 1201 #endif /* WIN32_FILENAMES */ |
| 428 | 1202 |
| 1203 if (newdir) | |
| 1204 { | |
| 1205 /* Get rid of any slash at the end of newdir, unless newdir is | |
| 771 | 1206 just / or // (an incomplete UNC name). */ |
| 1207 length = qxestrlen (newdir); | |
| 428 | 1208 if (length > 1 && IS_DIRECTORY_SEP (newdir[length - 1]) |
| 657 | 1209 #ifdef WIN32_FILENAMES |
| 428 | 1210 && !(length == 2 && IS_DIRECTORY_SEP (newdir[0])) |
| 1211 #endif | |
| 1212 ) | |
| 1213 { | |
| 2367 | 1214 Ibyte *temp = alloca_ibytes (length); |
| 428 | 1215 memcpy (temp, newdir, length - 1); |
| 1216 temp[length - 1] = 0; | |
| 1217 newdir = temp; | |
| 1218 } | |
| 1219 tlen = length + 1; | |
| 1220 } | |
| 1221 else | |
| 1222 tlen = 0; | |
| 1223 | |
| 1224 /* Now concatenate the directory and name to new space in the stack frame */ | |
| 771 | 1225 tlen += qxestrlen (nm) + 1; |
| 657 | 1226 #ifdef WIN32_FILENAMES |
| 771 | 1227 /* Reserve space for drive specifier and escape prefix, since either |
| 1228 or both may need to be inserted. (The Microsoft x86 compiler | |
| 428 | 1229 produces incorrect code if the following two lines are combined.) */ |
| 2367 | 1230 target = alloca_ibytes (tlen + 4); |
| 771 | 1231 target += 4; |
| 657 | 1232 #else /* not WIN32_FILENAMES */ |
| 2367 | 1233 target = alloca_ibytes (tlen); |
| 657 | 1234 #endif /* not WIN32_FILENAMES */ |
| 428 | 1235 *target = 0; |
| 1236 | |
| 1237 if (newdir) | |
| 1238 { | |
| 1239 if (nm[0] == 0 || IS_DIRECTORY_SEP (nm[0])) | |
| 771 | 1240 { |
| 1241 #ifdef WIN32_FILENAMES | |
| 1242 /* If newdir is effectively "C:/", then the drive letter will have | |
| 1243 been stripped and newdir will be "/". Concatenating with an | |
| 1244 absolute directory in nm produces "//", which will then be | |
| 1245 incorrectly treated as a network share. Ignore newdir in | |
| 1246 this case (keeping the drive letter). */ | |
| 1247 if (!(drive && nm[0] && IS_DIRECTORY_SEP (newdir[0]) | |
| 1248 && newdir[1] == '\0')) | |
| 1249 #endif | |
| 1250 qxestrcpy (target, newdir); | |
| 1251 } | |
| 428 | 1252 else |
| 771 | 1253 file_name_as_directory (target, newdir); |
| 428 | 1254 } |
| 1255 | |
| 771 | 1256 qxestrcat (target, nm); |
| 428 | 1257 |
| 1258 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */ | |
| 1259 | |
| 771 | 1260 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they |
| 1261 appear. */ | |
| 428 | 1262 |
| 1263 p = target; | |
| 1264 o = target; | |
| 1265 | |
| 1266 while (*p) | |
| 1267 { | |
| 1268 if (!IS_DIRECTORY_SEP (*p)) | |
| 1269 { | |
| 1270 *o++ = *p++; | |
| 1271 } | |
| 1272 else if (IS_DIRECTORY_SEP (p[0]) | |
| 1273 && p[1] == '.' | |
| 1274 && (IS_DIRECTORY_SEP (p[2]) | |
| 1275 || p[2] == 0)) | |
| 1276 { | |
| 1277 /* If "/." is the entire filename, keep the "/". Otherwise, | |
| 1278 just delete the whole "/.". */ | |
| 1279 if (o == target && p[2] == '\0') | |
| 1280 *o++ = *p; | |
| 1281 p += 2; | |
| 1282 } | |
| 1283 else if (IS_DIRECTORY_SEP (p[0]) && p[1] == '.' && p[2] == '.' | |
| 1284 /* `/../' is the "superroot" on certain file systems. */ | |
| 1285 && o != target | |
| 1286 && (IS_DIRECTORY_SEP (p[3]) || p[3] == 0)) | |
| 1287 { | |
| 1288 while (o != target && (--o) && !IS_DIRECTORY_SEP (*o)) | |
| 1289 ; | |
| 1290 /* Keep initial / only if this is the whole name. */ | |
| 1291 if (o == target && IS_ANY_SEP (*o) && p[3] == 0) | |
| 1292 ++o; | |
| 1293 p += 3; | |
| 1294 } | |
| 771 | 1295 else if (p > target |
| 1296 && IS_DIRECTORY_SEP (p[0]) && IS_DIRECTORY_SEP (p[1])) | |
| 1297 { | |
| 1298 /* Collapse multiple `/' in a row. */ | |
| 1299 *o++ = *p++; | |
| 1300 while (IS_DIRECTORY_SEP (*p)) | |
| 1301 ++p; | |
| 1302 } | |
| 428 | 1303 else |
| 1304 { | |
| 1305 *o++ = *p++; | |
| 1306 } | |
| 1307 } | |
| 1308 | |
| 657 | 1309 #ifdef WIN32_FILENAMES |
| 428 | 1310 /* At last, set drive name, except for network file name. */ |
| 1311 if (drive) | |
| 1312 { | |
| 1313 target -= 2; | |
| 1314 target[0] = DRIVE_LETTER (drive); | |
| 1315 target[1] = ':'; | |
| 1316 } | |
| 657 | 1317 #ifdef WIN32_NATIVE |
| 428 | 1318 else |
| 1319 { | |
| 1320 assert (IS_DIRECTORY_SEP (target[0]) && IS_DIRECTORY_SEP (target[1])); | |
| 1321 } | |
| 657 | 1322 #endif |
| 771 | 1323 /* Reinsert the escape prefix if required. */ |
| 1324 if (is_escaped) | |
| 1325 { | |
| 1326 target -= 2; | |
| 1327 target[0] = '/'; | |
| 1328 target[1] = ':'; | |
| 1329 } | |
| 1330 | |
| 1331 *o = '\0'; | |
| 1332 | |
| 1333 { | |
| 867 | 1334 Ibyte *newtarget = mswindows_canonicalize_filename (target); |
| 771 | 1335 Lisp_Object result = build_intstring (newtarget); |
| 1726 | 1336 xfree (newtarget, Ibyte *); |
| 771 | 1337 |
| 2526 | 1338 RETURN_UNGCPRO_EXIT_PROFILING (QSin_expand_file_name, result); |
| 771 | 1339 } |
| 1340 #else /* not WIN32_FILENAMES */ | |
| 2526 | 1341 RETURN_UNGCPRO_EXIT_PROFILING (QSin_expand_file_name, |
| 1342 make_string (target, o - target)); | |
| 771 | 1343 #endif /* not WIN32_FILENAMES */ |
| 428 | 1344 } |
| 1345 | |
| 1346 DEFUN ("file-truename", Ffile_truename, 1, 2, 0, /* | |
| 444 | 1347 Return the canonical name of FILENAME. |
| 1348 Second arg DEFAULT is directory to start with if FILENAME is relative | |
| 428 | 1349 (does not start with slash); if DEFAULT is nil or missing, |
| 444 | 1350 the current buffer's value of `default-directory' is used. |
| 428 | 1351 No component of the resulting pathname will be a symbolic link, as |
| 1352 in the realpath() function. | |
| 1353 */ | |
| 1354 (filename, default_)) | |
| 1355 { | |
| 442 | 1356 /* This function can GC. GC checked 2000-07-28 ben. */ |
| 428 | 1357 Lisp_Object expanded_name; |
| 1358 struct gcpro gcpro1; | |
| 1359 | |
| 1360 CHECK_STRING (filename); | |
| 1361 | |
| 1362 expanded_name = Fexpand_file_name (filename, default_); | |
| 1363 | |
| 1364 if (!STRINGP (expanded_name)) | |
| 1365 return Qnil; | |
| 1366 | |
| 1367 GCPRO1 (expanded_name); | |
| 442 | 1368 |
| 1369 { | |
| 1370 Lisp_Object handler = | |
| 1371 Ffind_file_name_handler (expanded_name, Qfile_truename); | |
| 1372 | |
| 1373 if (!NILP (handler)) | |
| 1374 RETURN_UNGCPRO | |
| 1375 (call2_check_string (handler, Qfile_truename, expanded_name)); | |
| 1376 } | |
| 428 | 1377 |
| 1378 { | |
| 2421 | 1379 Ibyte resolved_path[PATH_MAX_INTERNAL]; |
| 771 | 1380 Bytecount elen = XSTRING_LENGTH (expanded_name); |
| 867 | 1381 Ibyte *path; |
| 1382 Ibyte *p; | |
| 771 | 1383 |
| 1384 LISP_STRING_TO_ALLOCA (expanded_name, path); | |
| 988 | 1385 |
| 1111 | 1386 #if defined (WIN32_FILENAMES) && defined (CYGWIN) |
| 988 | 1387 /* When using win32 filenames in cygwin we want file-truename to |
| 1388 detect that c:/windows == /windows for example. */ | |
| 1111 | 1389 if (! (IS_DIRECTORY_SEP (path[0]) && IS_DIRECTORY_SEP (path[1]))) |
| 1390 { | |
|
4834
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
1391 LOCAL_FILE_FORMAT_TO_INTERNAL_MSWIN (path, p); |
| 1111 | 1392 path = p; |
| 1393 } | |
| 988 | 1394 #endif |
| 428 | 1395 p = path; |
| 442 | 1396 |
| 428 | 1397 /* Try doing it all at once. */ |
| 2526 | 1398 if (!qxe_realpath (path, resolved_path, 0)) |
| 428 | 1399 { |
| 1400 /* Didn't resolve it -- have to do it one component at a time. */ | |
| 1401 /* "realpath" is a typically useless, stupid un*x piece of crap. | |
| 1402 It claims to return a useful value in the "error" case, but since | |
| 1403 there is no indication provided of how far along the pathname | |
| 1404 the function went before erring, there is no way to use the | |
| 442 | 1405 partial result returned. What a piece of junk. |
| 1406 | |
| 1407 The above comment refers to historical versions of | |
| 1408 realpath(). The Unix98 specs state: | |
| 1409 | |
| 1410 "On successful completion, realpath() returns a | |
| 1411 pointer to the resolved name. Otherwise, realpath() | |
| 1412 returns a null pointer and sets errno to indicate the | |
| 1413 error, and the contents of the buffer pointed to by | |
| 1414 resolved_name are undefined." | |
| 1415 | |
| 771 | 1416 Since we depend on undocumented semantics of various system |
| 2526 | 1417 realpath()s, we just use our own version in realpath.c. |
| 1418 | |
| 1419 Note also that our own version differs in its semantics from any | |
| 1420 standard version, since it accepts and returns internal-format | |
| 1421 text, not external-format. */ | |
| 428 | 1422 for (;;) |
| 1423 { | |
| 867 | 1424 Ibyte *pos; |
| 446 | 1425 |
| 657 | 1426 #ifdef WIN32_FILENAMES |
| 446 | 1427 if (IS_DRIVE (p[0]) && IS_DEVICE_SEP (p[1]) |
| 1428 && IS_DIRECTORY_SEP (p[2])) | |
| 1429 /* don't test c: on windows */ | |
| 1430 p = p+2; | |
| 1431 else if (IS_DIRECTORY_SEP (p[0]) && IS_DIRECTORY_SEP (p[1])) | |
| 1432 /* start after // */ | |
| 1433 p = p+1; | |
| 1434 #endif | |
| 1435 for (pos = p + 1; pos < path + elen; pos++) | |
| 1436 if (IS_DIRECTORY_SEP (*pos)) | |
| 1437 { | |
| 1438 *(p = pos) = 0; | |
| 1439 break; | |
| 1440 } | |
| 1441 if (p != pos) | |
| 1442 p = 0; | |
| 428 | 1443 |
| 2526 | 1444 if (qxe_realpath (path, resolved_path, 0)) |
| 428 | 1445 { |
| 1446 if (p) | |
| 446 | 1447 *p = DIRECTORY_SEP; |
| 428 | 1448 else |
| 1449 break; | |
| 1450 | |
| 1451 } | |
| 1452 else if (errno == ENOENT || errno == EACCES) | |
| 1453 { | |
| 1454 /* Failed on this component. Just tack on the rest of | |
| 1455 the string and we are done. */ | |
| 771 | 1456 int rlen = qxestrlen (resolved_path); |
| 428 | 1457 |
| 1458 /* "On failure, it returns NULL, sets errno to indicate | |
| 1459 the error, and places in resolved_path the absolute pathname | |
| 1460 of the path component which could not be resolved." */ | |
| 442 | 1461 |
| 1462 if (p) | |
| 428 | 1463 { |
| 1464 int plen = elen - (p - path); | |
| 1465 | |
| 446 | 1466 if (rlen > 1 && IS_DIRECTORY_SEP (resolved_path[rlen - 1])) |
| 428 | 1467 rlen = rlen - 1; |
| 1468 | |
| 1469 if (plen + rlen + 1 > countof (resolved_path)) | |
| 1470 goto toolong; | |
| 1471 | |
| 446 | 1472 resolved_path[rlen] = DIRECTORY_SEP; |
| 428 | 1473 memcpy (resolved_path + rlen + 1, p + 1, plen + 1 - 1); |
| 1474 } | |
| 1475 break; | |
| 1476 } | |
| 1477 else | |
| 1478 goto lose; | |
| 1479 } | |
| 1480 } | |
| 1481 | |
| 1482 { | |
| 442 | 1483 Lisp_Object resolved_name; |
| 771 | 1484 int rlen = qxestrlen (resolved_path); |
| 826 | 1485 if (elen > 0 && IS_DIRECTORY_SEP (string_byte (expanded_name, elen - 1)) |
| 446 | 1486 && !(rlen > 0 && IS_DIRECTORY_SEP (resolved_path[rlen - 1]))) |
| 428 | 1487 { |
| 1488 if (rlen + 1 > countof (resolved_path)) | |
| 1489 goto toolong; | |
| 446 | 1490 resolved_path[rlen++] = DIRECTORY_SEP; |
| 442 | 1491 resolved_path[rlen] = '\0'; |
| 428 | 1492 } |
| 771 | 1493 resolved_name = make_string (resolved_path, rlen); |
| 442 | 1494 RETURN_UNGCPRO (resolved_name); |
| 428 | 1495 } |
| 1496 | |
| 1497 toolong: | |
| 1498 errno = ENAMETOOLONG; | |
| 1499 goto lose; | |
| 1500 lose: | |
| 563 | 1501 report_file_error ("Finding truename", expanded_name); |
| 428 | 1502 } |
| 442 | 1503 RETURN_UNGCPRO (Qnil); |
| 428 | 1504 } |
| 1505 | |
| 1506 | |
| 1507 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name, 1, 1, 0, /* | |
| 1508 Substitute environment variables referred to in FILENAME. | |
| 1509 `$FOO' where FOO is an environment variable name means to substitute | |
| 1510 the value of that variable. The variable name should be terminated | |
| 444 | 1511 with a character, not a letter, digit or underscore; otherwise, enclose |
| 428 | 1512 the entire variable name in braces. |
| 1513 If `/~' appears, all of FILENAME through that `/' is discarded. | |
| 1514 */ | |
| 444 | 1515 (filename)) |
| 428 | 1516 { |
| 442 | 1517 /* This function can GC. GC checked 2000-07-28 ben. */ |
| 867 | 1518 Ibyte *nm; |
| 1519 | |
|
4324
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1520 Ibyte *s, *p, *o, *x, *endp, *got; |
| 867 | 1521 Ibyte *target = 0; |
| 428 | 1522 int total = 0; |
|
4324
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1523 int substituted = 0, seen_braces; |
| 867 | 1524 Ibyte *xnm; |
| 428 | 1525 Lisp_Object handler; |
| 1526 | |
| 444 | 1527 CHECK_STRING (filename); |
| 428 | 1528 |
| 1529 /* If the file name has special constructs in it, | |
| 1530 call the corresponding file handler. */ | |
| 444 | 1531 handler = Ffind_file_name_handler (filename, Qsubstitute_in_file_name); |
| 428 | 1532 if (!NILP (handler)) |
| 1533 return call2_check_string_or_nil (handler, Qsubstitute_in_file_name, | |
| 444 | 1534 filename); |
| 1535 | |
| 1536 nm = XSTRING_DATA (filename); | |
| 1537 endp = nm + XSTRING_LENGTH (filename); | |
| 428 | 1538 |
| 1539 /* If /~ or // appears, discard everything through first slash. */ | |
| 1540 | |
| 1541 for (p = nm; p != endp; p++) | |
| 1542 { | |
| 1543 if ((p[0] == '~' | |
| 657 | 1544 #if defined (WIN32_FILENAMES) |
| 440 | 1545 /* // at start of file name is meaningful in WindowsNT systems */ |
| 428 | 1546 || (IS_DIRECTORY_SEP (p[0]) && p - 1 != nm) |
| 657 | 1547 #else /* not (WIN32_FILENAMES) */ |
| 428 | 1548 || IS_DIRECTORY_SEP (p[0]) |
| 657 | 1549 #endif /* not (WIN32_FILENAMES) */ |
| 428 | 1550 ) |
| 1551 && p != nm | |
| 1552 && (IS_DIRECTORY_SEP (p[-1]))) | |
| 1553 { | |
| 1554 nm = p; | |
| 1555 substituted = 1; | |
| 1556 } | |
| 657 | 1557 #ifdef WIN32_FILENAMES |
| 428 | 1558 /* see comment in expand-file-name about drive specifiers */ |
| 1559 else if (IS_DRIVE (p[0]) && p[1] == ':' | |
| 1560 && p > nm && IS_DIRECTORY_SEP (p[-1])) | |
| 1561 { | |
| 1562 nm = p; | |
| 1563 substituted = 1; | |
| 1564 } | |
| 657 | 1565 #endif /* WIN32_FILENAMES */ |
| 428 | 1566 } |
| 1567 | |
| 1568 /* See if any variables are substituted into the string | |
| 1569 and find the total length of their values in `total' */ | |
| 1570 | |
| 1571 for (p = nm; p != endp;) | |
| 1572 if (*p != '$') | |
| 1573 p++; | |
| 1574 else | |
| 1575 { | |
| 1576 p++; | |
| 1577 if (p == endp) | |
|
4324
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1578 { |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1579 /* No substitution, no error. */ |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1580 break; |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1581 } |
| 428 | 1582 else if (*p == '$') |
| 1583 { | |
| 1584 /* "$$" means a single "$" */ | |
| 1585 p++; | |
| 1586 total -= 1; | |
| 1587 substituted = 1; | |
| 1588 continue; | |
| 1589 } | |
| 1590 else if (*p == '{') | |
| 1591 { | |
| 1592 o = ++p; | |
| 1593 while (p != endp && *p != '}') p++; | |
|
4324
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1594 if (*p != '}') |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1595 { |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1596 /* No substitution, no error. Keep looking. */ |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1597 p = o; |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1598 continue; |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1599 } |
| 428 | 1600 s = p; |
| 1601 } | |
| 1602 else | |
| 1603 { | |
| 1604 o = p; | |
| 1605 while (p != endp && (isalnum (*p) || *p == '_')) p++; | |
| 1606 s = p; | |
| 1607 } | |
| 1608 | |
| 1609 /* Copy out the variable name */ | |
| 2367 | 1610 target = alloca_ibytes (s - o + 1); |
| 771 | 1611 qxestrncpy (target, o, s - o); |
| 428 | 1612 target[s - o] = 0; |
| 442 | 1613 #ifdef WIN32_NATIVE |
| 1204 | 1614 qxestrupr (target); /* $home == $HOME etc. */ |
| 442 | 1615 #endif /* WIN32_NATIVE */ |
| 428 | 1616 |
| 1617 /* Get variable value */ | |
|
4324
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1618 got = egetenv ((CIbyte *) target); |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1619 if (got) |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1620 { |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1621 total += qxestrlen (got); |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1622 substituted = 1; |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1623 } |
| 428 | 1624 } |
| 1625 | |
| 1626 if (!substituted) | |
| 444 | 1627 return filename; |
| 1628 | |
| 1629 /* If substitution required, recopy the filename and do it */ | |
| 428 | 1630 /* Make space in stack frame for the new copy */ |
| 2367 | 1631 xnm = alloca_ibytes (XSTRING_LENGTH (filename) + total + 1); |
| 428 | 1632 x = xnm; |
| 1633 | |
| 1634 /* Copy the rest of the name through, replacing $ constructs with values */ | |
| 1635 for (p = nm; *p;) | |
| 1636 if (*p != '$') | |
| 1637 *x++ = *p++; | |
| 1638 else | |
| 1639 { | |
| 1640 p++; | |
|
4324
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1641 seen_braces = 0; |
| 428 | 1642 if (p == endp) |
|
4324
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1643 { |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1644 *x++ = '$'; |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1645 break; |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1646 } |
| 428 | 1647 else if (*p == '$') |
| 1648 { | |
| 1649 *x++ = *p++; | |
| 1650 continue; | |
| 1651 } | |
| 1652 else if (*p == '{') | |
| 1653 { | |
|
4324
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1654 seen_braces = 1; |
| 428 | 1655 o = ++p; |
| 1656 while (p != endp && *p != '}') p++; | |
|
4324
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1657 if (*p != '}') |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1658 { |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1659 /* Don't syntax error, don't substitute */ |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1660 *x++ = '{'; |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1661 p = o; |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1662 continue; |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1663 } |
| 428 | 1664 s = p++; |
| 1665 } | |
| 1666 else | |
| 1667 { | |
| 1668 o = p; | |
| 1669 while (p != endp && (isalnum (*p) || *p == '_')) p++; | |
| 1670 s = p; | |
| 1671 } | |
| 1672 | |
| 1673 /* Copy out the variable name */ | |
| 2367 | 1674 target = alloca_ibytes (s - o + 1); |
| 771 | 1675 qxestrncpy (target, o, s - o); |
| 428 | 1676 target[s - o] = 0; |
| 442 | 1677 #ifdef WIN32_NATIVE |
| 1204 | 1678 qxestrupr (target); /* $home == $HOME etc. */ |
| 442 | 1679 #endif /* WIN32_NATIVE */ |
| 428 | 1680 |
| 1681 /* Get variable value */ | |
|
4324
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1682 got = egetenv ((CIbyte *) target); |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1683 if (got) |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1684 { |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1685 qxestrcpy (x, got); |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1686 x += qxestrlen (got); |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1687 } |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1688 else |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1689 { |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1690 *x++ = '$'; |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1691 if (seen_braces) |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1692 { |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1693 *x++ = '{'; |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1694 /* Preserve the original case. */ |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1695 qxestrncpy (x, o, s - o); |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1696 x += s - o; |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1697 *x++ = '}'; |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1698 } |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1699 else |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1700 { |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1701 /* Preserve the original case. */ |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1702 qxestrncpy (x, o, s - o); |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1703 x += s - o; |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1704 } |
|
5e526366d533
Don't error on unknown environment variables, #'substitute-in-file-name.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4266
diff
changeset
|
1705 } |
| 428 | 1706 } |
| 1707 | |
| 1708 *x = 0; | |
| 1709 | |
| 1710 /* If /~ or // appears, discard everything through first slash. */ | |
| 1711 | |
| 1712 for (p = xnm; p != x; p++) | |
| 1713 if ((p[0] == '~' | |
| 657 | 1714 #if defined (WIN32_FILENAMES) |
| 428 | 1715 || (IS_DIRECTORY_SEP (p[0]) && p - 1 != xnm) |
| 657 | 1716 #else /* not WIN32_FILENAMES */ |
| 428 | 1717 || IS_DIRECTORY_SEP (p[0]) |
| 657 | 1718 #endif /* not WIN32_FILENAMES */ |
| 428 | 1719 ) |
| 1720 /* don't do p[-1] if that would go off the beginning --jwz */ | |
| 1721 && p != nm && p > xnm && IS_DIRECTORY_SEP (p[-1])) | |
| 1722 xnm = p; | |
| 657 | 1723 #ifdef WIN32_FILENAMES |
| 428 | 1724 else if (IS_DRIVE (p[0]) && p[1] == ':' |
| 1725 && p > nm && IS_DIRECTORY_SEP (p[-1])) | |
| 1726 xnm = p; | |
| 1727 #endif | |
| 1728 | |
| 1729 return make_string (xnm, x - xnm); | |
| 1730 } | |
| 1731 | |
| 1732 /* A slightly faster and more convenient way to get | |
| 1733 (directory-file-name (expand-file-name FOO)). */ | |
| 1734 | |
| 1735 Lisp_Object | |
| 1736 expand_and_dir_to_file (Lisp_Object filename, Lisp_Object defdir) | |
| 1737 { | |
| 442 | 1738 /* This function can call Lisp. GC checked 2000-07-28 ben */ |
| 428 | 1739 Lisp_Object abspath; |
| 1740 struct gcpro gcpro1; | |
| 1741 | |
| 1742 abspath = Fexpand_file_name (filename, defdir); | |
| 1743 GCPRO1 (abspath); | |
| 1744 /* Remove final slash, if any (unless path is root). | |
| 1745 stat behaves differently depending! */ | |
| 1746 if (XSTRING_LENGTH (abspath) > 1 | |
| 826 | 1747 && IS_DIRECTORY_SEP (string_byte (abspath, XSTRING_LENGTH (abspath) - 1)) |
| 1748 && !IS_DEVICE_SEP (string_byte (abspath, XSTRING_LENGTH (abspath) - 2))) | |
| 428 | 1749 /* We cannot take shortcuts; they might be wrong for magic file names. */ |
| 1750 abspath = Fdirectory_file_name (abspath); | |
| 1751 UNGCPRO; | |
| 1752 return abspath; | |
| 1753 } | |
| 1754 | |
| 1755 /* Signal an error if the file ABSNAME already exists. | |
| 1756 If INTERACTIVE is nonzero, ask the user whether to proceed, | |
| 1757 and bypass the error if the user says to go ahead. | |
| 1758 QUERYSTRING is a name for the action that is being considered | |
| 1759 to alter the file. | |
| 1760 *STATPTR is used to store the stat information if the file exists. | |
| 1761 If the file does not exist, STATPTR->st_mode is set to 0. */ | |
| 1762 | |
| 1763 static void | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4867
diff
changeset
|
1764 barf_or_query_if_file_exists (Lisp_Object absname, const Ascbyte *querystring, |
| 428 | 1765 int interactive, struct stat *statptr) |
| 1766 { | |
| 442 | 1767 /* This function can call Lisp. GC checked 2000-07-28 ben */ |
| 428 | 1768 struct stat statbuf; |
| 1769 | |
| 1770 /* stat is a good way to tell whether the file exists, | |
| 1771 regardless of what access permissions it has. */ | |
| 771 | 1772 if (qxe_stat (XSTRING_DATA (absname), &statbuf) >= 0) |
| 428 | 1773 { |
| 1774 Lisp_Object tem; | |
| 1775 | |
| 1776 if (interactive) | |
| 1777 { | |
| 1778 Lisp_Object prompt; | |
| 1779 struct gcpro gcpro1; | |
| 1780 | |
| 771 | 1781 prompt = |
| 1782 emacs_sprintf_string | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4867
diff
changeset
|
1783 (GETTEXT ("File %s already exists; %s anyway? "), |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4867
diff
changeset
|
1784 XSTRING_DATA (absname), GETTEXT (querystring)); |
| 428 | 1785 |
| 1786 GCPRO1 (prompt); | |
| 1787 tem = call1 (Qyes_or_no_p, prompt); | |
| 1788 UNGCPRO; | |
| 1789 } | |
| 1790 else | |
| 1791 tem = Qnil; | |
| 1792 | |
| 1793 if (NILP (tem)) | |
| 1794 Fsignal (Qfile_already_exists, | |
| 771 | 1795 list2 (build_msg_string ("File already exists"), |
| 428 | 1796 absname)); |
| 1797 if (statptr) | |
| 1798 *statptr = statbuf; | |
| 1799 } | |
| 1800 else | |
| 1801 { | |
| 1802 if (statptr) | |
| 1803 statptr->st_mode = 0; | |
| 1804 } | |
| 1805 return; | |
| 1806 } | |
| 1807 | |
| 1808 DEFUN ("copy-file", Fcopy_file, 2, 4, | |
| 1809 "fCopy file: \nFCopy %s to file: \np\nP", /* | |
| 444 | 1810 Copy FILENAME to NEWNAME. Both args must be strings. |
| 428 | 1811 Signals a `file-already-exists' error if file NEWNAME already exists, |
| 1812 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil. | |
| 1813 A number as third arg means request confirmation if NEWNAME already exists. | |
| 1814 This is what happens in interactive use with M-x. | |
| 1815 Fourth arg KEEP-TIME non-nil means give the new file the same | |
| 1816 last-modified time as the old one. (This works on only some systems.) | |
| 1817 A prefix arg makes KEEP-TIME non-nil. | |
| 1818 */ | |
| 1819 (filename, newname, ok_if_already_exists, keep_time)) | |
| 1820 { | |
| 442 | 1821 /* This function can call Lisp. GC checked 2000-07-28 ben */ |
| 428 | 1822 int ifd, ofd, n; |
| 1823 char buf[16 * 1024]; | |
| 1824 struct stat st, out_st; | |
| 1825 Lisp_Object handler; | |
| 1826 int speccount = specpdl_depth (); | |
| 1827 struct gcpro gcpro1, gcpro2; | |
| 1828 /* Lisp_Object args[6]; */ | |
| 1829 int input_file_statable_p; | |
| 1830 | |
| 1831 GCPRO2 (filename, newname); | |
| 1832 CHECK_STRING (filename); | |
| 1833 CHECK_STRING (newname); | |
| 1834 filename = Fexpand_file_name (filename, Qnil); | |
| 1835 newname = Fexpand_file_name (newname, Qnil); | |
| 1836 | |
| 1837 /* If the input file name has special constructs in it, | |
| 1838 call the corresponding file handler. */ | |
| 1839 handler = Ffind_file_name_handler (filename, Qcopy_file); | |
| 1840 /* Likewise for output file name. */ | |
| 1841 if (NILP (handler)) | |
| 1842 handler = Ffind_file_name_handler (newname, Qcopy_file); | |
| 1843 if (!NILP (handler)) | |
| 1844 { | |
| 1845 UNGCPRO; | |
| 1846 return call5 (handler, Qcopy_file, filename, newname, | |
| 1847 ok_if_already_exists, keep_time); | |
| 1848 } | |
| 1849 | |
| 1850 /* When second argument is a directory, copy the file into it. | |
| 1851 (copy-file "foo" "bar/") == (copy-file "foo" "bar/foo") | |
| 1852 */ | |
| 1853 if (!NILP (Ffile_directory_p (newname))) | |
| 1854 { | |
| 1855 Lisp_Object args[3]; | |
| 1856 struct gcpro ngcpro1; | |
| 1857 int i = 1; | |
| 1858 | |
| 1859 args[0] = newname; | |
| 1860 args[1] = Qnil; args[2] = Qnil; | |
| 1861 NGCPRO1 (*args); | |
| 1862 ngcpro1.nvars = 3; | |
| 826 | 1863 if (!IS_DIRECTORY_SEP (string_byte (newname, |
| 442 | 1864 XSTRING_LENGTH (newname) - 1))) |
| 1865 | |
| 1866 args[i++] = Fchar_to_string (Vdirectory_sep_char); | |
| 428 | 1867 args[i++] = Ffile_name_nondirectory (filename); |
| 1868 newname = Fconcat (i, args); | |
| 1869 NUNGCPRO; | |
| 1870 } | |
| 1871 | |
| 1872 if (NILP (ok_if_already_exists) | |
| 1873 || INTP (ok_if_already_exists)) | |
| 1874 barf_or_query_if_file_exists (newname, "copy to it", | |
| 1875 INTP (ok_if_already_exists), &out_st); | |
| 771 | 1876 else if (qxe_stat (XSTRING_DATA (newname), &out_st) < 0) |
| 428 | 1877 out_st.st_mode = 0; |
| 1878 | |
| 771 | 1879 ifd = qxe_interruptible_open (XSTRING_DATA (filename), |
| 1880 O_RDONLY | OPEN_BINARY, 0); | |
| 428 | 1881 if (ifd < 0) |
| 563 | 1882 report_file_error ("Opening input file", filename); |
| 428 | 1883 |
| 1884 record_unwind_protect (close_file_unwind, make_int (ifd)); | |
| 1885 | |
| 1886 /* We can only copy regular files and symbolic links. Other files are not | |
| 1887 copyable by us. */ | |
| 771 | 1888 input_file_statable_p = (qxe_fstat (ifd, &st) >= 0); |
| 428 | 1889 |
| 442 | 1890 #ifndef WIN32_NATIVE |
| 428 | 1891 if (out_st.st_mode != 0 |
| 1892 && st.st_dev == out_st.st_dev && st.st_ino == out_st.st_ino) | |
| 1893 { | |
| 1894 errno = 0; | |
| 1895 report_file_error ("Input and output files are the same", | |
| 563 | 1896 list3 (Qunbound, filename, newname)); |
| 428 | 1897 } |
| 1898 #endif | |
| 1899 | |
| 1900 #if defined (S_ISREG) && defined (S_ISLNK) | |
| 1901 if (input_file_statable_p) | |
| 1902 { | |
| 1903 if (!(S_ISREG (st.st_mode)) | |
| 1904 /* XEmacs: have to allow S_ISCHR in order to copy /dev/null */ | |
| 1905 #ifdef S_ISCHR | |
| 1906 && !(S_ISCHR (st.st_mode)) | |
| 1907 #endif | |
| 1908 && !(S_ISLNK (st.st_mode))) | |
| 1909 { | |
| 1910 #if defined (EISDIR) | |
| 1911 /* Get a better looking error message. */ | |
| 1912 errno = EISDIR; | |
| 1913 #endif /* EISDIR */ | |
| 563 | 1914 report_file_error ("Non-regular file", filename); |
| 428 | 1915 } |
| 1916 } | |
| 1917 #endif /* S_ISREG && S_ISLNK */ | |
| 1918 | |
| 771 | 1919 ofd = qxe_open (XSTRING_DATA (newname), |
| 1920 O_WRONLY | O_CREAT | O_TRUNC | OPEN_BINARY, CREAT_MODE); | |
| 428 | 1921 if (ofd < 0) |
| 563 | 1922 report_file_error ("Opening output file", newname); |
| 428 | 1923 |
| 1924 { | |
| 1925 Lisp_Object ofd_locative = noseeum_cons (make_int (ofd), Qnil); | |
| 1926 | |
| 1927 record_unwind_protect (close_file_unwind, ofd_locative); | |
| 1928 | |
| 1929 while ((n = read_allowing_quit (ifd, buf, sizeof (buf))) > 0) | |
| 1930 { | |
| 1931 if (write_allowing_quit (ofd, buf, n) != n) | |
| 563 | 1932 report_file_error ("I/O error", newname); |
| 428 | 1933 } |
| 1934 | |
| 1935 /* Closing the output clobbers the file times on some systems. */ | |
| 771 | 1936 if (retry_close (ofd) < 0) |
| 563 | 1937 report_file_error ("I/O error", newname); |
| 428 | 1938 |
| 1939 if (input_file_statable_p) | |
| 1940 { | |
| 442 | 1941 if (!NILP (keep_time)) |
| 1942 { | |
| 1943 EMACS_TIME atime, mtime; | |
| 1944 EMACS_SET_SECS_USECS (atime, st.st_atime, 0); | |
| 1945 EMACS_SET_SECS_USECS (mtime, st.st_mtime, 0); | |
| 592 | 1946 if (set_file_times (newname, atime, mtime)) |
| 1947 report_file_error ("I/O error", list1 (newname)); | |
| 442 | 1948 } |
| 771 | 1949 qxe_chmod (XSTRING_DATA (newname), st.st_mode & 07777); |
| 428 | 1950 } |
| 1951 | |
| 1952 /* We'll close it by hand */ | |
| 1953 XCAR (ofd_locative) = Qnil; | |
| 1954 | |
| 1955 /* Close ifd */ | |
| 771 | 1956 unbind_to (speccount); |
| 428 | 1957 } |
| 1958 | |
| 1959 UNGCPRO; | |
| 1960 return Qnil; | |
| 1961 } | |
| 1962 | |
| 1963 DEFUN ("make-directory-internal", Fmake_directory_internal, 1, 1, 0, /* | |
| 1964 Create a directory. One argument, a file name string. | |
| 1965 */ | |
| 1966 (dirname_)) | |
| 1967 { | |
| 1968 /* This function can GC. GC checked 1997.04.06. */ | |
| 1969 Lisp_Object handler; | |
| 1970 struct gcpro gcpro1; | |
| 771 | 1971 DECLARE_EISTRING (dir); |
| 428 | 1972 |
| 1973 CHECK_STRING (dirname_); | |
| 1974 dirname_ = Fexpand_file_name (dirname_, Qnil); | |
| 1975 | |
| 1976 GCPRO1 (dirname_); | |
| 1977 handler = Ffind_file_name_handler (dirname_, Qmake_directory_internal); | |
| 1978 UNGCPRO; | |
| 1979 if (!NILP (handler)) | |
| 1980 return (call2 (handler, Qmake_directory_internal, dirname_)); | |
| 1981 | |
| 771 | 1982 eicpy_lstr (dir, dirname_); |
| 1983 if (eigetch_char (dir, eicharlen (dir) - 1) == '/') | |
| 1984 eidel (dir, eilen (dir) - 1, -1, 1, -1); | |
| 1985 | |
| 1986 if (qxe_mkdir (eidata (dir), 0777) != 0) | |
| 563 | 1987 report_file_error ("Creating directory", dirname_); |
| 428 | 1988 |
| 1989 return Qnil; | |
| 1990 } | |
| 1991 | |
| 1992 DEFUN ("delete-directory", Fdelete_directory, 1, 1, "FDelete directory: ", /* | |
| 1993 Delete a directory. One argument, a file name or directory name string. | |
| 1994 */ | |
| 1995 (dirname_)) | |
| 1996 { | |
| 1997 /* This function can GC. GC checked 1997.04.06. */ | |
| 1998 Lisp_Object handler; | |
| 1999 struct gcpro gcpro1; | |
| 2000 | |
| 2001 CHECK_STRING (dirname_); | |
| 2002 | |
| 2003 GCPRO1 (dirname_); | |
| 2004 dirname_ = Fexpand_file_name (dirname_, Qnil); | |
| 2005 dirname_ = Fdirectory_file_name (dirname_); | |
| 2006 | |
| 2007 handler = Ffind_file_name_handler (dirname_, Qdelete_directory); | |
| 2008 UNGCPRO; | |
| 2009 if (!NILP (handler)) | |
| 2010 return (call2 (handler, Qdelete_directory, dirname_)); | |
| 2011 | |
| 771 | 2012 if (qxe_rmdir (XSTRING_DATA (dirname_)) != 0) |
| 563 | 2013 report_file_error ("Removing directory", dirname_); |
| 428 | 2014 |
| 2015 return Qnil; | |
| 2016 } | |
| 2017 | |
| 2018 DEFUN ("delete-file", Fdelete_file, 1, 1, "fDelete file: ", /* | |
| 442 | 2019 Delete the file named FILENAME (a string). |
| 2020 If FILENAME has multiple names, it continues to exist with the other names. | |
| 428 | 2021 */ |
| 2022 (filename)) | |
| 2023 { | |
| 2024 /* This function can GC. GC checked 1997.04.06. */ | |
| 2025 Lisp_Object handler; | |
| 2026 struct gcpro gcpro1; | |
| 2027 | |
| 2028 CHECK_STRING (filename); | |
| 2029 filename = Fexpand_file_name (filename, Qnil); | |
| 2030 | |
| 2031 GCPRO1 (filename); | |
| 2032 handler = Ffind_file_name_handler (filename, Qdelete_file); | |
| 2033 UNGCPRO; | |
| 2034 if (!NILP (handler)) | |
| 2035 return call2 (handler, Qdelete_file, filename); | |
| 2036 | |
| 771 | 2037 if (0 > qxe_unlink (XSTRING_DATA (filename))) |
| 563 | 2038 report_file_error ("Removing old name", filename); |
| 428 | 2039 return Qnil; |
| 2040 } | |
| 2041 | |
| 2042 static Lisp_Object | |
| 2286 | 2043 internal_delete_file_1 (Lisp_Object UNUSED (ignore), |
| 2044 Lisp_Object UNUSED (ignore2)) | |
| 428 | 2045 { |
| 2046 return Qt; | |
| 2047 } | |
| 2048 | |
| 2049 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */ | |
| 2050 | |
| 2051 int | |
| 2052 internal_delete_file (Lisp_Object filename) | |
| 2053 { | |
| 2054 /* This function can GC. GC checked 1997.04.06. */ | |
| 2055 return NILP (condition_case_1 (Qt, Fdelete_file, filename, | |
| 2056 internal_delete_file_1, Qnil)); | |
| 2057 } | |
| 2058 | |
| 2059 DEFUN ("rename-file", Frename_file, 2, 3, | |
| 2060 "fRename file: \nFRename %s to file: \np", /* | |
| 444 | 2061 Rename FILENAME as NEWNAME. Both args must be strings. |
| 2062 If file has names other than FILENAME, it continues to have those names. | |
| 428 | 2063 Signals a `file-already-exists' error if a file NEWNAME already exists |
| 2064 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil. | |
| 2065 A number as third arg means request confirmation if NEWNAME already exists. | |
| 2066 This is what happens in interactive use with M-x. | |
| 2067 */ | |
| 2068 (filename, newname, ok_if_already_exists)) | |
| 2069 { | |
| 2070 /* This function can GC. GC checked 1997.04.06. */ | |
| 2071 Lisp_Object handler; | |
| 2072 struct gcpro gcpro1, gcpro2; | |
| 2073 | |
| 2074 GCPRO2 (filename, newname); | |
| 2075 CHECK_STRING (filename); | |
| 2076 CHECK_STRING (newname); | |
| 2077 filename = Fexpand_file_name (filename, Qnil); | |
| 2078 newname = Fexpand_file_name (newname, Qnil); | |
| 2079 | |
| 2080 /* If the file name has special constructs in it, | |
| 2081 call the corresponding file handler. */ | |
| 2082 handler = Ffind_file_name_handler (filename, Qrename_file); | |
| 2083 if (NILP (handler)) | |
| 2084 handler = Ffind_file_name_handler (newname, Qrename_file); | |
| 2085 if (!NILP (handler)) | |
| 2086 { | |
| 2087 UNGCPRO; | |
| 2088 return call4 (handler, Qrename_file, | |
| 2089 filename, newname, ok_if_already_exists); | |
| 2090 } | |
| 2091 | |
| 2092 /* When second argument is a directory, rename the file into it. | |
| 2093 (rename-file "foo" "bar/") == (rename-file "foo" "bar/foo") | |
| 2094 */ | |
| 2095 if (!NILP (Ffile_directory_p (newname))) | |
| 2096 { | |
| 2097 Lisp_Object args[3]; | |
| 2098 struct gcpro ngcpro1; | |
| 2099 int i = 1; | |
| 2100 | |
| 2101 args[0] = newname; | |
| 2102 args[1] = Qnil; args[2] = Qnil; | |
| 2103 NGCPRO1 (*args); | |
| 2104 ngcpro1.nvars = 3; | |
| 826 | 2105 if (string_byte (newname, XSTRING_LENGTH (newname) - 1) != '/') |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4867
diff
changeset
|
2106 args[i++] = build_ascstring ("/"); |
| 428 | 2107 args[i++] = Ffile_name_nondirectory (filename); |
| 2108 newname = Fconcat (i, args); | |
| 2109 NUNGCPRO; | |
| 2110 } | |
| 2111 | |
| 2112 if (NILP (ok_if_already_exists) | |
| 2113 || INTP (ok_if_already_exists)) | |
| 2114 barf_or_query_if_file_exists (newname, "rename to it", | |
| 2115 INTP (ok_if_already_exists), 0); | |
| 2116 | |
| 442 | 2117 /* We have configure check for rename() and emulate using |
| 2118 link()/unlink() if necessary. */ | |
| 771 | 2119 if (0 > qxe_rename (XSTRING_DATA (filename), XSTRING_DATA (newname))) |
| 428 | 2120 { |
| 2121 if (errno == EXDEV) | |
| 2122 { | |
| 2123 Fcopy_file (filename, newname, | |
| 2124 /* We have already prompted if it was an integer, | |
| 2125 so don't have copy-file prompt again. */ | |
| 2126 (NILP (ok_if_already_exists) ? Qnil : Qt), | |
| 2127 Qt); | |
| 2128 Fdelete_file (filename); | |
| 2129 } | |
| 2130 else | |
| 2131 { | |
| 563 | 2132 report_file_error ("Renaming", list3 (Qunbound, filename, newname)); |
| 428 | 2133 } |
| 2134 } | |
| 2135 UNGCPRO; | |
| 2136 return Qnil; | |
| 2137 } | |
| 2138 | |
| 2139 DEFUN ("add-name-to-file", Fadd_name_to_file, 2, 3, | |
| 2140 "fAdd name to file: \nFName to add to %s: \np", /* | |
| 444 | 2141 Give FILENAME additional name NEWNAME. Both args must be strings. |
| 428 | 2142 Signals a `file-already-exists' error if a file NEWNAME already exists |
| 2143 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil. | |
| 2144 A number as third arg means request confirmation if NEWNAME already exists. | |
| 2145 This is what happens in interactive use with M-x. | |
| 2146 */ | |
| 2147 (filename, newname, ok_if_already_exists)) | |
| 2148 { | |
| 2149 /* This function can GC. GC checked 1997.04.06. */ | |
| 2150 Lisp_Object handler; | |
| 2151 struct gcpro gcpro1, gcpro2; | |
| 2152 | |
| 2153 GCPRO2 (filename, newname); | |
| 2154 CHECK_STRING (filename); | |
| 2155 CHECK_STRING (newname); | |
| 2156 filename = Fexpand_file_name (filename, Qnil); | |
| 2157 newname = Fexpand_file_name (newname, Qnil); | |
| 2158 | |
| 2159 /* If the file name has special constructs in it, | |
| 2160 call the corresponding file handler. */ | |
| 2161 handler = Ffind_file_name_handler (filename, Qadd_name_to_file); | |
| 2162 if (!NILP (handler)) | |
| 2163 RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, filename, | |
| 2164 newname, ok_if_already_exists)); | |
| 2165 | |
| 2166 /* If the new name has special constructs in it, | |
| 2167 call the corresponding file handler. */ | |
| 2168 handler = Ffind_file_name_handler (newname, Qadd_name_to_file); | |
| 2169 if (!NILP (handler)) | |
| 2170 RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, filename, | |
| 2171 newname, ok_if_already_exists)); | |
| 2172 | |
| 2173 if (NILP (ok_if_already_exists) | |
| 2174 || INTP (ok_if_already_exists)) | |
| 2175 barf_or_query_if_file_exists (newname, "make it a new name", | |
| 2176 INTP (ok_if_already_exists), 0); | |
| 771 | 2177 /* #### Emacs 20.6 contains an implementation of link() in w32.c. |
| 2178 Need to port. */ | |
| 2179 #ifndef HAVE_LINK | |
| 563 | 2180 signal_error_2 (Qunimplemented, "Adding new name", filename, newname); |
| 771 | 2181 #else /* HAVE_LINK */ |
| 2182 qxe_unlink (XSTRING_DATA (newname)); | |
| 2183 if (0 > qxe_link (XSTRING_DATA (filename), XSTRING_DATA (newname))) | |
| 428 | 2184 { |
| 2185 report_file_error ("Adding new name", | |
| 563 | 2186 list3 (Qunbound, filename, newname)); |
| 428 | 2187 } |
| 771 | 2188 #endif /* HAVE_LINK */ |
| 428 | 2189 |
| 2190 UNGCPRO; | |
| 2191 return Qnil; | |
| 2192 } | |
| 2193 | |
| 2194 DEFUN ("make-symbolic-link", Fmake_symbolic_link, 2, 3, | |
| 2195 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np", /* | |
| 2196 Make a symbolic link to FILENAME, named LINKNAME. Both args strings. | |
| 2197 Signals a `file-already-exists' error if a file LINKNAME already exists | |
| 2198 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil. | |
| 2199 A number as third arg means request confirmation if LINKNAME already exists. | |
| 2200 This happens for interactive use with M-x. | |
|
4465
732b87cfabf2
Document Win32 symlink behaviour; adjust tests to take it into a/c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4383
diff
changeset
|
2201 |
|
732b87cfabf2
Document Win32 symlink behaviour; adjust tests to take it into a/c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4383
diff
changeset
|
2202 On platforms where symbolic links are not available, any file handlers will |
|
732b87cfabf2
Document Win32 symlink behaviour; adjust tests to take it into a/c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4383
diff
changeset
|
2203 be run, but the check for the existence of LINKNAME will not be done, and |
|
732b87cfabf2
Document Win32 symlink behaviour; adjust tests to take it into a/c.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4383
diff
changeset
|
2204 the symbolic link will not be created. |
| 428 | 2205 */ |
| 2206 (filename, linkname, ok_if_already_exists)) | |
| 2207 { | |
| 2208 /* This function can GC. GC checked 1997.06.04. */ | |
| 442 | 2209 /* XEmacs change: run handlers even if local machine doesn't have symlinks */ |
| 428 | 2210 Lisp_Object handler; |
| 2211 struct gcpro gcpro1, gcpro2; | |
| 2212 | |
| 2213 GCPRO2 (filename, linkname); | |
| 2214 CHECK_STRING (filename); | |
| 2215 CHECK_STRING (linkname); | |
| 2216 /* If the link target has a ~, we must expand it to get | |
| 2217 a truly valid file name. Otherwise, do not expand; | |
| 2218 we want to permit links to relative file names. */ | |
| 826 | 2219 if (string_byte (filename, 0) == '~') |
| 428 | 2220 filename = Fexpand_file_name (filename, Qnil); |
| 2221 linkname = Fexpand_file_name (linkname, Qnil); | |
| 2222 | |
| 2223 /* If the file name has special constructs in it, | |
| 2224 call the corresponding file handler. */ | |
| 2225 handler = Ffind_file_name_handler (filename, Qmake_symbolic_link); | |
| 2226 if (!NILP (handler)) | |
| 2227 RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename, linkname, | |
| 2228 ok_if_already_exists)); | |
| 2229 | |
| 2230 /* If the new link name has special constructs in it, | |
| 2231 call the corresponding file handler. */ | |
| 2232 handler = Ffind_file_name_handler (linkname, Qmake_symbolic_link); | |
| 2233 if (!NILP (handler)) | |
| 2234 RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename, | |
| 2235 linkname, ok_if_already_exists)); | |
| 2236 | |
| 771 | 2237 #ifdef HAVE_SYMLINK |
| 428 | 2238 if (NILP (ok_if_already_exists) |
| 2239 || INTP (ok_if_already_exists)) | |
| 2240 barf_or_query_if_file_exists (linkname, "make it a link", | |
| 2241 INTP (ok_if_already_exists), 0); | |
| 2242 | |
| 771 | 2243 qxe_unlink (XSTRING_DATA (linkname)); |
| 2244 if (0 > qxe_symlink (XSTRING_DATA (filename), | |
| 2245 XSTRING_DATA (linkname))) | |
| 428 | 2246 { |
| 2247 report_file_error ("Making symbolic link", | |
| 563 | 2248 list3 (Qunbound, filename, linkname)); |
| 428 | 2249 } |
| 771 | 2250 #endif |
| 442 | 2251 |
| 428 | 2252 UNGCPRO; |
| 2253 return Qnil; | |
| 2254 } | |
| 2255 | |
| 2256 #ifdef HPUX_NET | |
| 2257 | |
| 2258 DEFUN ("sysnetunam", Fsysnetunam, 2, 2, 0, /* | |
| 2259 Open a network connection to PATH using LOGIN as the login string. | |
| 2260 */ | |
| 2261 (path, login)) | |
| 2262 { | |
| 2263 int netresult; | |
| 1333 | 2264 const Extbyte *path_ext; |
| 2265 const Extbyte *login_ext; | |
| 428 | 2266 |
| 2267 CHECK_STRING (path); | |
| 2268 CHECK_STRING (login); | |
| 2269 | |
| 2270 /* netunam, being a strange-o system call only used once, is not | |
| 2271 encapsulated. */ | |
| 440 | 2272 |
| 442 | 2273 LISP_STRING_TO_EXTERNAL (path, path_ext, Qfile_name); |
|
4834
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2274 LISP_STRING_TO_EXTERNAL (login, login_ext, Quser_name_encoding); |
| 440 | 2275 |
| 2276 netresult = netunam (path_ext, login_ext); | |
| 2277 | |
| 2278 return netresult == -1 ? Qnil : Qt; | |
| 428 | 2279 } |
| 2280 #endif /* HPUX_NET */ | |
| 2281 | |
| 2282 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p, 1, 1, 0, /* | |
| 2283 Return t if file FILENAME specifies an absolute path name. | |
| 2284 On Unix, this is a name starting with a `/' or a `~'. | |
| 2285 */ | |
| 2286 (filename)) | |
| 2287 { | |
| 2288 /* This function does not GC */ | |
| 867 | 2289 Ibyte *ptr; |
| 428 | 2290 |
| 2291 CHECK_STRING (filename); | |
| 2292 ptr = XSTRING_DATA (filename); | |
| 2293 return (IS_DIRECTORY_SEP (*ptr) || *ptr == '~' | |
| 657 | 2294 #ifdef WIN32_FILENAMES |
| 428 | 2295 || (IS_DRIVE (*ptr) && ptr[1] == ':' && IS_DIRECTORY_SEP (ptr[2])) |
| 2296 #endif | |
| 2297 ) ? Qt : Qnil; | |
| 2298 } | |
| 2299 | |
| 2300 /* Return nonzero if file FILENAME exists and can be executed. */ | |
| 2301 | |
| 2302 static int | |
| 771 | 2303 check_executable (Lisp_Object filename) |
| 428 | 2304 { |
| 442 | 2305 #ifdef WIN32_NATIVE |
| 428 | 2306 struct stat st; |
| 771 | 2307 if (qxe_stat (XSTRING_DATA (filename), &st) < 0) |
| 428 | 2308 return 0; |
| 2309 return ((st.st_mode & S_IEXEC) != 0); | |
| 442 | 2310 #else /* not WIN32_NATIVE */ |
| 428 | 2311 #ifdef HAVE_EACCESS |
| 771 | 2312 return qxe_eaccess (XSTRING_DATA (filename), X_OK) >= 0; |
| 428 | 2313 #else |
| 2314 /* Access isn't quite right because it uses the real uid | |
| 2315 and we really want to test with the effective uid. | |
| 2316 But Unix doesn't give us a right way to do it. */ | |
| 771 | 2317 return qxe_access (XSTRING_DATA (filename), X_OK) >= 0; |
| 428 | 2318 #endif /* HAVE_EACCESS */ |
| 442 | 2319 #endif /* not WIN32_NATIVE */ |
| 428 | 2320 } |
| 2321 | |
| 2322 /* Return nonzero if file FILENAME exists and can be written. */ | |
| 2323 | |
| 2324 static int | |
| 867 | 2325 check_writable (const Ibyte *filename) |
| 428 | 2326 { |
|
4834
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2327 #ifdef WIN32_ANY |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2328 // Since this has to work for a directory, we can't just call 'CreateFile' |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2329 PSECURITY_DESCRIPTOR pDesc; /* Must be freed with LocalFree */ |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2330 /* these need not be freed, they point into pDesc */ |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2331 PSID psidOwner; |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2332 PSID psidGroup; |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2333 PACL pDacl; |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2334 PACL pSacl; |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2335 /* end of insides of descriptor */ |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2336 DWORD error; |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2337 DWORD attributes; |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2338 HANDLE tokenHandle; |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2339 GENERIC_MAPPING genericMapping; |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2340 DWORD accessMask; |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2341 PRIVILEGE_SET PrivilegeSet; |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2342 DWORD dwPrivSetSize = sizeof( PRIVILEGE_SET ); |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2343 BOOL fAccessGranted = FALSE; |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2344 DWORD dwAccessAllowed; |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2345 Extbyte *fnameext; |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2346 |
|
4867
7822019c5d98
Revert cast in check_writable() and fix up macros to use const.
Vin Shelton <acs@xemacs.org>
parents:
4864
diff
changeset
|
2347 LOCAL_FILE_FORMAT_TO_TSTR (filename, fnameext); |
|
4834
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2348 |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2349 // First check for a normal file with the old-style readonly bit |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2350 attributes = qxeGetFileAttributes(fnameext); |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2351 if (FILE_ATTRIBUTE_READONLY == (attributes & (FILE_ATTRIBUTE_DIRECTORY|FILE_ATTRIBUTE_READONLY))) |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2352 return 0; |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2353 |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2354 /* Win32 prototype lacks const. */ |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2355 error = qxeGetNamedSecurityInfo(fnameext, SE_FILE_OBJECT, |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2356 DACL_SECURITY_INFORMATION|GROUP_SECURITY_INFORMATION|OWNER_SECURITY_INFORMATION, |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2357 &psidOwner, &psidGroup, &pDacl, &pSacl, &pDesc); |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2358 if(error != ERROR_SUCCESS) { // FAT? |
| 3781 | 2359 attributes = qxeGetFileAttributes(fnameext); |
|
4834
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2360 return (attributes & FILE_ATTRIBUTE_DIRECTORY) || (0 == (attributes & FILE_ATTRIBUTE_READONLY)); |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2361 } |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2362 |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2363 genericMapping.GenericRead = FILE_GENERIC_READ; |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2364 genericMapping.GenericWrite = FILE_GENERIC_WRITE; |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2365 genericMapping.GenericExecute = FILE_GENERIC_EXECUTE; |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2366 genericMapping.GenericAll = FILE_ALL_ACCESS; |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2367 |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2368 if(!ImpersonateSelf(SecurityDelegation)) { |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2369 return 0; |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2370 } |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2371 if(!OpenThreadToken(GetCurrentThread(), TOKEN_ALL_ACCESS, TRUE, &tokenHandle)) { |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2372 return 0; |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2373 } |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2374 |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2375 accessMask = GENERIC_WRITE; |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2376 MapGenericMask(&accessMask, &genericMapping); |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2377 |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2378 if(!AccessCheck(pDesc, tokenHandle, accessMask, &genericMapping, |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2379 &PrivilegeSet, // receives privileges used in check |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2380 &dwPrivSetSize, // size of PrivilegeSet buffer |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2381 &dwAccessAllowed, // receives mask of allowed access rights |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2382 &fAccessGranted)) |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2383 { |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2384 CloseHandle(tokenHandle); |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2385 RevertToSelf(); |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2386 LocalFree(pDesc); |
| 3781 | 2387 return 0; |
|
4834
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2388 } |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2389 CloseHandle(tokenHandle); |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2390 RevertToSelf(); |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2391 LocalFree(pDesc); |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2392 return fAccessGranted == TRUE; |
|
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2393 #elif defined (HAVE_EACCESS) |
| 771 | 2394 return (qxe_eaccess (filename, W_OK) >= 0); |
| 428 | 2395 #else |
| 2396 /* Access isn't quite right because it uses the real uid | |
| 2397 and we really want to test with the effective uid. | |
| 2398 But Unix doesn't give us a right way to do it. | |
| 2399 Opening with O_WRONLY could work for an ordinary file, | |
| 2400 but would lose for directories. */ | |
| 771 | 2401 return (qxe_access (filename, W_OK) >= 0); |
|
4834
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4826
diff
changeset
|
2402 #endif /* (not) defined (HAVE_EACCESS) */ |
| 428 | 2403 } |
| 2404 | |
| 2405 DEFUN ("file-exists-p", Ffile_exists_p, 1, 1, 0, /* | |
| 2406 Return t if file FILENAME exists. (This does not mean you can read it.) | |
| 2407 See also `file-readable-p' and `file-attributes'. | |
| 2408 */ | |
| 2409 (filename)) | |
| 2410 { | |
| 442 | 2411 /* This function can call lisp; GC checked 2000-07-11 ben */ |
| 428 | 2412 Lisp_Object abspath; |
| 2413 Lisp_Object handler; | |
| 2414 struct stat statbuf; | |
| 2415 struct gcpro gcpro1; | |
| 2416 | |
| 2417 CHECK_STRING (filename); | |
| 2418 abspath = Fexpand_file_name (filename, Qnil); | |
| 2419 | |
| 2420 /* If the file name has special constructs in it, | |
| 2421 call the corresponding file handler. */ | |
| 2422 GCPRO1 (abspath); | |
| 2423 handler = Ffind_file_name_handler (abspath, Qfile_exists_p); | |
| 2424 UNGCPRO; | |
| 2425 if (!NILP (handler)) | |
| 2426 return call2 (handler, Qfile_exists_p, abspath); | |
| 2427 | |
| 771 | 2428 return qxe_stat (XSTRING_DATA (abspath), &statbuf) >= 0 ? Qt : Qnil; |
| 428 | 2429 } |
| 2430 | |
| 2431 DEFUN ("file-executable-p", Ffile_executable_p, 1, 1, 0, /* | |
| 2432 Return t if FILENAME can be executed by you. | |
| 2433 For a directory, this means you can access files in that directory. | |
| 2434 */ | |
| 2435 (filename)) | |
| 2436 | |
| 2437 { | |
| 442 | 2438 /* This function can GC. GC checked 07-11-2000 ben. */ |
| 428 | 2439 Lisp_Object abspath; |
| 2440 Lisp_Object handler; | |
| 2441 struct gcpro gcpro1; | |
| 2442 | |
| 2443 CHECK_STRING (filename); | |
| 2444 abspath = Fexpand_file_name (filename, Qnil); | |
| 2445 | |
| 2446 /* If the file name has special constructs in it, | |
| 2447 call the corresponding file handler. */ | |
| 2448 GCPRO1 (abspath); | |
| 2449 handler = Ffind_file_name_handler (abspath, Qfile_executable_p); | |
| 2450 UNGCPRO; | |
| 2451 if (!NILP (handler)) | |
| 2452 return call2 (handler, Qfile_executable_p, abspath); | |
| 2453 | |
| 771 | 2454 return check_executable (abspath) ? Qt : Qnil; |
| 428 | 2455 } |
| 2456 | |
| 2457 DEFUN ("file-readable-p", Ffile_readable_p, 1, 1, 0, /* | |
| 2458 Return t if file FILENAME exists and you can read it. | |
| 2459 See also `file-exists-p' and `file-attributes'. | |
| 2460 */ | |
| 2461 (filename)) | |
| 2462 { | |
| 2463 /* This function can GC */ | |
| 2464 Lisp_Object abspath = Qnil; | |
| 2465 Lisp_Object handler; | |
| 2466 struct gcpro gcpro1; | |
| 2467 GCPRO1 (abspath); | |
| 2468 | |
| 2469 CHECK_STRING (filename); | |
| 2470 abspath = Fexpand_file_name (filename, Qnil); | |
| 2471 | |
| 2472 /* If the file name has special constructs in it, | |
| 2473 call the corresponding file handler. */ | |
| 2474 handler = Ffind_file_name_handler (abspath, Qfile_readable_p); | |
| 2475 if (!NILP (handler)) | |
| 2476 RETURN_UNGCPRO (call2 (handler, Qfile_readable_p, abspath)); | |
| 2477 | |
| 2526 | 2478 #if defined (WIN32_FILENAMES) |
| 428 | 2479 /* Under MS-DOS and Windows, open does not work for directories. */ |
| 2480 UNGCPRO; | |
| 771 | 2481 if (qxe_access (XSTRING_DATA (abspath), 0) == 0) |
| 428 | 2482 return Qt; |
| 2483 else | |
| 2484 return Qnil; | |
| 657 | 2485 #else /* not WIN32_FILENAMES */ |
| 428 | 2486 { |
| 771 | 2487 int desc = qxe_interruptible_open (XSTRING_DATA (abspath), |
| 2488 O_RDONLY | OPEN_BINARY, 0); | |
| 428 | 2489 UNGCPRO; |
| 2490 if (desc < 0) | |
| 2491 return Qnil; | |
| 771 | 2492 retry_close (desc); |
| 428 | 2493 return Qt; |
| 2494 } | |
| 657 | 2495 #endif /* not WIN32_FILENAMES */ |
| 428 | 2496 } |
| 2497 | |
| 2498 /* Having this before file-symlink-p mysteriously caused it to be forgotten | |
| 2499 on the RT/PC. */ | |
| 2500 DEFUN ("file-writable-p", Ffile_writable_p, 1, 1, 0, /* | |
| 2501 Return t if file FILENAME can be written or created by you. | |
| 2502 */ | |
| 2503 (filename)) | |
| 2504 { | |
| 2505 /* This function can GC. GC checked 1997.04.10. */ | |
| 2506 Lisp_Object abspath, dir; | |
| 2507 Lisp_Object handler; | |
| 2508 struct stat statbuf; | |
| 2509 struct gcpro gcpro1; | |
| 2510 | |
| 2511 CHECK_STRING (filename); | |
| 2512 abspath = Fexpand_file_name (filename, Qnil); | |
| 2513 | |
| 2514 /* If the file name has special constructs in it, | |
| 2515 call the corresponding file handler. */ | |
| 2516 GCPRO1 (abspath); | |
| 2517 handler = Ffind_file_name_handler (abspath, Qfile_writable_p); | |
| 2518 UNGCPRO; | |
| 2519 if (!NILP (handler)) | |
| 2520 return call2 (handler, Qfile_writable_p, abspath); | |
| 2521 | |
| 771 | 2522 if (qxe_stat (XSTRING_DATA (abspath), &statbuf) >= 0) |
| 2523 return (check_writable (XSTRING_DATA (abspath)) | |
| 428 | 2524 ? Qt : Qnil); |
| 2525 | |
| 2526 | |
| 2527 GCPRO1 (abspath); | |
| 2528 dir = Ffile_name_directory (abspath); | |
| 2529 UNGCPRO; | |
| 867 | 2530 return (check_writable (!NILP (dir) ? XSTRING_DATA (dir) : (Ibyte *) "") |
| 428 | 2531 ? Qt : Qnil); |
| 2532 } | |
| 2533 | |
| 2534 DEFUN ("file-symlink-p", Ffile_symlink_p, 1, 1, 0, /* | |
| 2535 Return non-nil if file FILENAME is the name of a symbolic link. | |
| 2536 The value is the name of the file to which it is linked. | |
| 2537 Otherwise returns nil. | |
| 2538 */ | |
| 2539 (filename)) | |
| 2540 { | |
| 2541 /* This function can GC. GC checked 1997.04.10. */ | |
| 442 | 2542 /* XEmacs change: run handlers even if local machine doesn't have symlinks */ |
| 771 | 2543 #ifdef HAVE_READLINK |
| 867 | 2544 Ibyte *buf; |
| 428 | 2545 int bufsize; |
| 2546 int valsize; | |
| 2547 Lisp_Object val; | |
| 442 | 2548 #endif |
| 428 | 2549 Lisp_Object handler; |
| 2550 struct gcpro gcpro1; | |
| 2551 | |
| 2552 CHECK_STRING (filename); | |
| 2553 filename = Fexpand_file_name (filename, Qnil); | |
| 2554 | |
| 2555 /* If the file name has special constructs in it, | |
| 2556 call the corresponding file handler. */ | |
| 2557 GCPRO1 (filename); | |
| 2558 handler = Ffind_file_name_handler (filename, Qfile_symlink_p); | |
| 2559 UNGCPRO; | |
| 2560 if (!NILP (handler)) | |
| 2561 return call2 (handler, Qfile_symlink_p, filename); | |
| 2562 | |
| 771 | 2563 #ifdef HAVE_READLINK |
| 428 | 2564 bufsize = 100; |
| 2565 while (1) | |
| 2566 { | |
| 867 | 2567 buf = xnew_array_and_zero (Ibyte, bufsize); |
| 771 | 2568 valsize = qxe_readlink (XSTRING_DATA (filename), |
| 2569 buf, bufsize); | |
| 428 | 2570 if (valsize < bufsize) break; |
| 2571 /* Buffer was not long enough */ | |
| 1726 | 2572 xfree (buf, Ibyte *); |
| 428 | 2573 bufsize *= 2; |
| 2574 } | |
| 2575 if (valsize == -1) | |
| 2576 { | |
| 1726 | 2577 xfree (buf, Ibyte *); |
| 428 | 2578 return Qnil; |
| 2579 } | |
| 771 | 2580 val = make_string (buf, valsize); |
| 1726 | 2581 xfree (buf, Ibyte *); |
| 428 | 2582 return val; |
| 2526 | 2583 #elif defined (WIN32_NATIVE) |
| 2584 if (mswindows_shortcuts_are_symlinks) | |
| 2585 { | |
| 2586 /* We want to resolve the directory component and leave the rest | |
| 2587 alone. */ | |
| 2588 Ibyte *path = XSTRING_DATA (filename); | |
| 2589 Ibyte *dirend = | |
| 2590 find_end_of_directory_component (path, XSTRING_LENGTH (filename)); | |
| 2591 Ibyte *fname; | |
| 2592 DECLARE_EISTRING (dir); | |
| 2593 | |
| 2594 if (dirend != path) | |
| 2595 { | |
| 2596 Ibyte *resdir; | |
| 2597 DECLARE_EISTRING (resname); | |
| 2598 | |
| 2599 eicpy_raw (dir, path, dirend - path); | |
| 2600 PATHNAME_RESOLVE_LINKS (eidata (dir), resdir); | |
| 2601 eicpy_rawz (resname, resdir); | |
| 2602 eicat_rawz (resname, dirend); | |
| 2603 path = eidata (resname); | |
| 2604 } | |
| 2605 | |
| 2606 fname = mswindows_read_link (path); | |
| 2607 if (!fname) | |
| 2608 return Qnil; | |
| 2609 { | |
| 2610 Lisp_Object val = build_intstring (fname); | |
| 2611 xfree (fname, Ibyte *); | |
| 2612 return val; | |
| 2613 } | |
| 2614 } | |
| 428 | 2615 return Qnil; |
| 2526 | 2616 #else |
| 2617 return Qnil; | |
| 2618 #endif | |
| 428 | 2619 } |
| 2620 | |
| 2621 DEFUN ("file-directory-p", Ffile_directory_p, 1, 1, 0, /* | |
| 2622 Return t if file FILENAME is the name of a directory as a file. | |
| 2623 A directory name spec may be given instead; then the value is t | |
| 2624 if the directory so specified exists and really is a directory. | |
| 2625 */ | |
| 2626 (filename)) | |
| 2627 { | |
| 2628 /* This function can GC. GC checked 1997.04.10. */ | |
| 2629 Lisp_Object abspath; | |
| 2630 struct stat st; | |
| 2631 Lisp_Object handler; | |
| 2632 struct gcpro gcpro1; | |
| 2633 | |
| 2634 GCPRO1 (current_buffer->directory); | |
| 2635 abspath = expand_and_dir_to_file (filename, | |
| 2636 current_buffer->directory); | |
| 2637 UNGCPRO; | |
| 2638 | |
| 2639 /* If the file name has special constructs in it, | |
| 2640 call the corresponding file handler. */ | |
| 2641 GCPRO1 (abspath); | |
| 2642 handler = Ffind_file_name_handler (abspath, Qfile_directory_p); | |
| 2643 UNGCPRO; | |
| 2644 if (!NILP (handler)) | |
| 2645 return call2 (handler, Qfile_directory_p, abspath); | |
| 2646 | |
| 771 | 2647 if (qxe_stat (XSTRING_DATA (abspath), &st) < 0) |
| 428 | 2648 return Qnil; |
| 2649 return (st.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil; | |
| 2650 } | |
| 2651 | |
| 2652 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p, 1, 1, 0, /* | |
| 2653 Return t if file FILENAME is the name of a directory as a file, | |
| 2654 and files in that directory can be opened by you. In order to use a | |
| 2655 directory as a buffer's current directory, this predicate must return true. | |
| 2656 A directory name spec may be given instead; then the value is t | |
| 2657 if the directory so specified exists and really is a readable and | |
| 2658 searchable directory. | |
| 2659 */ | |
| 2660 (filename)) | |
| 2661 { | |
| 2662 /* This function can GC. GC checked 1997.04.10. */ | |
| 2663 Lisp_Object handler; | |
| 2664 | |
| 2665 /* If the file name has special constructs in it, | |
| 2666 call the corresponding file handler. */ | |
| 2667 handler = Ffind_file_name_handler (filename, Qfile_accessible_directory_p); | |
| 2668 if (!NILP (handler)) | |
| 2669 return call2 (handler, Qfile_accessible_directory_p, | |
| 2670 filename); | |
| 2671 | |
| 2526 | 2672 #if !defined (WIN32_NATIVE) |
| 428 | 2673 if (NILP (Ffile_directory_p (filename))) |
| 2674 return (Qnil); | |
| 2675 else | |
| 2676 return Ffile_executable_p (filename); | |
| 2677 #else | |
| 2678 { | |
| 2679 int tem; | |
| 2680 struct gcpro gcpro1; | |
| 2681 /* It's an unlikely combination, but yes we really do need to gcpro: | |
| 2682 Suppose that file-accessible-directory-p has no handler, but | |
| 2683 file-directory-p does have a handler; this handler causes a GC which | |
| 2684 relocates the string in `filename'; and finally file-directory-p | |
| 2685 returns non-nil. Then we would end up passing a garbaged string | |
| 2686 to file-executable-p. */ | |
| 2687 GCPRO1 (filename); | |
| 2688 tem = (NILP (Ffile_directory_p (filename)) | |
| 2689 || NILP (Ffile_executable_p (filename))); | |
| 2690 UNGCPRO; | |
| 2691 return tem ? Qnil : Qt; | |
| 2692 } | |
| 442 | 2693 #endif /* !defined(WIN32_NATIVE) */ |
| 428 | 2694 } |
| 2695 | |
| 2696 DEFUN ("file-regular-p", Ffile_regular_p, 1, 1, 0, /* | |
| 2697 Return t if file FILENAME is the name of a regular file. | |
| 2698 This is the sort of file that holds an ordinary stream of data bytes. | |
| 2699 */ | |
| 2700 (filename)) | |
| 2701 { | |
| 2702 /* This function can GC. GC checked 1997.04.10. */ | |
| 2703 Lisp_Object abspath; | |
| 2704 struct stat st; | |
| 2705 Lisp_Object handler; | |
| 2706 struct gcpro gcpro1; | |
| 2707 | |
| 2708 GCPRO1 (current_buffer->directory); | |
| 2709 abspath = expand_and_dir_to_file (filename, current_buffer->directory); | |
| 2710 UNGCPRO; | |
| 2711 | |
| 2712 /* If the file name has special constructs in it, | |
| 2713 call the corresponding file handler. */ | |
| 2714 GCPRO1 (abspath); | |
| 2715 handler = Ffind_file_name_handler (abspath, Qfile_regular_p); | |
| 2716 UNGCPRO; | |
| 2717 if (!NILP (handler)) | |
| 2718 return call2 (handler, Qfile_regular_p, abspath); | |
| 2719 | |
| 771 | 2720 if (qxe_stat (XSTRING_DATA (abspath), &st) < 0) |
| 428 | 2721 return Qnil; |
| 2722 return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil; | |
| 2723 } | |
| 2724 | |
| 2725 DEFUN ("file-modes", Ffile_modes, 1, 1, 0, /* | |
| 444 | 2726 Return mode bits of file named FILENAME, as an integer. |
| 428 | 2727 */ |
| 2728 (filename)) | |
| 2729 { | |
| 2730 /* This function can GC. GC checked 1997.04.10. */ | |
| 2731 Lisp_Object abspath; | |
| 2732 struct stat st; | |
| 2733 Lisp_Object handler; | |
| 2734 struct gcpro gcpro1; | |
| 2735 | |
| 2736 GCPRO1 (current_buffer->directory); | |
| 2737 abspath = expand_and_dir_to_file (filename, | |
| 2738 current_buffer->directory); | |
| 2739 UNGCPRO; | |
| 2740 | |
| 2741 /* If the file name has special constructs in it, | |
| 2742 call the corresponding file handler. */ | |
| 2743 GCPRO1 (abspath); | |
| 2744 handler = Ffind_file_name_handler (abspath, Qfile_modes); | |
| 2745 UNGCPRO; | |
| 2746 if (!NILP (handler)) | |
| 2747 return call2 (handler, Qfile_modes, abspath); | |
| 2748 | |
| 771 | 2749 if (qxe_stat (XSTRING_DATA (abspath), &st) < 0) |
| 428 | 2750 return Qnil; |
| 2751 /* Syncing with FSF 19.34.6 note: not in FSF, #if 0'ed out here. */ | |
| 2752 #if 0 | |
| 442 | 2753 #ifdef WIN32_NATIVE |
| 771 | 2754 if (check_executable (abspath)) |
| 428 | 2755 st.st_mode |= S_IEXEC; |
| 442 | 2756 #endif /* WIN32_NATIVE */ |
| 428 | 2757 #endif /* 0 */ |
| 2758 | |
| 2759 return make_int (st.st_mode & 07777); | |
| 2760 } | |
| 2761 | |
| 2762 DEFUN ("set-file-modes", Fset_file_modes, 2, 2, 0, /* | |
| 444 | 2763 Set mode bits of file named FILENAME to MODE (an integer). |
| 428 | 2764 Only the 12 low bits of MODE are used. |
| 2765 */ | |
| 2766 (filename, mode)) | |
| 2767 { | |
| 2768 /* This function can GC. GC checked 1997.04.10. */ | |
| 2769 Lisp_Object abspath; | |
| 2770 Lisp_Object handler; | |
| 2771 struct gcpro gcpro1; | |
| 2772 | |
| 2773 GCPRO1 (current_buffer->directory); | |
| 2774 abspath = Fexpand_file_name (filename, current_buffer->directory); | |
| 2775 UNGCPRO; | |
| 2776 | |
| 2777 CHECK_INT (mode); | |
| 2778 | |
| 2779 /* If the file name has special constructs in it, | |
| 2780 call the corresponding file handler. */ | |
| 2781 GCPRO1 (abspath); | |
| 2782 handler = Ffind_file_name_handler (abspath, Qset_file_modes); | |
| 2783 UNGCPRO; | |
| 2784 if (!NILP (handler)) | |
| 2785 return call3 (handler, Qset_file_modes, abspath, mode); | |
| 2786 | |
| 771 | 2787 if (qxe_chmod (XSTRING_DATA (abspath), XINT (mode)) < 0) |
| 563 | 2788 report_file_error ("Doing chmod", abspath); |
| 428 | 2789 |
| 2790 return Qnil; | |
| 2791 } | |
| 2792 | |
| 2793 DEFUN ("set-default-file-modes", Fset_default_file_modes, 1, 1, 0, /* | |
| 2794 Set the file permission bits for newly created files. | |
| 444 | 2795 The argument MODE should be an integer; if a bit in MODE is 1, |
| 2796 subsequently created files will not have the permission corresponding | |
| 2797 to that bit enabled. Only the low 9 bits are used. | |
| 428 | 2798 This setting is inherited by subprocesses. |
| 2799 */ | |
| 2800 (mode)) | |
| 2801 { | |
| 2802 CHECK_INT (mode); | |
| 2803 | |
| 2804 umask ((~ XINT (mode)) & 0777); | |
| 2805 | |
| 2806 return Qnil; | |
| 2807 } | |
| 2808 | |
| 2809 DEFUN ("default-file-modes", Fdefault_file_modes, 0, 0, 0, /* | |
| 2810 Return the default file protection for created files. | |
| 2811 The umask value determines which permissions are enabled in newly | |
| 2812 created files. If a permission's bit in the umask is 1, subsequently | |
| 2813 created files will not have that permission enabled. | |
| 2814 */ | |
| 2815 ()) | |
| 2816 { | |
| 2817 int mode; | |
| 2818 | |
| 2819 mode = umask (0); | |
| 2820 umask (mode); | |
| 2821 | |
| 2822 return make_int ((~ mode) & 0777); | |
| 2823 } | |
| 2824 | |
| 2825 DEFUN ("unix-sync", Funix_sync, 0, 0, "", /* | |
| 2826 Tell Unix to finish all pending disk updates. | |
| 2827 */ | |
| 2828 ()) | |
| 2829 { | |
| 442 | 2830 #ifndef WIN32_NATIVE |
| 428 | 2831 sync (); |
| 2832 #endif | |
| 2833 return Qnil; | |
| 2834 } | |
| 2835 | |
| 2836 | |
| 2837 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p, 2, 2, 0, /* | |
| 2838 Return t if file FILE1 is newer than file FILE2. | |
| 2839 If FILE1 does not exist, the answer is nil; | |
| 2840 otherwise, if FILE2 does not exist, the answer is t. | |
| 2841 */ | |
| 2842 (file1, file2)) | |
| 2843 { | |
| 2844 /* This function can GC. GC checked 1997.04.10. */ | |
| 2845 Lisp_Object abspath1, abspath2; | |
| 2846 struct stat st; | |
| 2847 int mtime1; | |
| 2848 Lisp_Object handler; | |
| 2849 struct gcpro gcpro1, gcpro2, gcpro3; | |
| 2850 | |
| 2851 CHECK_STRING (file1); | |
| 2852 CHECK_STRING (file2); | |
| 2853 | |
| 2854 abspath1 = Qnil; | |
| 2855 abspath2 = Qnil; | |
| 2856 | |
| 2857 GCPRO3 (abspath1, abspath2, current_buffer->directory); | |
| 2858 abspath1 = expand_and_dir_to_file (file1, current_buffer->directory); | |
| 2859 abspath2 = expand_and_dir_to_file (file2, current_buffer->directory); | |
| 2860 | |
| 2861 /* If the file name has special constructs in it, | |
| 2862 call the corresponding file handler. */ | |
| 2863 handler = Ffind_file_name_handler (abspath1, Qfile_newer_than_file_p); | |
| 2864 if (NILP (handler)) | |
| 2865 handler = Ffind_file_name_handler (abspath2, Qfile_newer_than_file_p); | |
| 2866 UNGCPRO; | |
| 2867 if (!NILP (handler)) | |
| 2868 return call3 (handler, Qfile_newer_than_file_p, abspath1, | |
| 2869 abspath2); | |
| 2870 | |
| 771 | 2871 if (qxe_stat (XSTRING_DATA (abspath1), &st) < 0) |
| 428 | 2872 return Qnil; |
| 2873 | |
| 2874 mtime1 = st.st_mtime; | |
| 2875 | |
| 771 | 2876 if (qxe_stat (XSTRING_DATA (abspath2), &st) < 0) |
| 428 | 2877 return Qt; |
| 2878 | |
| 2879 return (mtime1 > st.st_mtime) ? Qt : Qnil; | |
| 2880 } | |
| 2881 | |
| 2882 | |
| 2883 /* Stack sizes > 2**16 is a good way to elicit compiler bugs */ | |
| 2884 /* #define READ_BUF_SIZE (2 << 16) */ | |
| 2885 #define READ_BUF_SIZE (1 << 15) | |
| 2886 | |
| 2887 DEFUN ("insert-file-contents-internal", Finsert_file_contents_internal, | |
| 2888 1, 7, 0, /* | |
| 2889 Insert contents of file FILENAME after point; no coding-system frobbing. | |
| 2890 This function is identical to `insert-file-contents' except for the | |
| 771 | 2891 handling of the CODESYS and USED-CODESYS arguments. |
| 2892 | |
| 2893 The file is decoded according to CODESYS; if omitted, no conversion | |
| 2894 happens. If USED-CODESYS is non-nil, it should be a symbol, and the actual | |
| 2895 coding system that was used for the decoding is stored into it. It will in | |
| 2896 general be different from CODESYS if CODESYS specifies automatic encoding | |
| 2897 detection or end-of-line detection. | |
| 428 | 2898 |
| 444 | 2899 Currently START and END refer to byte positions (as opposed to character |
| 771 | 2900 positions), even in Mule and under MS Windows. (Fixing this, particularly |
| 2901 under Mule, is very difficult.) | |
| 428 | 2902 */ |
| 444 | 2903 (filename, visit, start, end, replace, codesys, used_codesys)) |
| 428 | 2904 { |
| 2905 /* This function can call lisp */ | |
| 2906 struct stat st; | |
| 2907 int fd; | |
| 2908 int saverrno = 0; | |
| 2909 Charcount inserted = 0; | |
| 2910 int speccount; | |
| 3841 | 2911 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; |
| 3814 | 2912 Lisp_Object val; |
| 428 | 2913 int total; |
| 867 | 2914 Ibyte read_buf[READ_BUF_SIZE]; |
| 428 | 2915 int mc_count; |
| 2916 struct buffer *buf = current_buffer; | |
| 2917 Lisp_Object curbuf; | |
| 2918 int not_regular = 0; | |
| 771 | 2919 int do_speedy_insert = |
| 2920 coding_system_is_binary (Fget_coding_system (codesys)); | |
| 428 | 2921 |
| 2922 if (buf->base_buffer && ! NILP (visit)) | |
| 563 | 2923 invalid_operation ("Cannot do file visiting in an indirect buffer", Qunbound); |
| 428 | 2924 |
| 2925 /* No need to call Fbarf_if_buffer_read_only() here. | |
| 2926 That's called in begin_multiple_change() or wherever. */ | |
| 2927 | |
| 2928 val = Qnil; | |
| 2929 | |
| 2930 /* #### dmoore - should probably check in various places to see if | |
| 2931 curbuf was killed and if so signal an error? */ | |
| 2932 | |
| 793 | 2933 curbuf = wrap_buffer (buf); |
| 428 | 2934 |
| 3814 | 2935 GCPRO4 (filename, val, visit, curbuf); |
| 428 | 2936 |
| 2937 mc_count = (NILP (replace)) ? | |
| 2938 begin_multiple_change (buf, BUF_PT (buf), BUF_PT (buf)) : | |
| 2939 begin_multiple_change (buf, BUF_BEG (buf), BUF_Z (buf)); | |
| 2940 | |
| 2941 speccount = specpdl_depth (); /* begin_multiple_change also adds | |
| 2942 an unwind_protect */ | |
| 2943 | |
| 2944 filename = Fexpand_file_name (filename, Qnil); | |
| 2945 | |
| 2946 if (!NILP (used_codesys)) | |
| 2947 CHECK_SYMBOL (used_codesys); | |
| 2948 | |
| 444 | 2949 if ( (!NILP (start) || !NILP (end)) && !NILP (visit) ) |
| 563 | 2950 invalid_operation ("Attempt to visit less than an entire file", Qunbound); |
| 428 | 2951 |
| 2952 fd = -1; | |
| 2953 | |
| 771 | 2954 if (qxe_stat (XSTRING_DATA (filename), &st) < 0) |
| 428 | 2955 { |
| 2956 badopen: | |
| 2957 if (NILP (visit)) | |
| 563 | 2958 report_file_error ("Opening input file", filename); |
| 428 | 2959 st.st_mtime = -1; |
| 2960 goto notfound; | |
| 2961 } | |
| 2962 | |
| 2963 #ifdef S_IFREG | |
| 2964 /* Signal an error if we are accessing a non-regular file, with | |
| 444 | 2965 REPLACE, START or END being non-nil. */ |
| 428 | 2966 if (!S_ISREG (st.st_mode)) |
| 2967 { | |
| 2968 not_regular = 1; | |
| 2969 | |
| 2970 if (!NILP (visit)) | |
| 2971 goto notfound; | |
| 2972 | |
| 444 | 2973 if (!NILP (replace) || !NILP (start) || !NILP (end)) |
| 428 | 2974 { |
| 2975 end_multiple_change (buf, mc_count); | |
| 2976 | |
| 444 | 2977 RETURN_UNGCPRO |
| 2978 (Fsignal (Qfile_error, | |
| 771 | 2979 list2 (build_msg_string("not a regular file"), |
| 444 | 2980 filename))); |
| 428 | 2981 } |
| 2982 } | |
| 2983 #endif /* S_IFREG */ | |
| 2984 | |
| 444 | 2985 if (!NILP (start)) |
| 2986 CHECK_INT (start); | |
| 428 | 2987 else |
| 444 | 2988 start = Qzero; |
| 428 | 2989 |
| 2990 if (!NILP (end)) | |
| 2991 CHECK_INT (end); | |
| 2992 | |
| 2993 if (fd < 0) | |
| 2994 { | |
| 771 | 2995 if ((fd = qxe_interruptible_open (XSTRING_DATA (filename), |
| 2996 O_RDONLY | OPEN_BINARY, 0)) < 0) | |
| 428 | 2997 goto badopen; |
| 2998 } | |
| 2999 | |
| 3000 /* Replacement should preserve point as it preserves markers. */ | |
| 3001 if (!NILP (replace)) | |
| 3002 record_unwind_protect (restore_point_unwind, Fpoint_marker (Qnil, Qnil)); | |
| 3003 | |
| 3004 record_unwind_protect (close_file_unwind, make_int (fd)); | |
| 3005 | |
| 3006 /* Supposedly happens on VMS. */ | |
| 3007 if (st.st_size < 0) | |
| 563 | 3008 signal_error (Qfile_error, "File size is negative", Qunbound); |
| 428 | 3009 |
| 3010 if (NILP (end)) | |
| 3011 { | |
| 3012 if (!not_regular) | |
| 3013 { | |
| 3014 end = make_int (st.st_size); | |
| 3015 if (XINT (end) != st.st_size) | |
| 563 | 3016 out_of_memory ("Maximum buffer size exceeded", Qunbound); |
| 428 | 3017 } |
| 3018 } | |
| 3019 | |
| 3020 /* If requested, replace the accessible part of the buffer | |
| 3021 with the file contents. Avoid replacing text at the | |
| 3022 beginning or end of the buffer that matches the file contents; | |
| 771 | 3023 that preserves markers pointing to the unchanged parts. */ |
| 3024 /* The replace-mode code is currently implemented by comparing the | |
| 3025 file on disk with the contents in the buffer, character by character. | |
| 3026 That works only if the characters on disk are exactly what will go into | |
| 3027 the buffer -- i.e. `binary' conversion. | |
| 3028 | |
| 3029 FSF tries to implement this in all situations, even the non-binary | |
| 3030 conversion, by (in that case) loading the whole converted file into a | |
| 3031 separate memory area, then doing the comparison. I really don't see | |
| 3032 the point of this, and it will fail spectacularly if the file is many | |
| 3033 megabytes in size. To try to get around this, we could certainly read | |
| 3034 from the beginning and decode as necessary before comparing, but doing | |
| 3035 the same at the end gets very difficult because of the possibility of | |
| 3036 modal coding systems -- trying to decode data from any point forward | |
| 3037 without decoding previous data might always give you different results | |
| 3038 from starting at the beginning. We could try further tricks like | |
| 3039 keeping track of which coding systems are non-modal and providing some | |
| 3040 extra method for such coding systems to be given a chunk of data that | |
| 3041 came from a specified location in a specified file and ask the coding | |
| 3042 systems to return a "sync point" from which the data can be read | |
| 3043 forward and have results guaranteed to be the same as reading from the | |
| 3044 beginning to that point, but I really don't think it's worth it. If | |
| 3045 we implemented the FSF "brute-force" method, we would have to put a | |
| 3046 reasonable maximum file size on the files. Is any of this worth it? | |
| 3047 --ben | |
| 3048 | |
| 3638 | 3049 |
| 3050 It's probably not worth it, and despite what you might take from the | |
| 3051 above, we don't do it currently; that is, for non-"binary" coding | |
| 3052 systems, we don't try to implement replace-mode at all. See the | |
| 3053 do_speedy_insert variable above. The upside of this is that our API | |
| 3054 is consistent and not buggy. -- Aidan Kehoe, Fri Oct 27 21:02:30 CEST | |
| 3055 2006 | |
| 771 | 3056 */ |
| 3057 | |
| 428 | 3058 if (!NILP (replace)) |
| 3059 { | |
| 771 | 3060 if (!do_speedy_insert) |
| 3061 buffer_delete_range (buf, BUF_BEG (buf), BUF_Z (buf), | |
| 3062 !NILP (visit) ? INSDEL_NO_LOCKING : 0); | |
| 3063 else | |
| 428 | 3064 { |
| 771 | 3065 char buffer[1 << 14]; |
| 3066 Charbpos same_at_start = BUF_BEGV (buf); | |
| 3067 Charbpos same_at_end = BUF_ZV (buf); | |
| 3068 int overlap; | |
| 3069 | |
| 3070 /* Count how many chars at the start of the file | |
| 3071 match the text at the beginning of the buffer. */ | |
| 3072 while (1) | |
| 3073 { | |
| 3074 int nread; | |
| 3075 Charbpos charbpos; | |
| 3076 nread = read_allowing_quit (fd, buffer, sizeof (buffer)); | |
| 3077 if (nread < 0) | |
| 3078 report_file_error ("Reading", filename); | |
| 3079 else if (nread == 0) | |
| 3080 break; | |
| 3081 charbpos = 0; | |
| 3082 while (charbpos < nread && same_at_start < BUF_ZV (buf) | |
| 814 | 3083 && BUF_FETCH_CHAR (buf, same_at_start) == |
| 3084 buffer[charbpos]) | |
| 771 | 3085 same_at_start++, charbpos++; |
| 3086 /* If we found a discrepancy, stop the scan. | |
| 3087 Otherwise loop around and scan the next bufferful. */ | |
| 3088 if (charbpos != nread) | |
| 3089 break; | |
| 3090 } | |
| 3091 /* If the file matches the buffer completely, | |
| 3092 there's no need to replace anything. */ | |
| 3093 if (same_at_start - BUF_BEGV (buf) == st.st_size) | |
| 3094 { | |
| 3095 retry_close (fd); | |
| 3096 unbind_to (speccount); | |
| 3097 /* Truncate the buffer to the size of the file. */ | |
| 3098 buffer_delete_range (buf, same_at_start, same_at_end, | |
| 3099 !NILP (visit) ? INSDEL_NO_LOCKING : 0); | |
| 3100 goto handled; | |
| 3101 } | |
| 3102 /* Count how many chars at the end of the file | |
| 3103 match the text at the end of the buffer. */ | |
| 3104 while (1) | |
| 3105 { | |
| 3106 int total_read, nread; | |
| 814 | 3107 Charcount charbpos, curpos, trial; |
| 771 | 3108 |
| 3109 /* At what file position are we now scanning? */ | |
| 3110 curpos = st.st_size - (BUF_ZV (buf) - same_at_end); | |
| 3111 /* If the entire file matches the buffer tail, stop the scan. */ | |
| 3112 if (curpos == 0) | |
| 3113 break; | |
| 3114 /* How much can we scan in the next step? */ | |
| 3115 trial = min (curpos, (Charbpos) sizeof (buffer)); | |
| 3116 if (lseek (fd, curpos - trial, 0) < 0) | |
| 3117 report_file_error ("Setting file position", filename); | |
| 3118 | |
| 3119 total_read = 0; | |
| 3120 while (total_read < trial) | |
| 3121 { | |
| 3122 nread = read_allowing_quit (fd, buffer + total_read, | |
| 3123 trial - total_read); | |
| 3124 if (nread <= 0) | |
| 3125 report_file_error ("IO error reading file", filename); | |
| 3126 total_read += nread; | |
| 3127 } | |
| 3128 /* Scan this bufferful from the end, comparing with | |
| 3129 the Emacs buffer. */ | |
| 3130 charbpos = total_read; | |
| 3131 /* Compare with same_at_start to avoid counting some buffer text | |
| 3132 as matching both at the file's beginning and at the end. */ | |
| 3133 while (charbpos > 0 && same_at_end > same_at_start | |
| 3134 && BUF_FETCH_CHAR (buf, same_at_end - 1) == | |
| 3135 buffer[charbpos - 1]) | |
| 3136 same_at_end--, charbpos--; | |
| 3137 /* If we found a discrepancy, stop the scan. | |
| 3138 Otherwise loop around and scan the preceding bufferful. */ | |
| 3139 if (charbpos != 0) | |
| 3140 break; | |
| 3141 /* If display current starts at beginning of line, | |
| 3142 keep it that way. */ | |
| 3143 if (XBUFFER (XWINDOW (Fselected_window (Qnil))->buffer) == buf) | |
| 3144 XWINDOW (Fselected_window (Qnil))->start_at_line_beg = | |
| 3145 !NILP (Fbolp (wrap_buffer (buf))); | |
| 3146 } | |
| 3147 | |
| 3148 /* Don't try to reuse the same piece of text twice. */ | |
| 3149 overlap = same_at_start - BUF_BEGV (buf) - | |
| 3150 (same_at_end + st.st_size - BUF_ZV (buf)); | |
| 3151 if (overlap > 0) | |
| 3152 same_at_end += overlap; | |
| 3153 | |
| 3154 /* Arrange to read only the nonmatching middle part of the file. */ | |
| 3155 start = make_int (same_at_start - BUF_BEGV (buf)); | |
| 3156 end = make_int (st.st_size - (BUF_ZV (buf) - same_at_end)); | |
| 3157 | |
| 428 | 3158 buffer_delete_range (buf, same_at_start, same_at_end, |
| 3159 !NILP (visit) ? INSDEL_NO_LOCKING : 0); | |
| 771 | 3160 /* Insert from the file at the proper position. */ |
| 3161 BUF_SET_PT (buf, same_at_start); | |
| 428 | 3162 } |
| 3163 } | |
| 3164 | |
| 3165 if (!not_regular) | |
| 3166 { | |
| 444 | 3167 total = XINT (end) - XINT (start); |
| 428 | 3168 |
| 3169 /* Make sure point-max won't overflow after this insertion. */ | |
| 3170 if (total != XINT (make_int (total))) | |
| 563 | 3171 out_of_memory ("Maximum buffer size exceeded", Qunbound); |
| 428 | 3172 } |
| 3173 else | |
| 3174 /* For a special file, all we can do is guess. The value of -1 | |
| 3175 will make the stream functions read as much as possible. */ | |
| 3176 total = -1; | |
| 3177 | |
| 444 | 3178 if (XINT (start) != 0 |
| 428 | 3179 /* why was this here? asked jwz. The reason is that the replace-mode |
| 3180 connivings above will normally put the file pointer other than | |
| 3181 where it should be. */ | |
| 771 | 3182 || (!NILP (replace) && do_speedy_insert)) |
| 428 | 3183 { |
| 444 | 3184 if (lseek (fd, XINT (start), 0) < 0) |
| 563 | 3185 report_file_error ("Setting file position", filename); |
| 428 | 3186 } |
| 3187 | |
| 3188 { | |
| 665 | 3189 Charbpos cur_point = BUF_PT (buf); |
| 428 | 3190 struct gcpro ngcpro1; |
| 3191 Lisp_Object stream = make_filedesc_input_stream (fd, 0, total, | |
| 3192 LSTR_ALLOW_QUIT); | |
| 3193 | |
| 3194 NGCPRO1 (stream); | |
| 3195 Lstream_set_buffering (XLSTREAM (stream), LSTREAM_BLOCKN_BUFFERED, 65536); | |
| 771 | 3196 stream = make_coding_input_stream |
| 3197 (XLSTREAM (stream), get_coding_system_for_text_file (codesys, 1), | |
| 800 | 3198 CODING_DECODE, 0); |
| 428 | 3199 Lstream_set_buffering (XLSTREAM (stream), LSTREAM_BLOCKN_BUFFERED, 65536); |
| 3200 | |
| 3201 record_unwind_protect (delete_stream_unwind, stream); | |
| 3202 | |
| 3203 /* No need to limit the amount of stuff we attempt to read. (It would | |
| 3204 be incorrect, anyway, when Mule is enabled.) Instead, the limiting | |
| 3205 occurs inside of the filedesc stream. */ | |
| 3206 while (1) | |
| 3207 { | |
| 665 | 3208 Bytecount this_len; |
| 428 | 3209 Charcount cc_inserted; |
| 3210 | |
| 3211 QUIT; | |
| 3212 this_len = Lstream_read (XLSTREAM (stream), read_buf, | |
| 3213 sizeof (read_buf)); | |
| 3214 | |
| 3215 if (this_len <= 0) | |
| 3216 { | |
| 3217 if (this_len < 0) | |
| 3218 saverrno = errno; | |
| 3219 break; | |
| 3220 } | |
| 3221 | |
| 3222 cc_inserted = buffer_insert_raw_string_1 (buf, cur_point, read_buf, | |
| 3223 this_len, | |
| 3224 !NILP (visit) | |
| 3225 ? INSDEL_NO_LOCKING : 0); | |
| 3226 inserted += cc_inserted; | |
| 3227 cur_point += cc_inserted; | |
| 3228 } | |
| 3229 if (!NILP (used_codesys)) | |
| 3230 { | |
| 3231 Fset (used_codesys, | |
| 771 | 3232 XCODING_SYSTEM_NAME |
| 3233 (coding_stream_detected_coding_system (XLSTREAM (stream)))); | |
| 428 | 3234 } |
| 3235 NUNGCPRO; | |
| 3236 } | |
| 3237 | |
| 3238 /* Close the file/stream */ | |
| 771 | 3239 unbind_to (speccount); |
| 428 | 3240 |
| 3241 if (saverrno != 0) | |
| 3242 { | |
| 563 | 3243 errno = saverrno; |
| 3244 report_file_error ("Reading", filename); | |
| 428 | 3245 } |
| 3246 | |
| 3247 notfound: | |
| 3248 handled: | |
| 3249 | |
| 3250 end_multiple_change (buf, mc_count); | |
| 3251 | |
| 3252 if (!NILP (visit)) | |
| 3253 { | |
| 3254 if (!EQ (buf->undo_list, Qt)) | |
| 3255 buf->undo_list = Qnil; | |
| 3814 | 3256 buf->modtime = st.st_mtime; |
| 3257 buf->filename = filename; | |
| 3258 /* XEmacs addition: */ | |
| 3259 /* This function used to be in C, ostensibly so that | |
| 3260 it could be called here. But that's just silly. | |
| 3261 There's no reason C code can't call out to Lisp | |
| 3262 code, and it's a lot cleaner this way. */ | |
| 3263 /* Note: compute-buffer-file-truename is called for | |
| 3264 side-effect! Its return value is intentionally | |
| 3265 ignored. */ | |
| 3266 if (!NILP (Ffboundp (Qcompute_buffer_file_truename))) | |
| 3267 call1 (Qcompute_buffer_file_truename, wrap_buffer (buf)); | |
| 428 | 3268 BUF_SAVE_MODIFF (buf) = BUF_MODIFF (buf); |
| 3269 buf->auto_save_modified = BUF_MODIFF (buf); | |
| 3270 buf->saved_size = make_int (BUF_SIZE (buf)); | |
| 3271 #ifdef CLASH_DETECTION | |
| 3814 | 3272 if (!NILP (buf->file_truename)) |
| 3273 unlock_file (buf->file_truename); | |
| 3274 unlock_file (filename); | |
| 428 | 3275 #endif /* CLASH_DETECTION */ |
| 3276 if (not_regular) | |
| 3277 RETURN_UNGCPRO (Fsignal (Qfile_error, | |
| 771 | 3278 list2 (build_msg_string ("not a regular file"), |
| 428 | 3279 filename))); |
| 3280 | |
| 3281 /* If visiting nonexistent file, return nil. */ | |
| 3282 if (buf->modtime == -1) | |
| 3283 report_file_error ("Opening input file", | |
| 563 | 3284 filename); |
| 428 | 3285 } |
| 3286 | |
| 3287 /* Decode file format */ | |
| 3288 if (inserted > 0) | |
| 3289 { | |
| 3290 Lisp_Object insval = call3 (Qformat_decode, | |
| 3291 Qnil, make_int (inserted), visit); | |
| 3292 CHECK_INT (insval); | |
| 3293 inserted = XINT (insval); | |
| 3294 } | |
| 3295 | |
| 3296 if (inserted > 0) | |
| 3297 { | |
| 2367 | 3298 GC_EXTERNAL_LIST_LOOP_2 (p, Vafter_insert_file_functions) |
| 428 | 3299 { |
| 2367 | 3300 Lisp_Object insval = call1 (p, make_int (inserted)); |
| 428 | 3301 if (!NILP (insval)) |
| 3302 { | |
| 3303 CHECK_NATNUM (insval); | |
| 3304 inserted = XINT (insval); | |
| 3305 } | |
| 3306 } | |
| 2367 | 3307 END_GC_EXTERNAL_LIST_LOOP (p); |
| 428 | 3308 } |
| 3309 | |
| 3310 UNGCPRO; | |
| 3311 | |
| 3312 if (!NILP (val)) | |
| 3313 return (val); | |
| 3314 else | |
| 3315 return (list2 (filename, make_int (inserted))); | |
| 3316 } | |
| 3317 | |
| 3318 | |
| 3319 static int a_write (Lisp_Object outstream, Lisp_Object instream, int pos, | |
| 3320 Lisp_Object *annot); | |
| 3321 static Lisp_Object build_annotations (Lisp_Object start, Lisp_Object end); | |
| 3322 | |
| 3323 /* If build_annotations switched buffers, switch back to BUF. | |
| 3324 Kill the temporary buffer that was selected in the meantime. */ | |
| 3325 | |
| 3326 static Lisp_Object | |
| 3327 build_annotations_unwind (Lisp_Object buf) | |
| 3328 { | |
| 3329 Lisp_Object tembuf; | |
| 3330 | |
| 3331 if (XBUFFER (buf) == current_buffer) | |
| 3332 return Qnil; | |
| 3333 tembuf = Fcurrent_buffer (); | |
| 3334 Fset_buffer (buf); | |
| 3335 Fkill_buffer (tembuf); | |
| 3336 return Qnil; | |
| 3337 } | |
| 3338 | |
| 4266 | 3339 DEFUN ("write-region-internal", Fwrite_region_internal, 3, 8, |
| 428 | 3340 "r\nFWrite region to file: ", /* |
| 3341 Write current region into specified file; no coding-system frobbing. | |
| 4266 | 3342 |
| 3343 This function is almost identical to `write-region'; see that function for | |
| 3344 documentation of the START, END, FILENAME, APPEND, VISIT, and LOCKNAME | |
| 3345 arguments. CODESYS specifies the encoding to be used for the file; if it is | |
| 3346 nil, no code conversion occurs. (With `write-region' the coding system is | |
| 3347 determined automatically if not specified.) | |
| 3348 | |
| 3349 MUSTBENEW specifies that a check for an existing file of the same name | |
| 3350 should be made. If it is 'excl, XEmacs will error on detecting such a file | |
| 3351 and never write it. If it is some other non-nil value, the user will be | |
| 3352 prompted to confirm the overwriting of an existing file. If it is nil, | |
| 3353 existing files are silently overwritten when file system permissions allow | |
| 3354 this. | |
| 764 | 3355 |
| 3356 As a special kludge to support auto-saving, when START is nil START and | |
| 3357 END are set to the beginning and end, respectively, of the buffer, | |
| 3358 regardless of any restrictions. Don't use this feature. It is documented | |
| 3359 here because write-region handler writers need to be aware of it. | |
| 4266 | 3360 |
| 428 | 3361 */ |
| 4266 | 3362 (start, end, filename, append, visit, lockname, codesys, |
| 3363 mustbenew)) | |
| 428 | 3364 { |
| 442 | 3365 /* This function can call lisp. GC checked 2000-07-28 ben */ |
| 428 | 3366 int desc; |
| 3367 int failure; | |
| 3368 int save_errno = 0; | |
| 3369 struct stat st; | |
| 442 | 3370 Lisp_Object fn = Qnil; |
| 428 | 3371 int speccount = specpdl_depth (); |
| 3372 int visiting_other = STRINGP (visit); | |
| 3373 int visiting = (EQ (visit, Qt) || visiting_other); | |
| 3374 int quietly = (!visiting && !NILP (visit)); | |
| 3375 Lisp_Object visit_file = Qnil; | |
| 3376 Lisp_Object annotations = Qnil; | |
| 3377 struct buffer *given_buffer; | |
| 665 | 3378 Charbpos start1, end1; |
| 442 | 3379 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; |
| 3380 struct gcpro ngcpro1, ngcpro2; | |
| 793 | 3381 Lisp_Object curbuf = wrap_buffer (current_buffer); |
| 3382 | |
| 442 | 3383 |
| 3384 /* start, end, visit, and append are never modified in this fun | |
| 3385 so we don't protect them. */ | |
| 3386 GCPRO5 (visit_file, filename, codesys, lockname, annotations); | |
| 3387 NGCPRO2 (curbuf, fn); | |
| 3388 | |
| 3389 /* [[ dmoore - if Fexpand_file_name or handlers kill the buffer, | |
| 428 | 3390 we should signal an error rather than blissfully continuing |
| 3391 along. ARGH, this function is going to lose lose lose. We need | |
| 3392 to protect the current_buffer from being destroyed, but the | |
| 442 | 3393 multiple return points make this a pain in the butt. ]] we do |
| 3394 protect curbuf now. --ben */ | |
| 428 | 3395 |
| 771 | 3396 codesys = get_coding_system_for_text_file (codesys, 0); |
| 428 | 3397 |
| 3398 if (current_buffer->base_buffer && ! NILP (visit)) | |
| 442 | 3399 invalid_operation ("Cannot do file visiting in an indirect buffer", |
| 3400 curbuf); | |
| 428 | 3401 |
| 3402 if (!NILP (start) && !STRINGP (start)) | |
| 3403 get_buffer_range_char (current_buffer, start, end, &start1, &end1, 0); | |
| 3404 | |
| 3405 { | |
| 3406 Lisp_Object handler; | |
| 3407 | |
| 4266 | 3408 if (!NILP (mustbenew) && !EQ (mustbenew, Qexcl)) |
| 3409 barf_or_query_if_file_exists (filename, "overwrite", 1, NULL); | |
| 3410 | |
| 428 | 3411 if (visiting_other) |
| 3412 visit_file = Fexpand_file_name (visit, Qnil); | |
| 3413 else | |
| 3414 visit_file = filename; | |
| 3415 filename = Fexpand_file_name (filename, Qnil); | |
| 3416 | |
| 3417 if (NILP (lockname)) | |
| 3418 lockname = visit_file; | |
| 3419 | |
| 442 | 3420 /* We used to UNGCPRO here. BAD! visit_file is used below after |
| 3421 more Lisp calling. */ | |
| 428 | 3422 /* If the file name has special constructs in it, |
| 3423 call the corresponding file handler. */ | |
| 3424 handler = Ffind_file_name_handler (filename, Qwrite_region); | |
| 3425 /* If FILENAME has no handler, see if VISIT has one. */ | |
| 3426 if (NILP (handler) && STRINGP (visit)) | |
| 3427 handler = Ffind_file_name_handler (visit, Qwrite_region); | |
| 3428 | |
| 3429 if (!NILP (handler)) | |
| 3430 { | |
| 3431 Lisp_Object val = call8 (handler, Qwrite_region, start, end, | |
| 3432 filename, append, visit, lockname, codesys); | |
| 3433 if (visiting) | |
| 3434 { | |
| 3435 BUF_SAVE_MODIFF (current_buffer) = BUF_MODIFF (current_buffer); | |
| 3436 current_buffer->saved_size = make_int (BUF_SIZE (current_buffer)); | |
| 3437 current_buffer->filename = visit_file; | |
| 3438 MARK_MODELINE_CHANGED; | |
| 3439 } | |
| 442 | 3440 NUNGCPRO; |
| 3441 UNGCPRO; | |
| 428 | 3442 return val; |
| 3443 } | |
| 3444 } | |
| 3445 | |
| 3446 #ifdef CLASH_DETECTION | |
| 3447 if (!auto_saving) | |
| 442 | 3448 lock_file (lockname); |
| 428 | 3449 #endif /* CLASH_DETECTION */ |
| 3450 | |
| 3451 /* Special kludge to simplify auto-saving. */ | |
| 3452 if (NILP (start)) | |
| 3453 { | |
| 3454 start1 = BUF_BEG (current_buffer); | |
| 3455 end1 = BUF_Z (current_buffer); | |
| 3456 } | |
| 3457 | |
| 3458 record_unwind_protect (build_annotations_unwind, Fcurrent_buffer ()); | |
| 3459 | |
| 3460 given_buffer = current_buffer; | |
| 3461 annotations = build_annotations (start, end); | |
| 3462 if (current_buffer != given_buffer) | |
| 3463 { | |
| 3464 start1 = BUF_BEGV (current_buffer); | |
| 3465 end1 = BUF_ZV (current_buffer); | |
| 3466 } | |
| 3467 | |
| 3468 fn = filename; | |
| 3469 desc = -1; | |
| 3470 if (!NILP (append)) | |
| 3471 { | |
| 4266 | 3472 desc = qxe_open (XSTRING_DATA (fn), O_WRONLY | OPEN_BINARY |
| 3473 | (EQ (mustbenew, Qexcl) ? O_EXCL : 0), 0); | |
| 428 | 3474 } |
| 3475 if (desc < 0) | |
| 3476 { | |
| 771 | 3477 desc = qxe_open (XSTRING_DATA (fn), |
| 4266 | 3478 O_WRONLY | (EQ (mustbenew, Qexcl) ? O_EXCL : O_TRUNC) |
| 3479 | O_CREAT | OPEN_BINARY, | |
| 771 | 3480 auto_saving ? auto_save_mode_bits : CREAT_MODE); |
| 428 | 3481 } |
| 3482 | |
| 3483 if (desc < 0) | |
| 3484 { | |
| 3485 #ifdef CLASH_DETECTION | |
| 3486 save_errno = errno; | |
| 3487 if (!auto_saving) unlock_file (lockname); | |
| 3488 errno = save_errno; | |
| 3489 #endif /* CLASH_DETECTION */ | |
| 563 | 3490 report_file_error ("Opening output file", filename); |
| 428 | 3491 } |
| 3492 | |
| 3493 { | |
| 3494 Lisp_Object desc_locative = Fcons (make_int (desc), Qnil); | |
| 3495 Lisp_Object instream = Qnil, outstream = Qnil; | |
| 442 | 3496 struct gcpro nngcpro1, nngcpro2; |
| 3497 NNGCPRO2 (instream, outstream); | |
| 428 | 3498 |
| 3499 record_unwind_protect (close_file_unwind, desc_locative); | |
| 3500 | |
| 3501 if (!NILP (append)) | |
| 3502 { | |
| 3503 if (lseek (desc, 0, 2) < 0) | |
| 3504 { | |
| 3505 #ifdef CLASH_DETECTION | |
| 3506 if (!auto_saving) unlock_file (lockname); | |
| 3507 #endif /* CLASH_DETECTION */ | |
| 3508 report_file_error ("Lseek error", | |
| 563 | 3509 filename); |
| 428 | 3510 } |
| 3511 } | |
| 3512 | |
| 3513 failure = 0; | |
| 3514 | |
| 3515 /* Note: I tried increasing the buffering size, along with | |
| 3516 various other tricks, but nothing seemed to make much of | |
| 3517 a difference in the time it took to save a large file. | |
| 3518 (Actually that's not true. With a local disk, changing | |
| 3519 the buffer size doesn't seem to make much difference. | |
| 3520 With an NFS-mounted disk, it could make a lot of difference | |
| 3521 because you're affecting the number of network requests | |
| 3522 that need to be made, and there could be a large latency | |
| 3523 for each request. So I've increased the buffer size | |
| 3524 to 64K.) */ | |
| 3525 outstream = make_filedesc_output_stream (desc, 0, -1, 0); | |
| 3526 Lstream_set_buffering (XLSTREAM (outstream), | |
| 3527 LSTREAM_BLOCKN_BUFFERED, 65536); | |
| 3528 outstream = | |
| 800 | 3529 make_coding_output_stream (XLSTREAM (outstream), codesys, |
| 3530 CODING_ENCODE, 0); | |
| 428 | 3531 Lstream_set_buffering (XLSTREAM (outstream), |
| 3532 LSTREAM_BLOCKN_BUFFERED, 65536); | |
| 3533 if (STRINGP (start)) | |
| 3534 { | |
| 3535 instream = make_lisp_string_input_stream (start, 0, -1); | |
| 3536 start1 = 0; | |
| 3537 } | |
| 3538 else | |
| 3539 instream = make_lisp_buffer_input_stream (current_buffer, start1, end1, | |
| 3540 LSTR_SELECTIVE | | |
| 3541 LSTR_IGNORE_ACCESSIBLE); | |
| 3542 failure = (0 > (a_write (outstream, instream, start1, | |
| 3543 &annotations))); | |
| 3544 save_errno = errno; | |
| 3545 /* Note that this doesn't close the desc since we created the | |
| 3546 stream without the LSTR_CLOSING flag, but it does | |
| 3547 flush out any buffered data. */ | |
| 3548 if (Lstream_close (XLSTREAM (outstream)) < 0) | |
| 3549 { | |
| 3550 failure = 1; | |
| 3551 save_errno = errno; | |
| 3552 } | |
| 3553 Lstream_close (XLSTREAM (instream)); | |
| 3554 | |
| 3555 #ifdef HAVE_FSYNC | |
| 3556 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun). | |
| 3557 Disk full in NFS may be reported here. */ | |
| 3558 /* mib says that closing the file will try to write as fast as NFS can do | |
| 3559 it, and that means the fsync here is not crucial for autosave files. */ | |
|
4499
eb82259f265d
Port write-region-inhibit-sync, allowing avoidance of bad FS performance.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4465
diff
changeset
|
3560 if (!auto_saving && !write_region_inhibit_fsync && fsync (desc) < 0 |
| 428 | 3561 /* If fsync fails with EINTR, don't treat that as serious. */ |
| 3562 && errno != EINTR) | |
| 3563 { | |
| 3564 failure = 1; | |
| 3565 save_errno = errno; | |
| 3566 } | |
| 3567 #endif /* HAVE_FSYNC */ | |
| 3568 | |
| 440 | 3569 /* Spurious "file has changed on disk" warnings used to be seen on |
| 3570 systems where close() can change the modtime. This is known to | |
| 3571 happen on various NFS file systems, on Windows, and on Linux. | |
| 3572 Rather than handling this on a per-system basis, we | |
| 771 | 3573 unconditionally do the qxe_stat() after the retry_close(). */ |
| 428 | 3574 |
| 3575 /* NFS can report a write failure now. */ | |
| 771 | 3576 if (retry_close (desc) < 0) |
| 428 | 3577 { |
| 3578 failure = 1; | |
| 3579 save_errno = errno; | |
| 3580 } | |
| 3581 | |
| 3582 /* Discard the close unwind-protect. Execute the one for | |
| 3583 build_annotations (switches back to the original current buffer | |
| 3584 as necessary). */ | |
| 3585 XCAR (desc_locative) = Qnil; | |
| 771 | 3586 unbind_to (speccount); |
| 442 | 3587 |
| 3588 NNUNGCPRO; | |
| 428 | 3589 } |
| 3590 | |
| 771 | 3591 qxe_stat (XSTRING_DATA (fn), &st); |
| 428 | 3592 |
| 3593 #ifdef CLASH_DETECTION | |
| 3594 if (!auto_saving) | |
| 3595 unlock_file (lockname); | |
| 3596 #endif /* CLASH_DETECTION */ | |
| 3597 | |
| 3598 /* Do this before reporting IO error | |
| 3599 to avoid a "file has changed on disk" warning on | |
| 3600 next attempt to save. */ | |
| 3601 if (visiting) | |
| 3602 current_buffer->modtime = st.st_mtime; | |
| 3603 | |
| 3604 if (failure) | |
| 442 | 3605 { |
| 3606 errno = save_errno; | |
| 563 | 3607 report_file_error ("Writing file", fn); |
| 442 | 3608 } |
| 428 | 3609 |
| 3610 if (visiting) | |
| 3611 { | |
| 3612 BUF_SAVE_MODIFF (current_buffer) = BUF_MODIFF (current_buffer); | |
| 3613 current_buffer->saved_size = make_int (BUF_SIZE (current_buffer)); | |
| 3614 current_buffer->filename = visit_file; | |
| 3615 MARK_MODELINE_CHANGED; | |
| 3616 } | |
| 3617 else if (quietly) | |
| 3618 { | |
| 442 | 3619 NUNGCPRO; |
| 3620 UNGCPRO; | |
| 428 | 3621 return Qnil; |
| 3622 } | |
| 3623 | |
| 3624 if (!auto_saving) | |
| 3625 { | |
| 3626 if (visiting_other) | |
| 3627 message ("Wrote %s", XSTRING_DATA (visit_file)); | |
| 3628 else | |
| 3629 { | |
| 446 | 3630 Lisp_Object fsp = Qnil; |
| 442 | 3631 struct gcpro nngcpro1; |
| 3632 | |
| 3633 NNGCPRO1 (fsp); | |
| 428 | 3634 fsp = Ffile_symlink_p (fn); |
| 3635 if (NILP (fsp)) | |
| 3636 message ("Wrote %s", XSTRING_DATA (fn)); | |
| 3637 else | |
| 3638 message ("Wrote %s (symlink to %s)", | |
| 3639 XSTRING_DATA (fn), XSTRING_DATA (fsp)); | |
| 442 | 3640 NNUNGCPRO; |
| 428 | 3641 } |
| 3642 } | |
| 442 | 3643 NUNGCPRO; |
| 3644 UNGCPRO; | |
| 428 | 3645 return Qnil; |
| 3646 } | |
| 3647 | |
| 3648 /* #### This is such a load of shit!!!! There is no way we should define | |
| 3649 something so stupid as a subr, just sort the fucking list more | |
| 3650 intelligently. */ | |
| 3651 DEFUN ("car-less-than-car", Fcar_less_than_car, 2, 2, 0, /* | |
| 3652 Return t if (car A) is numerically less than (car B). | |
| 3653 */ | |
| 3654 (a, b)) | |
| 3655 { | |
| 3656 Lisp_Object objs[2]; | |
| 3657 objs[0] = Fcar (a); | |
| 3658 objs[1] = Fcar (b); | |
| 3659 return Flss (2, objs); | |
| 3660 } | |
| 3661 | |
| 3662 /* Heh heh heh, let's define this too, just to aggravate the person who | |
| 3663 wrote the above comment. */ | |
| 3664 DEFUN ("cdr-less-than-cdr", Fcdr_less_than_cdr, 2, 2, 0, /* | |
| 3665 Return t if (cdr A) is numerically less than (cdr B). | |
| 3666 */ | |
| 3667 (a, b)) | |
| 3668 { | |
| 3669 Lisp_Object objs[2]; | |
| 3670 objs[0] = Fcdr (a); | |
| 3671 objs[1] = Fcdr (b); | |
| 3672 return Flss (2, objs); | |
| 3673 } | |
| 3674 | |
| 3675 /* Build the complete list of annotations appropriate for writing out | |
| 3676 the text between START and END, by calling all the functions in | |
| 3677 write-region-annotate-functions and merging the lists they return. | |
| 3678 If one of these functions switches to a different buffer, we assume | |
| 3679 that buffer contains altered text. Therefore, the caller must | |
| 3680 make sure to restore the current buffer in all cases, | |
| 3681 as save-excursion would do. */ | |
| 3682 | |
| 3683 static Lisp_Object | |
| 3684 build_annotations (Lisp_Object start, Lisp_Object end) | |
| 3685 { | |
| 3686 /* This function can GC */ | |
| 3687 Lisp_Object annotations; | |
| 3688 Lisp_Object p, res; | |
| 3689 struct gcpro gcpro1, gcpro2; | |
| 793 | 3690 Lisp_Object original_buffer = wrap_buffer (current_buffer); |
| 3691 | |
| 428 | 3692 |
| 3693 annotations = Qnil; | |
| 3694 p = Vwrite_region_annotate_functions; | |
| 3695 GCPRO2 (annotations, p); | |
| 3696 while (!NILP (p)) | |
| 3697 { | |
| 3698 struct buffer *given_buffer = current_buffer; | |
| 3699 Vwrite_region_annotations_so_far = annotations; | |
| 3700 res = call2 (Fcar (p), start, end); | |
| 3701 /* If the function makes a different buffer current, | |
| 3702 assume that means this buffer contains altered text to be output. | |
| 3703 Reset START and END from the buffer bounds | |
| 3704 and discard all previous annotations because they should have | |
| 3705 been dealt with by this function. */ | |
| 3706 if (current_buffer != given_buffer) | |
| 3707 { | |
| 3708 start = make_int (BUF_BEGV (current_buffer)); | |
| 3709 end = make_int (BUF_ZV (current_buffer)); | |
| 3710 annotations = Qnil; | |
| 3711 } | |
| 3712 Flength (res); /* Check basic validity of return value */ | |
| 3713 annotations = merge (annotations, res, Qcar_less_than_car); | |
| 3714 p = Fcdr (p); | |
| 3715 } | |
| 3716 | |
| 3717 /* Now do the same for annotation functions implied by the file-format */ | |
| 3718 if (auto_saving && (!EQ (Vauto_save_file_format, Qt))) | |
| 3719 p = Vauto_save_file_format; | |
| 3720 else | |
| 3721 p = current_buffer->file_format; | |
| 3722 while (!NILP (p)) | |
| 3723 { | |
| 3724 struct buffer *given_buffer = current_buffer; | |
| 3725 Vwrite_region_annotations_so_far = annotations; | |
| 3726 res = call4 (Qformat_annotate_function, Fcar (p), start, end, | |
| 3727 original_buffer); | |
| 3728 if (current_buffer != given_buffer) | |
| 3729 { | |
| 3730 start = make_int (BUF_BEGV (current_buffer)); | |
| 3731 end = make_int (BUF_ZV (current_buffer)); | |
| 3732 annotations = Qnil; | |
| 3733 } | |
| 3734 Flength (res); | |
| 3735 annotations = merge (annotations, res, Qcar_less_than_car); | |
| 3736 p = Fcdr (p); | |
| 3737 } | |
| 3738 UNGCPRO; | |
| 3739 return annotations; | |
| 3740 } | |
| 3741 | |
| 3742 /* Write to stream OUTSTREAM the characters from INSTREAM (it is read until | |
| 3743 EOF is encountered), assuming they start at position POS in the buffer | |
| 3744 of string that STREAM refers to. Intersperse with them the annotations | |
| 3745 from *ANNOT that fall into the range of positions we are reading from, | |
| 3746 each at its appropriate position. | |
| 3747 | |
| 3748 Modify *ANNOT by discarding elements as we output them. | |
| 3749 The return value is negative in case of system call failure. */ | |
| 3750 | |
| 3751 /* 4K should probably be fine. We just need to reduce the number of | |
| 3752 function calls to reasonable level. The Lstream stuff itself will | |
| 3753 batch to 64K to reduce the number of system calls. */ | |
| 3754 | |
| 3755 #define A_WRITE_BATCH_SIZE 4096 | |
| 3756 | |
| 3757 static int | |
| 3758 a_write (Lisp_Object outstream, Lisp_Object instream, int pos, | |
| 3759 Lisp_Object *annot) | |
| 3760 { | |
| 3761 Lisp_Object tem; | |
| 3762 int nextpos; | |
| 3763 unsigned char largebuf[A_WRITE_BATCH_SIZE]; | |
| 3764 Lstream *instr = XLSTREAM (instream); | |
| 3765 Lstream *outstr = XLSTREAM (outstream); | |
| 3766 | |
| 3767 while (LISTP (*annot)) | |
| 3768 { | |
| 3769 tem = Fcar_safe (Fcar (*annot)); | |
| 3770 if (INTP (tem)) | |
| 3771 nextpos = XINT (tem); | |
| 3772 else | |
| 3773 nextpos = INT_MAX; | |
| 3774 #ifdef MULE | |
| 3775 /* If there are annotations left and we have Mule, then we | |
| 867 | 3776 have to do the I/O one ichar at a time so we can |
| 428 | 3777 determine when to insert the annotation. */ |
| 3778 if (!NILP (*annot)) | |
| 3779 { | |
| 867 | 3780 Ichar ch; |
| 3781 while (pos != nextpos && (ch = Lstream_get_ichar (instr)) != EOF) | |
| 428 | 3782 { |
| 867 | 3783 if (Lstream_put_ichar (outstr, ch) < 0) |
| 428 | 3784 return -1; |
| 3785 pos++; | |
| 3786 } | |
| 3787 } | |
| 3788 else | |
| 3789 #endif /* MULE */ | |
| 3790 { | |
| 3791 while (pos != nextpos) | |
| 3792 { | |
| 3793 /* Otherwise there is no point to that. Just go in batches. */ | |
| 3794 int chunk = min (nextpos - pos, A_WRITE_BATCH_SIZE); | |
| 3795 | |
| 3796 chunk = Lstream_read (instr, largebuf, chunk); | |
| 3797 if (chunk < 0) | |
| 3798 return -1; | |
| 3799 if (chunk == 0) /* EOF */ | |
| 3800 break; | |
| 771 | 3801 if (Lstream_write (outstr, largebuf, chunk) < 0) |
| 428 | 3802 return -1; |
| 3803 pos += chunk; | |
| 3804 } | |
| 3805 } | |
| 3806 if (pos == nextpos) | |
| 3807 { | |
| 3808 tem = Fcdr (Fcar (*annot)); | |
| 3809 if (STRINGP (tem)) | |
| 3810 { | |
| 3811 if (Lstream_write (outstr, XSTRING_DATA (tem), | |
| 3812 XSTRING_LENGTH (tem)) < 0) | |
| 3813 return -1; | |
| 3814 } | |
| 3815 *annot = Fcdr (*annot); | |
| 3816 } | |
| 3817 else | |
| 3818 return 0; | |
| 3819 } | |
| 3820 return -1; | |
| 3821 } | |
| 3822 | |
| 3823 | |
| 3824 | |
| 3825 #if 0 | |
| 3826 #include <des_crypt.h> | |
| 3827 | |
| 3828 #define CRYPT_BLOCK_SIZE 8 /* bytes */ | |
| 3829 #define CRYPT_KEY_SIZE 8 /* bytes */ | |
| 3830 | |
| 3831 DEFUN ("encrypt-string", Fencrypt_string, 2, 2, 0, /* | |
| 3832 Encrypt STRING using KEY. | |
| 3833 */ | |
| 3834 (string, key)) | |
| 3835 { | |
| 2367 | 3836 /* !!#### Needs work */ |
| 1333 | 3837 Extbyte *encrypted_string, *raw_key; |
| 3838 Extbyte *string_ext, *key_ext; | |
| 3839 Bytecount string_size_ext, key_size_ext, rounded_size, extra, key_size; | |
| 3840 | |
| 428 | 3841 CHECK_STRING (string); |
| 3842 CHECK_STRING (key); | |
| 3843 | |
| 1333 | 3844 LISP_STRING_TO_SIZED_EXTERNAL (string, string_ext, string_size_ext, Qbinary); |
| 3845 LISP_STRING_TO_SIZED_EXTERNAL (key, key_ext, key_size_ext, Qbinary); | |
| 3846 | |
| 3847 extra = string_size_ext % CRYPT_BLOCK_SIZE; | |
| 3848 rounded_size = string_size_ext + extra; | |
| 851 | 3849 encrypted_string = ALLOCA (rounded_size + 1); |
| 1333 | 3850 memcpy (encrypted_string, string_ext, string_size_ext); |
| 428 | 3851 memset (encrypted_string + rounded_size - extra, 0, extra + 1); |
| 3852 | |
| 1333 | 3853 key_size = min (CRYPT_KEY_SIZE, key_size_ext); |
| 428 | 3854 |
| 851 | 3855 raw_key = ALLOCA (CRYPT_KEY_SIZE + 1); |
| 1333 | 3856 memcpy (raw_key, key_ext, key_size); |
| 428 | 3857 memset (raw_key + key_size, 0, (CRYPT_KEY_SIZE + 1) - key_size); |
| 3858 | |
| 3859 ecb_crypt (raw_key, encrypted_string, rounded_size, | |
| 3860 DES_ENCRYPT | DES_SW); | |
| 1333 | 3861 return make_ext_string (encrypted_string, rounded_size, Qbinary); |
| 428 | 3862 } |
| 3863 | |
| 3864 DEFUN ("decrypt-string", Fdecrypt_string, 2, 2, 0, /* | |
| 3865 Decrypt STRING using KEY. | |
| 3866 */ | |
| 3867 (string, key)) | |
| 3868 { | |
| 1333 | 3869 Extbyte *decrypted_string, *raw_key; |
| 3870 Extbyte *string_ext, *key_ext; | |
| 3871 Bytecount string_size_ext, key_size_ext, string_size, key_size; | |
| 428 | 3872 |
| 3873 CHECK_STRING (string); | |
| 3874 CHECK_STRING (key); | |
| 3875 | |
| 1333 | 3876 LISP_STRING_TO_SIZED_EXTERNAL (string, string_ext, string_size_ext, Qbinary); |
| 3877 LISP_STRING_TO_SIZED_EXTERNAL (key, key_ext, key_size_ext, Qbinary); | |
| 3878 | |
| 3879 string_size = string_size_ext + 1; | |
| 851 | 3880 decrypted_string = ALLOCA (string_size); |
| 1333 | 3881 memcpy (decrypted_string, string_ext, string_size); |
| 428 | 3882 decrypted_string[string_size - 1] = '\0'; |
| 3883 | |
| 1333 | 3884 key_size = min (CRYPT_KEY_SIZE, key_size_ext); |
| 428 | 3885 |
| 851 | 3886 raw_key = ALLOCA (CRYPT_KEY_SIZE + 1); |
| 1333 | 3887 memcpy (raw_key, key_ext, key_size); |
| 428 | 3888 memset (raw_key + key_size, 0, (CRYPT_KEY_SIZE + 1) - key_size); |
| 3889 | |
| 3890 | |
| 3891 ecb_crypt (raw_key, decrypted_string, string_size, D | DES_SW); | |
| 1333 | 3892 return make_ext_string (decrypted_string, string_size - 1, Qbinary); |
| 428 | 3893 } |
| 3894 #endif /* 0 */ | |
| 3895 | |
| 3896 | |
| 3897 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime, 1, 1, 0, /* | |
| 444 | 3898 Return t if last mod time of BUFFER's visited file matches what BUFFER records. |
| 428 | 3899 This means that the file has not been changed since it was visited or saved. |
| 3900 */ | |
| 444 | 3901 (buffer)) |
| 428 | 3902 { |
| 442 | 3903 /* This function can call lisp; GC checked 2000-07-11 ben */ |
| 428 | 3904 struct buffer *b; |
| 3905 struct stat st; | |
| 3906 Lisp_Object handler; | |
| 3907 | |
| 444 | 3908 CHECK_BUFFER (buffer); |
| 3909 b = XBUFFER (buffer); | |
| 428 | 3910 |
| 3911 if (!STRINGP (b->filename)) return Qt; | |
| 3912 if (b->modtime == 0) return Qt; | |
| 3913 | |
| 3914 /* If the file name has special constructs in it, | |
| 3915 call the corresponding file handler. */ | |
| 3916 handler = Ffind_file_name_handler (b->filename, | |
| 3917 Qverify_visited_file_modtime); | |
| 3918 if (!NILP (handler)) | |
| 444 | 3919 return call2 (handler, Qverify_visited_file_modtime, buffer); |
| 428 | 3920 |
| 771 | 3921 if (qxe_stat (XSTRING_DATA (b->filename), &st) < 0) |
| 428 | 3922 { |
| 3923 /* If the file doesn't exist now and didn't exist before, | |
| 3924 we say that it isn't modified, provided the error is a tame one. */ | |
| 3925 if (errno == ENOENT || errno == EACCES || errno == ENOTDIR) | |
| 3926 st.st_mtime = -1; | |
| 3927 else | |
| 3928 st.st_mtime = 0; | |
| 3929 } | |
| 3930 if (st.st_mtime == b->modtime | |
| 3931 /* If both are positive, accept them if they are off by one second. */ | |
| 3932 || (st.st_mtime > 0 && b->modtime > 0 | |
| 3933 && (st.st_mtime == b->modtime + 1 | |
| 3934 || st.st_mtime == b->modtime - 1))) | |
| 3935 return Qt; | |
| 3936 return Qnil; | |
| 3937 } | |
| 3938 | |
| 3939 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime, 0, 0, 0, /* | |
| 3940 Clear out records of last mod time of visited file. | |
| 3941 Next attempt to save will certainly not complain of a discrepancy. | |
| 3942 */ | |
| 3943 ()) | |
| 3944 { | |
| 3945 current_buffer->modtime = 0; | |
| 3946 return Qnil; | |
| 3947 } | |
| 3948 | |
| 3949 DEFUN ("visited-file-modtime", Fvisited_file_modtime, 0, 0, 0, /* | |
| 3950 Return the current buffer's recorded visited file modification time. | |
| 3951 The value is a list of the form (HIGH . LOW), like the time values | |
| 3952 that `file-attributes' returns. | |
| 3953 */ | |
| 3954 ()) | |
| 3955 { | |
| 3956 return time_to_lisp ((time_t) current_buffer->modtime); | |
| 3957 } | |
| 3958 | |
| 3959 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime, 0, 1, 0, /* | |
| 3960 Update buffer's recorded modification time from the visited file's time. | |
| 3961 Useful if the buffer was not read from the file normally | |
| 3962 or if the file itself has been changed for some known benign reason. | |
| 3963 An argument specifies the modification time value to use | |
| 3964 \(instead of that of the visited file), in the form of a list | |
| 3965 \(HIGH . LOW) or (HIGH LOW). | |
| 3966 */ | |
| 3967 (time_list)) | |
| 3968 { | |
| 3969 /* This function can call lisp */ | |
| 3970 if (!NILP (time_list)) | |
| 3971 { | |
| 3972 time_t the_time; | |
| 3973 lisp_to_time (time_list, &the_time); | |
| 3974 current_buffer->modtime = (int) the_time; | |
| 3975 } | |
| 3976 else | |
| 3977 { | |
| 446 | 3978 Lisp_Object filename = Qnil; |
| 428 | 3979 struct stat st; |
| 3980 Lisp_Object handler; | |
| 3981 struct gcpro gcpro1, gcpro2, gcpro3; | |
| 3982 | |
| 3983 GCPRO3 (filename, time_list, current_buffer->filename); | |
| 3984 filename = Fexpand_file_name (current_buffer->filename, Qnil); | |
| 3985 | |
| 3986 /* If the file name has special constructs in it, | |
| 3987 call the corresponding file handler. */ | |
| 3988 handler = Ffind_file_name_handler (filename, Qset_visited_file_modtime); | |
| 3989 UNGCPRO; | |
| 3990 if (!NILP (handler)) | |
| 3991 /* The handler can find the file name the same way we did. */ | |
| 3992 return call2 (handler, Qset_visited_file_modtime, Qnil); | |
| 771 | 3993 else if (qxe_stat (XSTRING_DATA (filename), &st) >= 0) |
| 428 | 3994 current_buffer->modtime = st.st_mtime; |
| 3995 } | |
| 3996 | |
| 3997 return Qnil; | |
| 3998 } | |
| 3999 | |
| 4000 static Lisp_Object | |
| 2286 | 4001 auto_save_error (Lisp_Object UNUSED (condition_object), |
| 4002 Lisp_Object UNUSED (ignored)) | |
| 428 | 4003 { |
| 4004 /* This function can call lisp */ | |
| 4005 if (gc_in_progress) | |
| 4006 return Qnil; | |
| 4007 /* Don't try printing an error message after everything is gone! */ | |
| 4008 if (preparing_for_armageddon) | |
| 4009 return Qnil; | |
| 4010 clear_echo_area (selected_frame (), Qauto_saving, 1); | |
| 4011 Fding (Qt, Qauto_save_error, Qnil); | |
| 4012 message ("Auto-saving...error for %s", XSTRING_DATA (current_buffer->name)); | |
| 4013 Fsleep_for (make_int (1)); | |
| 4014 message ("Auto-saving...error!for %s", XSTRING_DATA (current_buffer->name)); | |
| 4015 Fsleep_for (make_int (1)); | |
| 4016 message ("Auto-saving...error for %s", XSTRING_DATA (current_buffer->name)); | |
| 4017 Fsleep_for (make_int (1)); | |
| 4018 return Qnil; | |
| 4019 } | |
| 4020 | |
| 4021 static Lisp_Object | |
| 2286 | 4022 auto_save_1 (Lisp_Object UNUSED (ignored)) |
| 428 | 4023 { |
| 4024 /* This function can call lisp */ | |
| 4025 /* #### I think caller is protecting current_buffer? */ | |
| 4026 struct stat st; | |
| 4027 Lisp_Object fn = current_buffer->filename; | |
| 4028 Lisp_Object a = current_buffer->auto_save_file_name; | |
| 4029 | |
| 4030 if (!STRINGP (a)) | |
| 4031 return (Qnil); | |
| 4032 | |
| 4033 /* Get visited file's mode to become the auto save file's mode. */ | |
| 4034 if (STRINGP (fn) && | |
| 771 | 4035 qxe_stat (XSTRING_DATA (fn), &st) >= 0) |
| 428 | 4036 /* But make sure we can overwrite it later! */ |
| 4037 auto_save_mode_bits = st.st_mode | 0600; | |
| 4038 else | |
| 4039 /* default mode for auto-save files of buffers with no file is | |
| 4040 readable by owner only. This may annoy some small number of | |
| 4041 people, but the alternative removes all privacy from email. */ | |
| 4042 auto_save_mode_bits = 0600; | |
| 4043 | |
| 4044 return | |
| 4045 Fwrite_region_internal (Qnil, Qnil, a, Qnil, Qlambda, Qnil, | |
| 771 | 4046 #if 1 /* #### Kyle wants it changed to not use escape-quoted. Think |
| 4047 carefully about how this works. */ | |
| 4266 | 4048 Qescape_quoted, |
| 771 | 4049 #else |
| 4266 | 4050 current_buffer->buffer_file_coding_system, |
| 428 | 4051 #endif |
| 4266 | 4052 Qnil); |
| 428 | 4053 } |
| 4054 | |
| 4055 static Lisp_Object | |
| 2286 | 4056 auto_save_expand_name_error (Lisp_Object condition_object, |
| 4057 Lisp_Object UNUSED (ignored)) | |
| 428 | 4058 { |
| 771 | 4059 warn_when_safe_lispobj |
| 793 | 4060 (Qfile, Qerror, |
| 771 | 4061 Fcons (build_msg_string ("Invalid auto-save list-file"), |
| 4062 Fcons (Vauto_save_list_file_name, | |
| 4063 condition_object))); | |
| 428 | 4064 return Qnil; |
| 4065 } | |
| 4066 | |
| 4067 static Lisp_Object | |
| 4068 auto_save_expand_name (Lisp_Object name) | |
| 4069 { | |
| 4070 struct gcpro gcpro1; | |
| 4071 | |
| 4072 /* note that caller did NOT gc protect name, so we do it. */ | |
| 771 | 4073 /* [[dmoore - this might not be necessary, if condition_case_1 |
| 4074 protects it. but I don't think it does.]] indeed it doesn't. --ben */ | |
| 428 | 4075 GCPRO1 (name); |
| 4076 RETURN_UNGCPRO (Fexpand_file_name (name, Qnil)); | |
| 4077 } | |
| 4078 | |
| 4079 | |
| 4080 static Lisp_Object | |
| 4081 do_auto_save_unwind (Lisp_Object fd) | |
| 4082 { | |
| 771 | 4083 retry_close (XINT (fd)); |
| 428 | 4084 return (fd); |
| 4085 } | |
| 4086 | |
| 4087 /* Fdo_auto_save() checks whether a GC is in progress when it is called, | |
| 4088 and if so, tries to avoid touching lisp objects. | |
| 4089 | |
| 4090 The only time that Fdo_auto_save() is called while GC is in progress | |
| 2500 | 4091 is if we're going down, as a result of an ABORT() or a kill signal. |
| 428 | 4092 It's fairly important that we generate autosave files in that case! |
| 4093 */ | |
| 4094 | |
| 4095 DEFUN ("do-auto-save", Fdo_auto_save, 0, 2, "", /* | |
| 4096 Auto-save all buffers that need it. | |
| 4097 This is all buffers that have auto-saving enabled | |
| 4098 and are changed since last auto-saved. | |
| 4099 Auto-saving writes the buffer into a file | |
| 4100 so that your editing is not lost if the system crashes. | |
| 4101 This file is not the file you visited; that changes only when you save. | |
| 4102 Normally we run the normal hook `auto-save-hook' before saving. | |
| 4103 | |
| 4104 Non-nil first argument means do not print any message if successful. | |
| 4105 Non-nil second argument means save only current buffer. | |
| 4106 */ | |
| 4107 (no_message, current_only)) | |
| 4108 { | |
| 4109 /* This function can call lisp */ | |
| 4110 struct buffer *b; | |
| 4111 Lisp_Object tail, buf; | |
| 4112 int auto_saved = 0; | |
| 4113 int do_handled_files; | |
| 4114 Lisp_Object oquit = Qnil; | |
| 4115 Lisp_Object listfile = Qnil; | |
| 4116 Lisp_Object old; | |
| 4117 int listdesc = -1; | |
| 4118 int speccount = specpdl_depth (); | |
| 4119 struct gcpro gcpro1, gcpro2, gcpro3; | |
| 4120 | |
| 793 | 4121 old = wrap_buffer (current_buffer); |
| 428 | 4122 GCPRO3 (oquit, listfile, old); |
| 4123 check_quit (); /* make Vquit_flag accurate */ | |
| 4124 /* Ordinarily don't quit within this function, | |
| 4125 but don't make it impossible to quit (in case we get hung in I/O). */ | |
| 4126 oquit = Vquit_flag; | |
| 4127 Vquit_flag = Qnil; | |
| 4128 | |
| 4129 /* No further GCPRO needed, because (when it matters) all Lisp_Object | |
| 4130 variables point to non-strings reached from Vbuffer_alist. */ | |
| 4131 | |
| 4132 if (minibuf_level != 0 || preparing_for_armageddon) | |
| 4133 no_message = Qt; | |
| 4134 | |
| 4135 run_hook (Qauto_save_hook); | |
| 4136 | |
| 4137 if (STRINGP (Vauto_save_list_file_name)) | |
| 4138 listfile = condition_case_1 (Qt, | |
| 4139 auto_save_expand_name, | |
| 4140 Vauto_save_list_file_name, | |
| 4141 auto_save_expand_name_error, Qnil); | |
| 4142 | |
| 853 | 4143 internal_bind_int (&auto_saving, 1); |
| 428 | 4144 |
| 4145 /* First, save all files which don't have handlers. If Emacs is | |
| 4146 crashing, the handlers may tweak what is causing Emacs to crash | |
| 4147 in the first place, and it would be a shame if Emacs failed to | |
| 4148 autosave perfectly ordinary files because it couldn't handle some | |
| 4149 ange-ftp'd file. */ | |
| 4150 for (do_handled_files = 0; do_handled_files < 2; do_handled_files++) | |
| 4151 { | |
| 4152 for (tail = Vbuffer_alist; | |
| 4153 CONSP (tail); | |
| 4154 tail = XCDR (tail)) | |
| 4155 { | |
| 4156 buf = XCDR (XCAR (tail)); | |
| 4157 b = XBUFFER (buf); | |
| 4158 | |
| 4159 if (!NILP (current_only) | |
| 4160 && b != current_buffer) | |
| 4161 continue; | |
| 4162 | |
| 4163 /* Don't auto-save indirect buffers. | |
| 4164 The base buffer takes care of it. */ | |
| 4165 if (b->base_buffer) | |
| 4166 continue; | |
| 4167 | |
| 4168 /* Check for auto save enabled | |
| 4169 and file changed since last auto save | |
| 4170 and file changed since last real save. */ | |
| 4171 if (STRINGP (b->auto_save_file_name) | |
| 4172 && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b) | |
| 4173 && b->auto_save_modified < BUF_MODIFF (b) | |
| 4174 /* -1 means we've turned off autosaving for a while--see below. */ | |
| 4175 && XINT (b->saved_size) >= 0 | |
| 4176 && (do_handled_files | |
| 4177 || NILP (Ffind_file_name_handler (b->auto_save_file_name, | |
| 4178 Qwrite_region)))) | |
| 4179 { | |
| 4180 EMACS_TIME before_time, after_time; | |
| 4181 | |
| 4182 EMACS_GET_TIME (before_time); | |
| 4183 /* If we had a failure, don't try again for 20 minutes. */ | |
| 4184 if (!preparing_for_armageddon | |
| 4185 && b->auto_save_failure_time >= 0 | |
| 4186 && (EMACS_SECS (before_time) - b->auto_save_failure_time < | |
| 4187 1200)) | |
| 4188 continue; | |
| 4189 | |
| 4190 if (!preparing_for_armageddon && | |
| 4191 (XINT (b->saved_size) * 10 | |
| 4192 > (BUF_Z (b) - BUF_BEG (b)) * 13) | |
| 4193 /* A short file is likely to change a large fraction; | |
| 4194 spare the user annoying messages. */ | |
| 4195 && XINT (b->saved_size) > 5000 | |
| 4196 /* These messages are frequent and annoying for `*mail*'. */ | |
| 4197 && !NILP (b->filename) | |
| 4198 && NILP (no_message) | |
| 4199 && disable_auto_save_when_buffer_shrinks) | |
| 4200 { | |
| 4201 /* It has shrunk too much; turn off auto-saving here. | |
| 4202 Unless we're about to crash, in which case auto-save it | |
| 4203 anyway. | |
| 4204 */ | |
| 4205 message | |
| 4206 ("Buffer %s has shrunk a lot; auto save turned off there", | |
| 4207 XSTRING_DATA (b->name)); | |
| 4208 /* Turn off auto-saving until there's a real save, | |
| 4209 and prevent any more warnings. */ | |
| 4210 b->saved_size = make_int (-1); | |
| 4211 if (!gc_in_progress) | |
| 4212 Fsleep_for (make_int (1)); | |
| 4213 continue; | |
| 4214 } | |
| 4215 set_buffer_internal (b); | |
| 4216 if (!auto_saved && NILP (no_message)) | |
| 4217 { | |
| 1333 | 4218 static const Ibyte *msg = (const Ibyte *) "Auto-saving..."; |
| 428 | 4219 echo_area_message (selected_frame (), msg, Qnil, |
| 1333 | 4220 0, qxestrlen (msg), |
| 428 | 4221 Qauto_saving); |
| 4222 } | |
| 4223 | |
| 4224 /* Open the auto-save list file, if necessary. | |
| 4225 We only do this now so that the file only exists | |
| 4226 if we actually auto-saved any files. */ | |
| 444 | 4227 if (!auto_saved && !inhibit_auto_save_session |
| 4228 && !NILP (Vauto_save_list_file_prefix) | |
| 4229 && STRINGP (listfile) && listdesc < 0) | |
| 428 | 4230 { |
| 771 | 4231 listdesc = |
| 4232 qxe_open (XSTRING_DATA (listfile), | |
| 4233 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY, | |
| 4234 CREAT_MODE); | |
| 428 | 4235 |
| 4236 /* Arrange to close that file whether or not we get | |
| 4237 an error. */ | |
| 4238 if (listdesc >= 0) | |
| 4239 record_unwind_protect (do_auto_save_unwind, | |
| 4240 make_int (listdesc)); | |
| 4241 } | |
| 4242 | |
| 4243 /* Record all the buffers that we are auto-saving in | |
| 4244 the special file that lists them. For each of | |
| 4245 these buffers, record visited name (if any) and | |
| 4246 auto save name. */ | |
| 4247 if (listdesc >= 0) | |
| 4248 { | |
| 442 | 4249 const Extbyte *auto_save_file_name_ext; |
| 665 | 4250 Bytecount auto_save_file_name_ext_len; |
| 428 | 4251 |
| 440 | 4252 TO_EXTERNAL_FORMAT (LISP_STRING, b->auto_save_file_name, |
| 4253 ALLOCA, (auto_save_file_name_ext, | |
| 4254 auto_save_file_name_ext_len), | |
| 771 | 4255 Qescape_quoted); |
| 428 | 4256 if (!NILP (b->filename)) |
| 4257 { | |
| 442 | 4258 const Extbyte *filename_ext; |
| 665 | 4259 Bytecount filename_ext_len; |
| 428 | 4260 |
| 440 | 4261 TO_EXTERNAL_FORMAT (LISP_STRING, b->filename, |
| 4262 ALLOCA, (filename_ext, | |
| 4263 filename_ext_len), | |
| 771 | 4264 Qescape_quoted); |
| 4265 retry_write (listdesc, filename_ext, filename_ext_len); | |
| 428 | 4266 } |
| 771 | 4267 retry_write (listdesc, "\n", 1); |
| 4268 retry_write (listdesc, auto_save_file_name_ext, | |
| 428 | 4269 auto_save_file_name_ext_len); |
| 771 | 4270 retry_write (listdesc, "\n", 1); |
| 428 | 4271 } |
| 4272 | |
| 4273 /* dmoore - In a bad scenario we've set b=XBUFFER(buf) | |
| 4274 based on values in Vbuffer_alist. auto_save_1 may | |
| 4275 cause lisp handlers to run. Those handlers may kill | |
| 4276 the buffer and then GC. Since the buffer is killed, | |
| 4277 it's no longer in Vbuffer_alist so it might get reaped | |
| 4278 by the GC. We also need to protect tail. */ | |
| 4279 /* #### There is probably a lot of other code which has | |
| 4280 pointers into buffers which may get blown away by | |
| 4281 handlers. */ | |
| 4282 { | |
| 4283 struct gcpro ngcpro1, ngcpro2; | |
| 4284 NGCPRO2 (buf, tail); | |
| 4285 condition_case_1 (Qt, | |
| 4286 auto_save_1, Qnil, | |
| 4287 auto_save_error, Qnil); | |
| 4288 NUNGCPRO; | |
| 4289 } | |
| 4290 /* Handler killed our saved current-buffer! Pick any. */ | |
| 4291 if (!BUFFER_LIVE_P (XBUFFER (old))) | |
| 793 | 4292 old = wrap_buffer (current_buffer); |
| 428 | 4293 |
| 4294 set_buffer_internal (XBUFFER (old)); | |
| 4295 auto_saved++; | |
| 4296 | |
| 4297 /* Handler killed their own buffer! */ | |
| 4298 if (!BUFFER_LIVE_P(b)) | |
| 4299 continue; | |
| 4300 | |
| 4301 b->auto_save_modified = BUF_MODIFF (b); | |
| 4302 b->saved_size = make_int (BUF_SIZE (b)); | |
| 4303 EMACS_GET_TIME (after_time); | |
| 4304 /* If auto-save took more than 60 seconds, | |
| 4305 assume it was an NFS failure that got a timeout. */ | |
| 4306 if (EMACS_SECS (after_time) - EMACS_SECS (before_time) > 60) | |
| 4307 b->auto_save_failure_time = EMACS_SECS (after_time); | |
| 4308 } | |
| 4309 } | |
| 4310 } | |
| 4311 | |
| 4312 /* Prevent another auto save till enough input events come in. */ | |
| 4313 if (auto_saved) | |
| 4314 record_auto_save (); | |
| 4315 | |
| 4316 /* If we didn't save anything into the listfile, remove the old | |
| 4317 one because nothing needed to be auto-saved. Do this afterwards | |
| 4318 rather than before in case we get a crash attempting to autosave | |
| 4319 (in that case we'd still want the old one around). */ | |
| 4320 if (listdesc < 0 && !auto_saved && STRINGP (listfile)) | |
| 771 | 4321 qxe_unlink (XSTRING_DATA (listfile)); |
| 428 | 4322 |
| 4323 /* Show "...done" only if the echo area would otherwise be empty. */ | |
| 4324 if (auto_saved && NILP (no_message) | |
| 4325 && NILP (clear_echo_area (selected_frame (), Qauto_saving, 0))) | |
| 4326 { | |
| 1333 | 4327 static const Ibyte *msg = (const Ibyte *)"Auto-saving...done"; |
| 428 | 4328 echo_area_message (selected_frame (), msg, Qnil, 0, |
| 1333 | 4329 qxestrlen (msg), Qauto_saving); |
| 428 | 4330 } |
| 4331 | |
| 4332 Vquit_flag = oquit; | |
| 4333 | |
| 771 | 4334 RETURN_UNGCPRO (unbind_to (speccount)); |
| 428 | 4335 } |
| 4336 | |
| 4337 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved, 0, 0, 0, /* | |
| 4338 Mark current buffer as auto-saved with its current text. | |
| 4339 No auto-save file will be written until the buffer changes again. | |
| 4340 */ | |
| 4341 ()) | |
| 4342 { | |
| 4343 current_buffer->auto_save_modified = BUF_MODIFF (current_buffer); | |
| 4344 current_buffer->saved_size = make_int (BUF_SIZE (current_buffer)); | |
| 4345 current_buffer->auto_save_failure_time = -1; | |
| 4346 return Qnil; | |
| 4347 } | |
| 4348 | |
| 4349 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure, 0, 0, 0, /* | |
| 4350 Clear any record of a recent auto-save failure in the current buffer. | |
| 4351 */ | |
| 4352 ()) | |
| 4353 { | |
| 4354 current_buffer->auto_save_failure_time = -1; | |
| 4355 return Qnil; | |
| 4356 } | |
| 4357 | |
| 4358 DEFUN ("recent-auto-save-p", Frecent_auto_save_p, 0, 0, 0, /* | |
| 4359 Return t if buffer has been auto-saved since last read in or saved. | |
| 4360 */ | |
| 4361 ()) | |
| 4362 { | |
| 4363 return (BUF_SAVE_MODIFF (current_buffer) < | |
| 4364 current_buffer->auto_save_modified) ? Qt : Qnil; | |
| 4365 } | |
| 4366 | |
| 4367 | |
| 4368 /************************************************************************/ | |
| 4369 /* initialization */ | |
| 4370 /************************************************************************/ | |
| 4371 | |
| 4372 void | |
| 4373 syms_of_fileio (void) | |
| 4374 { | |
| 563 | 4375 DEFSYMBOL (Qexpand_file_name); |
| 4376 DEFSYMBOL (Qfile_truename); | |
| 4377 DEFSYMBOL (Qsubstitute_in_file_name); | |
| 4378 DEFSYMBOL (Qdirectory_file_name); | |
| 4379 DEFSYMBOL (Qfile_name_directory); | |
| 4380 DEFSYMBOL (Qfile_name_nondirectory); | |
| 996 | 4381 DEFSYMBOL (Qfile_name_sans_extension); |
| 563 | 4382 DEFSYMBOL (Qunhandled_file_name_directory); |
| 4383 DEFSYMBOL (Qfile_name_as_directory); | |
| 4384 DEFSYMBOL (Qcopy_file); | |
| 4385 DEFSYMBOL (Qmake_directory_internal); | |
| 4386 DEFSYMBOL (Qdelete_directory); | |
| 4387 DEFSYMBOL (Qdelete_file); | |
| 4388 DEFSYMBOL (Qrename_file); | |
| 4389 DEFSYMBOL (Qadd_name_to_file); | |
| 4390 DEFSYMBOL (Qmake_symbolic_link); | |
| 844 | 4391 DEFSYMBOL (Qmake_temp_name); |
| 563 | 4392 DEFSYMBOL (Qfile_exists_p); |
| 4393 DEFSYMBOL (Qfile_executable_p); | |
| 4394 DEFSYMBOL (Qfile_readable_p); | |
| 4395 DEFSYMBOL (Qfile_symlink_p); | |
| 4396 DEFSYMBOL (Qfile_writable_p); | |
| 4397 DEFSYMBOL (Qfile_directory_p); | |
| 4398 DEFSYMBOL (Qfile_regular_p); | |
| 4399 DEFSYMBOL (Qfile_accessible_directory_p); | |
| 4400 DEFSYMBOL (Qfile_modes); | |
| 4401 DEFSYMBOL (Qset_file_modes); | |
| 4402 DEFSYMBOL (Qfile_newer_than_file_p); | |
| 4403 DEFSYMBOL (Qinsert_file_contents); | |
| 4404 DEFSYMBOL (Qwrite_region); | |
| 4405 DEFSYMBOL (Qverify_visited_file_modtime); | |
| 4406 DEFSYMBOL (Qset_visited_file_modtime); | |
| 4407 DEFSYMBOL (Qcar_less_than_car); /* Vomitous! */ | |
| 4266 | 4408 DEFSYMBOL (Qexcl); |
| 563 | 4409 |
| 4410 DEFSYMBOL (Qauto_save_hook); | |
| 4411 DEFSYMBOL (Qauto_save_error); | |
| 4412 DEFSYMBOL (Qauto_saving); | |
| 4413 | |
| 4414 DEFSYMBOL (Qformat_decode); | |
| 4415 DEFSYMBOL (Qformat_annotate_function); | |
| 4416 | |
| 4417 DEFSYMBOL (Qcompute_buffer_file_truename); | |
| 4418 | |
| 442 | 4419 DEFERROR_STANDARD (Qfile_already_exists, Qfile_error); |
| 428 | 4420 |
| 4421 DEFSUBR (Ffind_file_name_handler); | |
| 4422 | |
| 4423 DEFSUBR (Ffile_name_directory); | |
| 4424 DEFSUBR (Ffile_name_nondirectory); | |
| 4425 DEFSUBR (Funhandled_file_name_directory); | |
| 4426 DEFSUBR (Ffile_name_as_directory); | |
| 4427 DEFSUBR (Fdirectory_file_name); | |
| 4428 DEFSUBR (Fmake_temp_name); | |
| 4429 DEFSUBR (Fexpand_file_name); | |
| 4430 DEFSUBR (Ffile_truename); | |
| 4431 DEFSUBR (Fsubstitute_in_file_name); | |
| 4432 DEFSUBR (Fcopy_file); | |
| 4433 DEFSUBR (Fmake_directory_internal); | |
| 4434 DEFSUBR (Fdelete_directory); | |
| 4435 DEFSUBR (Fdelete_file); | |
| 4436 DEFSUBR (Frename_file); | |
| 4437 DEFSUBR (Fadd_name_to_file); | |
| 4438 DEFSUBR (Fmake_symbolic_link); | |
| 4439 #ifdef HPUX_NET | |
| 4440 DEFSUBR (Fsysnetunam); | |
| 4441 #endif /* HPUX_NET */ | |
| 4442 DEFSUBR (Ffile_name_absolute_p); | |
| 4443 DEFSUBR (Ffile_exists_p); | |
| 4444 DEFSUBR (Ffile_executable_p); | |
| 4445 DEFSUBR (Ffile_readable_p); | |
| 4446 DEFSUBR (Ffile_writable_p); | |
| 4447 DEFSUBR (Ffile_symlink_p); | |
| 4448 DEFSUBR (Ffile_directory_p); | |
| 4449 DEFSUBR (Ffile_accessible_directory_p); | |
| 4450 DEFSUBR (Ffile_regular_p); | |
| 4451 DEFSUBR (Ffile_modes); | |
| 4452 DEFSUBR (Fset_file_modes); | |
| 4453 DEFSUBR (Fset_default_file_modes); | |
| 4454 DEFSUBR (Fdefault_file_modes); | |
| 4455 DEFSUBR (Funix_sync); | |
| 4456 DEFSUBR (Ffile_newer_than_file_p); | |
| 4457 DEFSUBR (Finsert_file_contents_internal); | |
| 4458 DEFSUBR (Fwrite_region_internal); | |
| 4459 DEFSUBR (Fcar_less_than_car); /* Vomitous! */ | |
| 4460 DEFSUBR (Fcdr_less_than_cdr); /* Yeah oh yeah bucko .... */ | |
| 4461 #if 0 | |
| 4462 DEFSUBR (Fencrypt_string); | |
| 4463 DEFSUBR (Fdecrypt_string); | |
| 4464 #endif | |
| 4465 DEFSUBR (Fverify_visited_file_modtime); | |
| 4466 DEFSUBR (Fclear_visited_file_modtime); | |
| 4467 DEFSUBR (Fvisited_file_modtime); | |
| 4468 DEFSUBR (Fset_visited_file_modtime); | |
| 4469 | |
| 4470 DEFSUBR (Fdo_auto_save); | |
| 4471 DEFSUBR (Fset_buffer_auto_saved); | |
| 4472 DEFSUBR (Fclear_buffer_auto_save_failure); | |
| 4473 DEFSUBR (Frecent_auto_save_p); | |
| 4474 } | |
| 4475 | |
| 4476 void | |
| 4477 vars_of_fileio (void) | |
| 4478 { | |
| 2526 | 4479 QSin_expand_file_name = |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4867
diff
changeset
|
4480 build_defer_string ("(in expand-file-name)"); |
| 2526 | 4481 staticpro (&QSin_expand_file_name); |
| 4482 | |
| 428 | 4483 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format /* |
| 4484 *Format in which to write auto-save files. | |
| 4485 Should be a list of symbols naming formats that are defined in `format-alist'. | |
| 4486 If it is t, which is the default, auto-save files are written in the | |
| 4487 same format as a regular save would use. | |
| 4488 */ ); | |
| 4489 Vauto_save_file_format = Qt; | |
| 4490 | |
| 4491 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist /* | |
| 4492 *Alist of elements (REGEXP . HANDLER) for file names handled specially. | |
| 4493 If a file name matches REGEXP, then all I/O on that file is done by calling | |
| 4494 HANDLER. | |
| 4495 | |
| 4496 The first argument given to HANDLER is the name of the I/O primitive | |
| 4497 to be handled; the remaining arguments are the arguments that were | |
| 4498 passed to that primitive. For example, if you do | |
| 4499 (file-exists-p FILENAME) | |
| 4500 and FILENAME is handled by HANDLER, then HANDLER is called like this: | |
| 4501 (funcall HANDLER 'file-exists-p FILENAME) | |
| 4502 The function `find-file-name-handler' checks this list for a handler | |
| 4503 for its argument. | |
| 4504 */ ); | |
| 4505 Vfile_name_handler_alist = Qnil; | |
| 4506 | |
| 4507 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions /* | |
| 4508 A list of functions to be called at the end of `insert-file-contents'. | |
| 4509 Each is passed one argument, the number of bytes inserted. It should return | |
| 4510 the new byte count, and leave point the same. If `insert-file-contents' is | |
| 4511 intercepted by a handler from `file-name-handler-alist', that handler is | |
| 4512 responsible for calling the after-insert-file-functions if appropriate. | |
| 4513 */ ); | |
| 4514 Vafter_insert_file_functions = Qnil; | |
| 4515 | |
| 4516 DEFVAR_LISP ("write-region-annotate-functions", | |
| 4517 &Vwrite_region_annotate_functions /* | |
| 4518 A list of functions to be called at the start of `write-region'. | |
| 4519 Each is passed two arguments, START and END, as for `write-region'. | |
| 4520 It should return a list of pairs (POSITION . STRING) of strings to be | |
| 4521 effectively inserted at the specified positions of the file being written | |
| 4522 \(1 means to insert before the first byte written). The POSITIONs must be | |
| 4523 sorted into increasing order. If there are several functions in the list, | |
| 4524 the several lists are merged destructively. | |
| 4525 */ ); | |
| 4526 Vwrite_region_annotate_functions = Qnil; | |
| 4527 | |
| 4528 DEFVAR_LISP ("write-region-annotations-so-far", | |
| 4529 &Vwrite_region_annotations_so_far /* | |
| 4530 When an annotation function is called, this holds the previous annotations. | |
| 4531 These are the annotations made by other annotation functions | |
| 4532 that were already called. See also `write-region-annotate-functions'. | |
| 4533 */ ); | |
| 4534 Vwrite_region_annotations_so_far = Qnil; | |
| 4535 | |
| 4536 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers /* | |
| 4537 A list of file name handlers that temporarily should not be used. | |
| 4538 This applies only to the operation `inhibit-file-name-operation'. | |
| 4539 */ ); | |
| 4540 Vinhibit_file_name_handlers = Qnil; | |
| 4541 | |
| 4542 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation /* | |
| 4543 The operation for which `inhibit-file-name-handlers' is applicable. | |
| 4544 */ ); | |
| 4545 Vinhibit_file_name_operation = Qnil; | |
| 4546 | |
| 4547 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name /* | |
| 4548 File name in which we write a list of all auto save file names. | |
| 4549 */ ); | |
| 4550 Vauto_save_list_file_name = Qnil; | |
| 4551 | |
|
4499
eb82259f265d
Port write-region-inhibit-sync, allowing avoidance of bad FS performance.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4465
diff
changeset
|
4552 #ifdef HAVE_FSYNC |
|
eb82259f265d
Port write-region-inhibit-sync, allowing avoidance of bad FS performance.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4465
diff
changeset
|
4553 DEFVAR_BOOL ("write-region-inhibit-fsync", &write_region_inhibit_fsync /* |
|
eb82259f265d
Port write-region-inhibit-sync, allowing avoidance of bad FS performance.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4465
diff
changeset
|
4554 *Non-nil means don't call fsync in `write-region'. |
|
eb82259f265d
Port write-region-inhibit-sync, allowing avoidance of bad FS performance.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4465
diff
changeset
|
4555 This variable affects calls to `write-region' as well as save commands. |
|
eb82259f265d
Port write-region-inhibit-sync, allowing avoidance of bad FS performance.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4465
diff
changeset
|
4556 A non-nil value may result in data loss! |
|
eb82259f265d
Port write-region-inhibit-sync, allowing avoidance of bad FS performance.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4465
diff
changeset
|
4557 */ ); |
|
eb82259f265d
Port write-region-inhibit-sync, allowing avoidance of bad FS performance.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4465
diff
changeset
|
4558 write_region_inhibit_fsync = 0; |
|
eb82259f265d
Port write-region-inhibit-sync, allowing avoidance of bad FS performance.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4465
diff
changeset
|
4559 #endif |
|
eb82259f265d
Port write-region-inhibit-sync, allowing avoidance of bad FS performance.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4465
diff
changeset
|
4560 |
| 444 | 4561 DEFVAR_LISP ("auto-save-list-file-prefix", &Vauto_save_list_file_prefix /* |
| 4562 Prefix for generating auto-save-list-file-name. | |
| 4563 Emacs's pid and the system name will be appended to | |
| 4564 this prefix to create a unique file name. | |
| 4565 */ ); | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4867
diff
changeset
|
4566 Vauto_save_list_file_prefix = build_ascstring ("~/.saves-"); |
| 444 | 4567 |
| 4568 DEFVAR_BOOL ("inhibit-auto-save-session", &inhibit_auto_save_session /* | |
| 4569 When non-nil, inhibit auto save list file creation. | |
| 4570 */ ); | |
| 4571 inhibit_auto_save_session = 0; | |
| 4572 | |
| 428 | 4573 DEFVAR_BOOL ("disable-auto-save-when-buffer-shrinks", |
| 4574 &disable_auto_save_when_buffer_shrinks /* | |
| 4575 If non-nil, auto-saving is disabled when a buffer shrinks too much. | |
| 4576 This is to prevent you from losing your edits if you accidentally | |
| 4577 delete a large chunk of the buffer and don't notice it until too late. | |
| 4578 Saving the buffer normally turns auto-save back on. | |
| 4579 */ ); | |
| 4580 disable_auto_save_when_buffer_shrinks = 1; | |
| 4581 | |
| 4582 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char /* | |
| 4583 Directory separator character for built-in functions that return file names. | |
| 4584 The value should be either ?/ or ?\\ (any other value is treated as ?\\). | |
| 4585 This variable affects the built-in functions only on Windows, | |
| 4586 on other platforms, it is initialized so that Lisp code can find out | |
| 4587 what the normal separator is. | |
| 4588 */ ); | |
| 771 | 4589 Vdirectory_sep_char = make_char (DEFAULT_DIRECTORY_SEP); |
| 428 | 4590 } |
| 442 | 4591 |
| 4592 void | |
| 4593 reinit_vars_of_fileio (void) | |
| 4594 { | |
| 4595 /* We want temp_name_rand to be initialized to a value likely to be | |
| 4596 unique to the process, not to the executable. The danger is that | |
| 4597 two different XEmacs processes using the same binary on different | |
| 4598 machines creating temp files in the same directory will be | |
| 4599 unlucky enough to have the same pid. If we randomize using | |
| 4600 process startup time, then in practice they will be unlikely to | |
| 4601 collide. We use the microseconds field so that scripts that start | |
| 4602 simultaneous XEmacs processes on multiple machines will have less | |
| 4603 chance of collision. */ | |
| 4604 { | |
| 4605 EMACS_TIME thyme; | |
| 4606 | |
| 4607 EMACS_GET_TIME (thyme); | |
| 4608 temp_name_rand = (unsigned int) (EMACS_SECS (thyme) ^ EMACS_USECS (thyme)); | |
| 4609 } | |
| 4610 } |