commit 57a77f833e37abe2f7936585e9915b6947e3564a (HEAD, refs/remotes/origin/master) Author: Michael Albinus Date: Fri Dec 9 10:03:05 2016 +0100 Document file-name-quote, file-name-unquote and file-name-quoted-p * doc/lispref/files.texi (File Name Expansion): * etc/NEWS: Mention file-name-quote, file-name-unquote and file-name-quoted-p. * lisp/files.el (file-name-non-special): Revert using file-name-quote, file-name-unquote and file-name-quoted-p. diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 26db93c..906cd56 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -2402,6 +2402,47 @@ through the immediately preceding @samp{/}). @end defun + Sometimes, it is not desired to expand file names. In such cases, +the file name can be quoted to suppress the expansion, and to handle +the file name literally. Quoting happens by prefixing the file name +with @samp{/:}. + +@defmac file-name-quote name +This macro adds the quotation prefix @samp{/:} to the file @var{name}. +For a local file @var{name}, it prefixes @var{name} with @samp{/:}. +If @var{name} is a remote file name, the local part of @var{name} is +quoted. If @var{name} is already a quoted file name, @var{name} is +returned unchanged. + +@example +@group +(substitute-in-file-name (file-name-quote "bar/~/foo")) + @result{} "/:bar/~/foo" +@end group + +@group +(substitute-in-file-name (file-name-quote "/ssh:host:bar/~/foo")) + @result{} "/ssh:host:/:bar/~/foo" +@end group +@end example + +The macro cannot be used to suppress file name handlers from magic +file names (@pxref{Magic File Names}). +@end defmac + +@defmac file-name-unquote name +This macro removes the quotation prefix @samp{/:} from the file +@var{name}, if any. If @var{name} is a remote file name, the local +part of @var{name} is unquoted. +@end defmac + +@defmac file-name-quoted-p name +This macro returns non-@code{nil}, when @var{name} is quoted with the +prefix @samp{/:}. If @var{name} is a remote file name, the local part +of @var{name} is checked. +@end defmac + + @node Unique File Names @subsection Generating Unique File Names @cindex unique file names diff --git a/etc/NEWS b/etc/NEWS index a62668a..614b614 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -749,6 +749,11 @@ can be used for creation of temporary files of remote or mounted directories. of remote processes. +++ +** The new functions 'file-name-quote', 'file-name-unquote' and +'file-name-quoted-p' can be used to quote / unquote file names with +the prefix "/:". + ++++ ** The new error 'file-missing', a subcategory of 'file-error', is now signaled instead of 'file-error' if a file operation acts on a file that does not exist. diff --git a/lisp/files.el b/lisp/files.el index 6f6e868..790f6ce 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -6923,19 +6923,24 @@ only these files will be asked to be saved." (save-match-data (while (consp file-arg-indices) (let ((pair (nthcdr (car file-arg-indices) arguments))) - (and (car pair) (setcar pair (file-name-unquote (car pair))))) + (and (car pair) + (string-match "\\`/:" (car pair)) + (setcar pair + (if (= (length (car pair)) 2) + "/" + (substring (car pair) 2))))) (setq file-arg-indices (cdr file-arg-indices)))) (pcase method (`identity (car arguments)) - (`add (file-name-quote (apply operation arguments))) + (`add (concat "/:" (apply operation arguments))) (`insert-file-contents (let ((visit (nth 1 arguments))) (unwind-protect (apply operation arguments) (when (and visit buffer-file-name) - (setq buffer-file-name (file-name-quote buffer-file-name)))))) + (setq buffer-file-name (concat "/:" buffer-file-name)))))) (`unquote-then-quote - (let ((buffer-file-name (file-name-unquote buffer-file-name))) + (let ((buffer-file-name (substring buffer-file-name 2))) (apply operation arguments))) (_ (apply operation arguments))))) commit 8f611e5e2309ae3f7f1753f0d2f7a60ca6fc2657 Author: Noam Postavsky Date: Fri Dec 9 00:14:48 2016 -0500 Fix bad quoting of python-shell-interpreter `python-shell-calculate-command' was using `shell-quote-argument' as if it was generating a shell command, but its callers don't pass the result to a shell, and they expect to parse it with `split-string-and-unquote'. This caused problems depending on the flavor of shell quoting in effect (Bug#25025). * lisp/progmodes/python.el (python-shell-calculate-command): Use `combine-and-quote-strings' to quote the interpreter, so that it can be parsed by `python-shell-make-comint' successfully using `split-string-and-unquote'. diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index af8b791..3701812 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -2379,7 +2379,9 @@ the `buffer-name'." (defun python-shell-calculate-command () "Calculate the string used to execute the inferior Python process." (format "%s %s" - (shell-quote-argument python-shell-interpreter) + ;; `python-shell-make-comint' expects to be able to + ;; `split-string-and-unquote' the result of this function. + (combine-and-quote-strings (list python-shell-interpreter)) python-shell-interpreter-args)) (define-obsolete-function-alias commit 7f106f48e9c35eb75e5f06181e93d481988f8527 Author: Paul Eggert Date: Thu Dec 8 18:17:15 2016 -0800 * src/lisp.h (struct terminal): Remove unnecessary forward decl. diff --git a/src/lisp.h b/src/lisp.h index b9c6289..11e49b6 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4281,9 +4281,6 @@ extern void syms_of_xmenu (void); /* Defined in termchar.h. */ struct tty_display_info; -/* Defined in termhooks.h. */ -struct terminal; - /* Defined in sysdep.c. */ #ifdef HAVE_PERSONALITY_ADDR_NO_RANDOMIZE extern bool disable_address_randomization (void); commit f0a1e9ec3fba3d5bea5bd62f525dba3fb005d1b1 Author: Paul Eggert Date: Thu Dec 8 11:32:48 2016 -0800 Make read1 more reentrant This is needed if ‘read’ is called soon after startup, before the Unicode tables have been set up, and it reads a \N escape and needs to look up a value the Unicode tables, a lookup that in turn calls read1 recursively. Although this change doesn’t make ‘read’ fully reentrant, it’s good enough to handle this case. * src/lread.c (read_buffer_size, read_buffer): Remove static vars. (grow_read_buffer): Revamp to use locals, not statics, and to record memory allocation un the specpdl. All callers changed. (read1): Start with a stack-based buffer, and use the heap only if the stack buffer is too small. Use unbind_to to free any heap buffer allocated. Use bool for boolean. Redo symbol loop so that only one call to grow_read_buffer is needed. (init_obarray): Remove no-longer-needed initialization. diff --git a/src/lread.c b/src/lread.c index 1335ccf..157a392 100644 --- a/src/lread.c +++ b/src/lread.c @@ -2144,16 +2144,28 @@ read0 (Lisp_Object readcharfun) Fmake_string (make_number (1), make_number (c))); } -static ptrdiff_t read_buffer_size; -static char *read_buffer; - -/* Grow the read buffer by at least MAX_MULTIBYTE_LENGTH bytes. */ - -static void -grow_read_buffer (void) +/* Grow a read buffer BUF that contains OFFSET useful bytes of data, + by at least MAX_MULTIBYTE_LENGTH bytes. Update *BUF_ADDR and + *BUF_SIZE accordingly; 0 <= OFFSET <= *BUF_SIZE. If *BUF_ADDR is + initially null, BUF is on the stack: copy its data to the new heap + buffer. Otherwise, BUF must equal *BUF_ADDR and can simply be + reallocated. Either way, remember the heap allocation (which is at + pdl slot COUNT) so that it can be freed when unwinding the stack.*/ + +static char * +grow_read_buffer (char *buf, ptrdiff_t offset, + char **buf_addr, ptrdiff_t *buf_size, ptrdiff_t count) { - read_buffer = xpalloc (read_buffer, &read_buffer_size, - MAX_MULTIBYTE_LENGTH, -1, 1); + char *p = xpalloc (*buf_addr, buf_size, MAX_MULTIBYTE_LENGTH, -1, 1); + if (!*buf_addr) + { + memcpy (p, buf, offset); + record_unwind_protect_ptr (xfree, p); + } + else + set_unwind_protect_ptr (count, xfree, p); + *buf_addr = p; + return p; } /* Return the scalar value that has the Unicode character name NAME. @@ -2432,6 +2444,9 @@ read_escape (Lisp_Object readcharfun, bool stringp) if (length == 0) invalid_syntax ("Empty character name"); name[length] = '\0'; + + /* character_name_to_code can invoke read1, recursively. + This is why read1's buffer is not static. */ return character_name_to_code (name, length); } @@ -2541,8 +2556,9 @@ static Lisp_Object read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) { int c; - bool uninterned_symbol = 0; + bool uninterned_symbol = false; bool multibyte; + char stackbuf[MAX_ALLOCA]; *pch = 0; @@ -2873,7 +2889,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) /* #:foo is the uninterned symbol named foo. */ if (c == ':') { - uninterned_symbol = 1; + uninterned_symbol = true; c = READCHAR; if (!(c > 040 && c != NO_BREAK_SPACE @@ -3084,16 +3100,20 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) case '"': { + ptrdiff_t count = SPECPDL_INDEX (); + char *read_buffer = stackbuf; + ptrdiff_t read_buffer_size = sizeof stackbuf; + char *heapbuf = NULL; char *p = read_buffer; char *end = read_buffer + read_buffer_size; int ch; /* True if we saw an escape sequence specifying a multibyte character. */ - bool force_multibyte = 0; + bool force_multibyte = false; /* True if we saw an escape sequence specifying a single-byte character. */ - bool force_singlebyte = 0; - bool cancel = 0; + bool force_singlebyte = false; + bool cancel = false; ptrdiff_t nchars = 0; while ((ch = READCHAR) >= 0 @@ -3102,7 +3122,9 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) if (end - p < MAX_MULTIBYTE_LENGTH) { ptrdiff_t offset = p - read_buffer; - grow_read_buffer (); + read_buffer = grow_read_buffer (read_buffer, offset, + &heapbuf, &read_buffer_size, + count); p = read_buffer + offset; end = read_buffer + read_buffer_size; } @@ -3117,7 +3139,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) if (ch == -1) { if (p == read_buffer) - cancel = 1; + cancel = true; continue; } @@ -3125,9 +3147,9 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) ch = ch & ~CHAR_MODIFIER_MASK; if (CHAR_BYTE8_P (ch)) - force_singlebyte = 1; + force_singlebyte = true; else if (! ASCII_CHAR_P (ch)) - force_multibyte = 1; + force_multibyte = true; else /* I.e. ASCII_CHAR_P (ch). */ { /* Allow `\C- ' and `\C-?'. */ @@ -3153,7 +3175,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) string. */ modifiers &= ~CHAR_META; ch = BYTE8_TO_CHAR (ch | 0x80); - force_singlebyte = 1; + force_singlebyte = true; } } @@ -3166,9 +3188,9 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) { p += CHAR_STRING (ch, (unsigned char *) p); if (CHAR_BYTE8_P (ch)) - force_singlebyte = 1; + force_singlebyte = true; else if (! ASCII_CHAR_P (ch)) - force_multibyte = 1; + force_multibyte = true; } nchars++; } @@ -3180,7 +3202,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) return zero instead. This is for doc strings that we are really going to find in etc/DOC.nn.nn. */ if (!NILP (Vpurify_flag) && NILP (Vdoc_file_name) && cancel) - return make_number (0); + return unbind_to (count, make_number (0)); if (! force_multibyte && force_singlebyte) { @@ -3191,9 +3213,11 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) p = read_buffer + nchars; } - return make_specified_string (read_buffer, nchars, p - read_buffer, - (force_multibyte - || (p - read_buffer != nchars))); + Lisp_Object result + = make_specified_string (read_buffer, nchars, p - read_buffer, + (force_multibyte + || (p - read_buffer != nchars))); + return unbind_to (count, result); } case '.': @@ -3221,81 +3245,74 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) read_symbol: { + ptrdiff_t count = SPECPDL_INDEX (); + char *read_buffer = stackbuf; + ptrdiff_t read_buffer_size = sizeof stackbuf; + char *heapbuf = NULL; char *p = read_buffer; - bool quoted = 0; + char *end = read_buffer + read_buffer_size; + bool quoted = false; EMACS_INT start_position = readchar_count - 1; - { - char *end = read_buffer + read_buffer_size; - - do - { - if (end - p < MAX_MULTIBYTE_LENGTH) - { - ptrdiff_t offset = p - read_buffer; - grow_read_buffer (); - p = read_buffer + offset; - end = read_buffer + read_buffer_size; - } + do + { + if (end - p < MAX_MULTIBYTE_LENGTH + 1) + { + ptrdiff_t offset = p - read_buffer; + read_buffer = grow_read_buffer (read_buffer, offset, + &heapbuf, &read_buffer_size, + count); + p = read_buffer + offset; + end = read_buffer + read_buffer_size; + } - if (c == '\\') - { - c = READCHAR; - if (c == -1) - end_of_file_error (); - quoted = 1; - } + if (c == '\\') + { + c = READCHAR; + if (c == -1) + end_of_file_error (); + quoted = true; + } - if (multibyte) - p += CHAR_STRING (c, (unsigned char *) p); - else - *p++ = c; - c = READCHAR; - } - while (c > 040 - && c != NO_BREAK_SPACE - && (c >= 0200 - || strchr ("\"';()[]#`,", c) == NULL)); + if (multibyte) + p += CHAR_STRING (c, (unsigned char *) p); + else + *p++ = c; + c = READCHAR; + } + while (c > 040 + && c != NO_BREAK_SPACE + && (c >= 0200 + || strchr ("\"';()[]#`,", c) == NULL)); - if (p == end) - { - ptrdiff_t offset = p - read_buffer; - grow_read_buffer (); - p = read_buffer + offset; - end = read_buffer + read_buffer_size; - } - *p = 0; - UNREAD (c); - } + *p = 0; + UNREAD (c); if (!quoted && !uninterned_symbol) { Lisp_Object result = string_to_number (read_buffer, 10, 0); if (! NILP (result)) - return result; + return unbind_to (count, result); } - { - Lisp_Object name, result; - ptrdiff_t nbytes = p - read_buffer; - ptrdiff_t nchars - = (multibyte - ? multibyte_chars_in_text ((unsigned char *) read_buffer, - nbytes) - : nbytes); - - name = ((uninterned_symbol && ! NILP (Vpurify_flag) - ? make_pure_string : make_specified_string) - (read_buffer, nchars, nbytes, multibyte)); - result = (uninterned_symbol ? Fmake_symbol (name) - : Fintern (name, Qnil)); - - if (EQ (Vread_with_symbol_positions, Qt) - || EQ (Vread_with_symbol_positions, readcharfun)) - Vread_symbol_positions_list - = Fcons (Fcons (result, make_number (start_position)), - Vread_symbol_positions_list); - return result; - } + + ptrdiff_t nbytes = p - read_buffer; + ptrdiff_t nchars + = (multibyte + ? multibyte_chars_in_text ((unsigned char *) read_buffer, + nbytes) + : nbytes); + Lisp_Object name = ((uninterned_symbol && ! NILP (Vpurify_flag) + ? make_pure_string : make_specified_string) + (read_buffer, nchars, nbytes, multibyte)); + Lisp_Object result = (uninterned_symbol ? Fmake_symbol (name) + : Fintern (name, Qnil)); + + if (EQ (Vread_with_symbol_positions, Qt) + || EQ (Vread_with_symbol_positions, readcharfun)) + Vread_symbol_positions_list + = Fcons (Fcons (result, make_number (start_position)), + Vread_symbol_positions_list); + return unbind_to (count, result); } } } @@ -4104,12 +4121,7 @@ OBARRAY defaults to the value of `obarray'. */) void init_obarray (void) { - Lisp_Object oblength; - ptrdiff_t size = 100 + MAX_MULTIBYTE_LENGTH; - - XSETFASTINT (oblength, OBARRAY_SIZE); - - Vobarray = Fmake_vector (oblength, make_number (0)); + Vobarray = Fmake_vector (make_number (OBARRAY_SIZE), make_number (0)); initial_obarray = Vobarray; staticpro (&initial_obarray); @@ -4132,9 +4144,6 @@ init_obarray (void) Vpurify_flag = Qt; DEFSYM (Qvariable_documentation, "variable-documentation"); - - read_buffer = xmalloc (size); - read_buffer_size = size; } void commit 162ba405ac144c2a0cb6854f791ff7d3203b0e2f Author: Paul Eggert Date: Thu Dec 8 10:43:11 2016 -0800 Fix unlikely substitute-command-keys memory leak * src/doc.c (Fsubstitute_command_keys): Free buffer when unwinding. diff --git a/src/doc.c b/src/doc.c index ce4f89b..6a78ed6 100644 --- a/src/doc.c +++ b/src/doc.c @@ -772,6 +772,8 @@ Otherwise, return a new string. */) /* Extra room for expansion due to replacing ‘\[]’ with ‘M-x ’. */ enum { EXTRA_ROOM = sizeof "M-x " - sizeof "\\[]" }; + ptrdiff_t count = SPECPDL_INDEX (); + if (bsize <= sizeof sbuf - EXTRA_ROOM) { abuf = NULL; @@ -779,7 +781,10 @@ Otherwise, return a new string. */) bsize = sizeof sbuf; } else - buf = abuf = xpalloc (NULL, &bsize, EXTRA_ROOM, STRING_BYTES_BOUND, 1); + { + buf = abuf = xpalloc (NULL, &bsize, EXTRA_ROOM, STRING_BYTES_BOUND, 1); + record_unwind_protect_ptr (xfree, abuf); + } bufp = buf; strp = SDATA (str); @@ -929,7 +934,12 @@ Otherwise, return a new string. */) abuf = xpalloc (abuf, &bsize, need - avail, STRING_BYTES_BOUND, 1); if (buf == sbuf) - memcpy (abuf, sbuf, offset); + { + record_unwind_protect_ptr (xfree, abuf); + memcpy (abuf, sbuf, offset); + } + else + set_unwind_protect_ptr (count, xfree, abuf); buf = abuf; bufp = buf + offset; } @@ -988,8 +998,7 @@ Otherwise, return a new string. */) } else tem = string; - xfree (abuf); - return tem; + return unbind_to (count, tem); } void commit c685e4c92909b2ae0140953417e0d856eb34ba33 Author: Michael Albinus Date: Thu Dec 8 18:33:26 2016 +0100 ; Fix last patch diff --git a/lisp/files.el b/lisp/files.el index ba60046..6f6e868 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -6923,7 +6923,7 @@ only these files will be asked to be saved." (save-match-data (while (consp file-arg-indices) (let ((pair (nthcdr (car file-arg-indices) arguments))) - (and (car pair) (setcar pair (file-name-unquote 2)))) + (and (car pair) (setcar pair (file-name-unquote (car pair))))) (setq file-arg-indices (cdr file-arg-indices)))) (pcase method (`identity (car arguments)) @@ -6935,7 +6935,7 @@ only these files will be asked to be saved." (when (and visit buffer-file-name) (setq buffer-file-name (file-name-quote buffer-file-name)))))) (`unquote-then-quote - (let ((buffer-file-name (substring buffer-file-name 2))) + (let ((buffer-file-name (file-name-unquote buffer-file-name))) (apply operation arguments))) (_ (apply operation arguments))))) commit b67fdee18b07d55c44f3513d3d8a15d3b34ab4b6 Author: Michael Albinus Date: Thu Dec 8 18:00:10 2016 +0100 Add file-name-quoted-p, file-name-quote, file-name-unquote * lisp/files.el (file-name-quoted-p, file-name-quote) (file-name-unquote): New defsubst. (find-file--read-only, find-file-noselect) (file-name-non-special): Use them. diff --git a/lisp/files.el b/lisp/files.el index 54e8495..ba60046 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1605,7 +1605,7 @@ file names with wildcards." (defun find-file--read-only (fun filename wildcards) (unless (or (and wildcards find-file-wildcards - (not (string-match "\\`/:" filename)) + (not (file-name-quoted-p filename)) (string-match "[[*?]" filename)) (file-exists-p filename)) (error "%s does not exist" filename)) @@ -1985,7 +1985,7 @@ the various files." (error "%s is a directory" filename)) (if (and wildcards find-file-wildcards - (not (string-match "\\`/:" filename)) + (not (file-name-quoted-p filename)) (string-match "[[*?]" filename)) (let ((files (condition-case nil (file-expand-wildcards filename t) @@ -6923,27 +6923,44 @@ only these files will be asked to be saved." (save-match-data (while (consp file-arg-indices) (let ((pair (nthcdr (car file-arg-indices) arguments))) - (and (car pair) - (string-match "\\`/:" (car pair)) - (setcar pair - (if (= (length (car pair)) 2) - "/" - (substring (car pair) 2))))) + (and (car pair) (setcar pair (file-name-unquote 2)))) (setq file-arg-indices (cdr file-arg-indices)))) (pcase method (`identity (car arguments)) - (`add (concat "/:" (apply operation arguments))) + (`add (file-name-quote (apply operation arguments))) (`insert-file-contents (let ((visit (nth 1 arguments))) (unwind-protect (apply operation arguments) (when (and visit buffer-file-name) - (setq buffer-file-name (concat "/:" buffer-file-name)))))) + (setq buffer-file-name (file-name-quote buffer-file-name)))))) (`unquote-then-quote (let ((buffer-file-name (substring buffer-file-name 2))) (apply operation arguments))) (_ (apply operation arguments))))) + +(defsubst file-name-quoted-p (name) + "Whether NAME is quoted with prefix \"/:\". +If NAME is a remote file name, check the local part of NAME." + (string-prefix-p "/:" (file-local-name name))) + +(defsubst file-name-quote (name) + "Add the quotation prefix \"/:\" to file NAME. +If NAME is a remote file name, the local part of NAME is quoted. +If NAME is already a quoted file name, NAME is returned unchanged." + (if (file-name-quoted-p name) + name + (concat (file-remote-p name) "/:" (file-local-name name)))) + +(defsubst file-name-unquote (name) + "Remove quotation prefix \"/:\" from file NAME, if any. +If NAME is a remote file name, the local part of NAME is unquoted." + (let ((localname (file-local-name name))) + (when (file-name-quoted-p localname) + (setq + localname (if (= (length localname) 2) "/" (substring localname 2)))) + (concat (file-remote-p name) localname))) ;; Symbolic modes and read-file-modes.