X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/d57563b6120699ac06eb33ee1d2c161869965072..d243e605a05e28cfd0d68fee5d28b05593ec6969:/src/fileio.c diff --git a/src/fileio.c b/src/fileio.c index 9d14a851bd..29367875ac 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -177,6 +177,10 @@ Lisp_Object Vset_auto_coding_function; /* Functions to be called to process text properties in inserted file. */ Lisp_Object Vafter_insert_file_functions; +/* Lisp function for setting buffer-file-coding-system and the + multibyteness of the current buffer after inserting a file. */ +Lisp_Object Qafter_insert_file_set_coding; + /* Functions to be called to create text property annotations for file. */ Lisp_Object Vwrite_region_annotate_functions; @@ -188,7 +192,7 @@ Lisp_Object Vwrite_region_annotations_so_far; Lisp_Object Vauto_save_list_file_name; /* Function to call to read a file name. */ -Lisp_Object Vread_file_name_function; +Lisp_Object Vread_file_name_function; /* Current predicate used by read_file_name_internal. */ Lisp_Object Vread_file_name_predicate; @@ -447,9 +451,7 @@ on VMS, perhaps instead a string ending in `:', `]' or `>'. */) CORRECT_DIR_SEPS (beg); #endif /* DOS_NT */ - if (STRING_MULTIBYTE (filename)) - return make_string (beg, p - beg); - return make_unibyte_string (beg, p - beg); + return make_specified_string (beg, -1, p - beg, STRING_MULTIBYTE (filename)); } DEFUN ("file-name-nondirectory", Ffile_name_nondirectory, @@ -488,9 +490,7 @@ or the entire name if it contains no slash. */) ) p--; - if (STRING_MULTIBYTE (filename)) - return make_string (p, end - p); - return make_unibyte_string (p, end - p); + return make_specified_string (p, -1, end - p, STRING_MULTIBYTE (filename)); } DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory, @@ -631,7 +631,9 @@ On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc. */) return call2 (handler, Qfile_name_as_directory, file); buf = (char *) alloca (SBYTES (file) + 10); - return build_string (file_name_as_directory (buf, SDATA (file))); + file_name_as_directory (buf, SDATA (file)); + return make_specified_string (buf, -1, strlen (buf), + STRING_MULTIBYTE (file)); } /* @@ -831,7 +833,8 @@ it returns a file name such as \"[X]Y.DIR.1\". */) buf = (char *) alloca (SBYTES (directory) + 20); #endif directory_file_name (SDATA (directory), buf); - return build_string (buf); + return make_specified_string (buf, -1, strlen (buf), + STRING_MULTIBYTE (directory)); } static char make_temp_name_tbl[64] = @@ -849,13 +852,13 @@ static char make_temp_name_tbl[64] = static unsigned make_temp_name_count, make_temp_name_count_initialized_p; /* Value is a temporary file name starting with PREFIX, a string. - + The Emacs process number forms part of the result, so there is no danger of generating a name being used by another process. In addition, this function makes an attempt to choose a name which has no existing file. To make this work, PREFIX should be an absolute file name. - + BASE64_P non-zero means add the pid as 3 characters in base64 encoding. In this case, 6 characters will be added to PREFIX to form the file name. Otherwise, if Emacs is running on a system @@ -875,7 +878,7 @@ make_temp_name (prefix, base64_p) unsigned char *p, *data; char pidbuf[20]; int pidlen; - + CHECK_STRING (prefix); /* VAL is created by adding 6 characters to PREFIX. The first @@ -904,7 +907,7 @@ make_temp_name (prefix, base64_p) pidlen = 3; #endif } - + len = SCHARS (prefix); val = make_uninit_string (len + 3 + pidlen); data = SDATA (val); @@ -1027,7 +1030,7 @@ See also the function `substitute-in-file-name'. */) int is_escaped = 0; #endif /* DOS_NT */ int length; - Lisp_Object handler; + Lisp_Object handler, result; CHECK_STRING (name); @@ -1195,7 +1198,7 @@ See also the function `substitute-in-file-name'. */) && IS_DIRECTORY_SEP (p[0]) && IS_DIRECTORY_SEP (p[1])) lose = 1; - + #ifdef VMS if (p[0] == '\\') lose = 1; @@ -1275,7 +1278,11 @@ See also the function `substitute-in-file-name'. */) { #ifdef VMS if (index (nm, '/')) - return build_string (sys_translate_unix (nm)); + { + nm = sys_translate_unix (nm); + return make_specified_string (nm, -1, strlen (nm), + STRING_MULTIBYTE (name)); + } #endif /* VMS */ #ifdef DOS_NT /* Make sure directories are all separated with / or \ as @@ -1286,22 +1293,27 @@ See also the function `substitute-in-file-name'. */) if (IS_DIRECTORY_SEP (nm[1])) { if (strcmp (nm, SDATA (name)) != 0) - name = build_string (nm); + name = make_specified_string (nm, -1, strlen (nm), + STRING_MULTIBYTE (name)); } else #endif /* drive must be set, so this is okay */ if (strcmp (nm - 2, SDATA (name)) != 0) { - name = make_string (nm - 2, p - nm + 2); - SSET (name, 0, DRIVE_LETTER (drive)); - SSET (name, 1, ':'); + char temp[] = " :"; + + name = make_specified_string (nm, -1, p - nm, + STRING_MULTIBYTE (name)); + temp[0] = DRIVE_LETTER (drive); + name = concat2 (build_string (temp), name); } return name; #else /* not DOS_NT */ if (nm == SDATA (name)) return name; - return build_string (nm); + return make_specified_string (nm, -1, strlen (nm), + STRING_MULTIBYTE (name)); #endif /* not DOS_NT */ } } @@ -1538,7 +1550,7 @@ See also the function `substitute-in-file-name'. */) absolute directory in nm produces "//", which will then be incorrectly treated as a network share. Ignore newdir in this case (keeping the drive letter). */ - if (!(drive && nm[0] && IS_DIRECTORY_SEP (newdir[0]) + if (!(drive && nm[0] && IS_DIRECTORY_SEP (newdir[0]) && newdir[1] == '\0')) #endif strcpy (target, newdir); @@ -1670,7 +1682,19 @@ See also the function `substitute-in-file-name'. */) CORRECT_DIR_SEPS (target); #endif /* DOS_NT */ - return make_string (target, o - target); + result = make_specified_string (target, -1, o - target, + STRING_MULTIBYTE (name)); + + /* Again look to see if the file name has special constructs in it + and perhaps call the corresponding file handler. This is needed + for filenames such as "/foo/../user@host:/bar/../baz". Expanding + the ".." component gives us "/user@host:/bar/../baz" which needs + to be expanded again. */ + handler = Ffind_file_name_handler (result, Qexpand_file_name); + if (!NILP (handler)) + return call3 (handler, Qexpand_file_name, result, default_directory); + + return result; } #if 0 @@ -2052,13 +2076,13 @@ duplicates what `expand-file-name' does. */) for (p = nm; p != endp; p++) { if ((p[0] == '~' -#if defined (APOLLO) || defined (WINDOWSNT) - /* // at start of file name is meaningful in Apollo and - WindowsNT systems. */ +#if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN) + /* // at start of file name is meaningful in Apollo, + WindowsNT and Cygwin systems. */ || (IS_DIRECTORY_SEP (p[0]) && p - 1 != nm) -#else /* not (APOLLO || WINDOWSNT) */ +#else /* not (APOLLO || WINDOWSNT || CYGWIN) */ || IS_DIRECTORY_SEP (p[0]) -#endif /* not (APOLLO || WINDOWSNT) */ +#endif /* not (APOLLO || WINDOWSNT || CYGWIN) */ ) && p != nm && (0 @@ -2101,7 +2125,8 @@ duplicates what `expand-file-name' does. */) } #ifdef VMS - return build_string (nm); + return make_specified_string (nm, -1, strlen (nm), + STRING_MULTIBYTE (filename)); #else /* See if any variables are substituted into the string @@ -2230,11 +2255,11 @@ duplicates what `expand-file-name' does. */) for (p = xnm; p != x; p++) if ((p[0] == '~' -#if defined (APOLLO) || defined (WINDOWSNT) +#if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN) || (IS_DIRECTORY_SEP (p[0]) && p - 1 != xnm) -#else /* not (APOLLO || WINDOWSNT) */ +#else /* not (APOLLO || WINDOWSNT || CYGWIN) */ || IS_DIRECTORY_SEP (p[0]) -#endif /* not (APOLLO || WINDOWSNT) */ +#endif /* not (APOLLO || WINDOWSNT || CYGWIN) */ ) && p != xnm && IS_DIRECTORY_SEP (p[-1])) xnm = p; @@ -2244,9 +2269,7 @@ duplicates what `expand-file-name' does. */) xnm = p; #endif - if (STRING_MULTIBYTE (filename)) - return make_string (xnm, x - xnm); - return make_unibyte_string (xnm, x - xnm); + return make_specified_string (xnm, -1, x - xnm, STRING_MULTIBYTE (filename)); badsubst: error ("Bad format environment-variable substitution"); @@ -2323,8 +2346,8 @@ barf_or_query_if_file_exists (absname, querystring, interactive, statptr, quick) Fcons (build_string ("File already exists"), Fcons (absname, Qnil))); GCPRO1 (absname); - tem = format1 ("File %s already exists; %s anyway? ", - SDATA (absname), querystring); + tem = format2 ("File %s already exists; %s anyway? ", + absname, build_string (querystring)); if (quick) tem = Fy_or_n_p (tem); else @@ -2402,10 +2425,11 @@ A prefix arg makes KEEP-TIME non-nil. */) #ifdef WINDOWSNT if (!CopyFile (SDATA (encoded_file), - SDATA (encoded_newname), + SDATA (encoded_newname), FALSE)) report_file_error ("Copying file", Fcons (file, Fcons (newname, Qnil))); - else if (!NILP (keep_time)) + /* CopyFile retains the timestamp by default. */ + else if (NILP (keep_time)) { EMACS_TIME now; DWORD attributes; @@ -2562,7 +2586,7 @@ DEFUN ("make-directory-internal", Fmake_directory_internal, } DEFUN ("delete-directory", Fdelete_directory, Sdelete_directory, 1, 1, "FDelete directory: ", - doc: /* Delete the directory named DIRECTORY. */) + doc: /* Delete the directory named DIRECTORY. Does not follow symlinks. */) (directory) Lisp_Object directory; { @@ -2588,15 +2612,21 @@ DEFUN ("delete-directory", Fdelete_directory, Sdelete_directory, 1, 1, "FDelete } DEFUN ("delete-file", Fdelete_file, Sdelete_file, 1, 1, "fDelete file: ", - doc: /* Delete file named FILENAME. + doc: /* Delete file named FILENAME. If it is a symlink, remove the symlink. If file has multiple names, it continues to exist with the other names. */) (filename) Lisp_Object filename; { Lisp_Object handler; Lisp_Object encoded_file; + struct gcpro gcpro1; - CHECK_STRING (filename); + GCPRO1 (filename); + if (!NILP (Ffile_directory_p (filename))) + Fsignal (Qfile_error, + Fcons (build_string ("Removing old name: is a directory"), + Fcons (filename, Qnil))); + UNGCPRO; filename = Fexpand_file_name (filename, Qnil); handler = Ffind_file_name_handler (filename, Qdelete_file); @@ -3156,7 +3186,7 @@ If there is no error, we return nil. */) DEFUN ("file-symlink-p", Ffile_symlink_p, Sfile_symlink_p, 1, 1, 0, doc: /* Return non-nil if file FILENAME is the name of a symbolic link. -The value is the name of the file to which it is linked. +The value is the link target, as a string. Otherwise returns nil. */) (filename) Lisp_Object filename; @@ -3186,7 +3216,7 @@ Otherwise returns nil. */) bufsize *= 2; buf = (char *) xrealloc (buf, bufsize); bzero (buf, bufsize); - + errno = 0; valsize = readlink (SDATA (filename), buf, bufsize); if (valsize == -1) @@ -3204,7 +3234,7 @@ Otherwise returns nil. */) } } while (valsize >= bufsize); - + val = make_string (buf, valsize); if (buf[0] == '/' && index (buf, ':')) val = concat2 (build_string ("/:"), val); @@ -3524,7 +3554,7 @@ static Lisp_Object read_non_regular () { int nbytes; - + immediate_quit = 1; QUIT; nbytes = emacs_read (non_regular_fd, @@ -3548,7 +3578,7 @@ read_non_regular_quit () DEFUN ("insert-file-contents", Finsert_file_contents, Sinsert_file_contents, 1, 5, 0, doc: /* Insert contents of file FILENAME after point. -Returns list of absolute file name and number of bytes inserted. +Returns list of absolute file name and number of characters inserted. If second argument VISIT is non-nil, the buffer's visited filename and last save file modtime are set, and it is marked unmodified. If visiting and the file does not exist, visiting is completed @@ -3790,7 +3820,7 @@ actually used. */) buf->undo_list = Qt; buf->overlays_before = Qnil; buf->overlays_after = Qnil; - + set_buffer_internal (buf); Ferase_buffer (); buf->enable_multibyte_characters = Qnil; @@ -3800,7 +3830,7 @@ actually used. */) val = call2 (Vset_auto_coding_function, filename, make_number (nread)); set_buffer_internal (prev); - + /* Discard the unwind protect for recovering the current buffer. */ specpdl_ptr--; @@ -3965,11 +3995,11 @@ actually used. */) break; total_read += nread; } - + /* Scan this bufferful from the end, comparing with the Emacs buffer. */ bufpos = total_read; - + /* Compare with same_at_start to avoid counting some buffer text as matching both at the file's beginning and at the end. */ while (bufpos > 0 && same_at_end > same_at_start @@ -4226,7 +4256,7 @@ actually used. */) if (coding.cmp_data && coding.cmp_data->used) coding_restore_composition (&coding, Fcurrent_buffer ()); coding_free_composition_data (&coding); - + /* Set `inserted' to the number of inserted characters. */ inserted = PT - temp; @@ -4271,15 +4301,15 @@ actually used. */) before exiting the loop, it is set to a negative value if I/O error occurs. */ how_much = 0; - + /* Total bytes inserted. */ inserted = 0; - + /* Here, we don't do code conversion in the loop. It is done by code_convert_region after all data are read into the buffer. */ { int gap_size = GAP_SIZE; - + while (how_much < total) { /* try is reserved in some compilers (Microsoft C) */ @@ -4323,7 +4353,7 @@ actually used. */) this = emacs_read (fd, BEG_ADDR + PT_BYTE - BEG_BYTE + inserted, trytry); immediate_quit = 0; } - + if (this <= 0) { how_much = this; @@ -4467,11 +4497,13 @@ actually used. */) inserted); } + /* Now INSERTED is measured in characters. */ + #ifdef DOS_NT /* Use the conversion type to determine buffer-file-type (find-buffer-file-type is now used to help determine the conversion). */ - if ((coding.eol_type == CODING_EOL_UNDECIDED + if ((coding.eol_type == CODING_EOL_UNDECIDED || coding.eol_type == CODING_EOL_LF) && ! CODING_REQUIRE_DECODING (&coding)) current_buffer->buffer_file_type = Qt; @@ -4512,11 +4544,24 @@ actually used. */) Fcons (orig_filename, Qnil))); } + if (set_coding_system) + Vlast_coding_system_used = coding.symbol; + + if (! NILP (Ffboundp (Qafter_insert_file_set_coding))) + { + insval = call1 (Qafter_insert_file_set_coding, make_number (inserted)); + if (! NILP (insval)) + { + CHECK_NUMBER (insval); + inserted = XFASTINT (insval); + } + } + /* Decode file format */ if (inserted > 0) { int empty_undo_list_p = 0; - + /* If we're anyway going to discard undo information, don't record it in the first place. The buffer's undo list at this point is either nil or t when visiting a file. */ @@ -4525,19 +4570,16 @@ actually used. */) empty_undo_list_p = NILP (current_buffer->undo_list); current_buffer->undo_list = Qt; } - + insval = call3 (Qformat_decode, Qnil, make_number (inserted), visit); CHECK_NUMBER (insval); inserted = XFASTINT (insval); - + if (!NILP (visit)) current_buffer->undo_list = empty_undo_list_p ? Qnil : Qt; } - if (set_coding_system) - Vlast_coding_system_used = coding.symbol; - /* Call after-change hooks for the inserted text, aside from the case of normal visiting (not with REPLACE), which is done in a new buffer "before" the buffer is changed. */ @@ -4649,7 +4691,7 @@ choose_write_coding_system (start, end, filename, if (NILP (current_buffer->enable_multibyte_characters)) force_raw_text = 1; } - + if (NILP (val)) { /* Check file-coding-system-alist. */ @@ -4671,7 +4713,7 @@ choose_write_coding_system (start, end, filename, val = current_buffer->buffer_file_coding_system; using_default_coding = 1; } - + if (!force_raw_text && !NILP (Ffboundp (Vselect_safe_coding_system_function))) /* Confirm that VAL can surely encode the current region. */ @@ -4965,7 +5007,7 @@ This does code conversion according to the value of if (!NILP (append) && !NILP (Ffile_regular_p (filename))) { long ret; - + if (NUMBERP (append)) ret = lseek (desc, XINT (append), 1); else @@ -4979,7 +5021,7 @@ This does code conversion according to the value of report_file_error ("Lseek error", Fcons (filename, Qnil)); } } - + UNGCPRO; #ifdef VMS @@ -5211,7 +5253,7 @@ build_annotations (start, end) for (i = 0; CONSP (p); p = XCDR (p), ++i) { struct buffer *given_buffer = current_buffer; - + Vwrite_region_annotations_so_far = annotations; /* Value is either a list of annotations or nil if the function @@ -5225,7 +5267,7 @@ build_annotations (start, end) XSETFASTINT (end, ZV); annotations = Qnil; } - + if (CONSP (res)) annotations = merge (annotations, res, Qcar_less_than_car); } @@ -5512,9 +5554,9 @@ auto_save_error (error) Lisp_Object args[3], msg; int i, nbytes; struct gcpro gcpro1; - + ring_bell (); - + args[0] = build_string ("Auto-saving %s: %s"); args[1] = current_buffer->name; args[2] = Ferror_message_string (error); @@ -5624,7 +5666,7 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */) old_message_p = push_message (); record_unwind_protect (pop_message_unwind, Qnil); } - + /* Ordinarily don't quit within this function, but don't make it impossible to quit (in case we get hung in I/O). */ oquit = Vquit_flag; @@ -5639,7 +5681,7 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */) if (STRINGP (Vauto_save_list_file_name)) { Lisp_Object listfile; - + listfile = Fexpand_file_name (Vauto_save_list_file_name, Qnil); /* Don't try to create the directory when shutting down Emacs, @@ -5657,7 +5699,7 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */) do_auto_save_eh); UNGCPRO; } - + stream = fopen (SDATA (listfile), "w"); if (stream != NULL) { @@ -5953,7 +5995,7 @@ DEFUN ("read-file-name-internal", Fread_file_name_internal, Sread_file_name_inte #ifndef VMS if (EQ (Vread_file_name_predicate, Qfile_directory_p)) { - /* Brute-force speed up for directory checking: + /* Brute-force speed up for directory checking: Discard strings which don't end in a slash. */ for (comp = Qnil; CONSP (all); all = XCDR (all)) { @@ -6003,7 +6045,7 @@ Default name to DEFAULT-FILENAME if user enters a null string. Fourth arg MUSTMATCH non-nil means require existing file's name. Non-nil and non-t means also require confirmation after completion. Fifth arg INITIAL specifies text to start with. -If optional sixth arg PREDICATE is non-nil, possible completions and the +If optional sixth arg PREDICATE is non-nil, possible completions and the resulting file name must satisfy (funcall PREDICATE NAME). DIR defaults to current buffer's directory default. @@ -6016,6 +6058,7 @@ provides a file dialog box. */) Lisp_Object val, insdef, tem; struct gcpro gcpro1, gcpro2; register char *homedir; + Lisp_Object decoded_homedir; int replace_in_history = 0; int add_to_history = 0; int count; @@ -6038,25 +6081,29 @@ provides a file dialog box. */) CORRECT_DIR_SEPS (homedir); } #endif + if (homedir != 0) + decoded_homedir + = DECODE_FILE (make_unibyte_string (homedir, strlen (homedir))); if (homedir != 0 && STRINGP (dir) - && !strncmp (homedir, SDATA (dir), strlen (homedir)) - && IS_DIRECTORY_SEP (SREF (dir, strlen (homedir)))) + && !strncmp (SDATA (decoded_homedir), SDATA (dir), + SBYTES (decoded_homedir)) + && IS_DIRECTORY_SEP (SREF (dir, SBYTES (decoded_homedir)))) { - dir = make_string (SDATA (dir) + strlen (homedir) - 1, - SBYTES (dir) - strlen (homedir) + 1); - SSET (dir, 0, '~'); + dir = Fsubstring (dir, make_number (SCHARS (decoded_homedir)), Qnil); + dir = concat2 (build_string ("~"), dir); } /* Likewise for default_filename. */ if (homedir != 0 && STRINGP (default_filename) - && !strncmp (homedir, SDATA (default_filename), strlen (homedir)) - && IS_DIRECTORY_SEP (SREF (default_filename, strlen (homedir)))) + && !strncmp (SDATA (decoded_homedir), SDATA (default_filename), + SBYTES (decoded_homedir)) + && IS_DIRECTORY_SEP (SREF (default_filename, SBYTES (decoded_homedir)))) { default_filename - = make_string (SDATA (default_filename) + strlen (homedir) - 1, - SBYTES (default_filename) - strlen (homedir) + 1); - SSET (default_filename, 0, '~'); + = Fsubstring (default_filename, + make_number (SCHARS (decoded_homedir)), Qnil); + default_filename = concat2 (build_string ("~"), default_filename); } if (!NILP (default_filename)) { @@ -6106,12 +6153,12 @@ provides a file dialog box. */) #endif specbind (intern ("minibuffer-completing-file-name"), Qt); - specbind (intern ("read-file-name-predicate"), + specbind (intern ("read-file-name-predicate"), (NILP (predicate) ? Qfile_exists_p : predicate)); GCPRO2 (insdef, default_filename); - -#if defined (USE_MOTIF) || defined (HAVE_NTGUI) + +#if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event)) && use_dialog_box && have_menus_p ()) @@ -6186,7 +6233,7 @@ provides a file dialog box. */) Fset (Qfile_name_history, Fcons (val1, tem)); } - + return val; } @@ -6311,7 +6358,9 @@ same format as a regular save would use. */); staticpro (&Qformat_decode); Qformat_annotate_function = intern ("format-annotate-function"); staticpro (&Qformat_annotate_function); - + Qafter_insert_file_set_coding = intern ("after-insert-file-set-coding"); + staticpro (&Qafter_insert_file_set_coding); + Qcar_less_than_car = intern ("car-less-than-car"); staticpro (&Qcar_less_than_car); @@ -6383,10 +6432,11 @@ or local variable spec of the tailing lines with `coding:' tag. */); DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions, doc: /* A list of functions to be called at the end of `insert-file-contents'. -Each is passed one argument, the number of bytes inserted. It should return -the new byte count, and leave point the same. If `insert-file-contents' is -intercepted by a handler from `file-name-handler-alist', that handler is -responsible for calling the after-insert-file-functions if appropriate. */); +Each is passed one argument, the number of characters inserted. +It should return the new character count, and leave point the same. +If `insert-file-contents' is intercepted by a handler from +`file-name-handler-alist', that handler is responsible for calling the +functions in `after-insert-file-functions' if appropriate. */); Vafter_insert_file_functions = Qnil; DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions, @@ -6483,4 +6533,3 @@ a non-nil value. */); defsubr (&Sunix_sync); #endif } -