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