@var{target} at the time the opening is done, or will get an error if
the name @var{target} is nonexistent at that time. This command does
not expand the argument @var{target}, so that it allows you to specify
-a relative name as the target of the link. On MS-Windows, this
-command works only on MS Windows Vista and later. On remote systems,
+a relative name as the target of the link. However, this command
+does expand leading @samp{~} in @var{target} so that you can easily
+specify home directories, and strips leading @samp{/:} so that you can
+specify relative names beginning with literal @samp{~} or @samp{/:}.
+@xref{Quoted File Names}. On MS-Windows, this command works only on
+MS Windows Vista and later. When @var{new} is remote,
it works depending on the system type.
@node Misc File Ops
SELinux context are not copied over in either case.
@end deffn
-@deffn Command make-symbolic-link filename newname &optional ok-if-already-exists
+@deffn Command make-symbolic-link target newname &optional ok-if-already-exists
@pindex ln
@kindex file-already-exists
-This command makes a symbolic link to @var{filename}, named
+This command makes a symbolic link to @var{target}, named
@var{newname}. This is like the shell command @samp{ln -s
-@var{filename} @var{newname}}. The @var{filename} argument
+@var{target} @var{newname}}. The @var{target} argument
is treated only as a string; it need not name an existing file.
-If @var{filename} is a relative file name, the resulting symbolic link
+If @var{ok-if-already-exists} is an integer, indicating interactive
+use, then leading @samp{~} is expanded and leading @samp{/:} is
+stripped in the @var{target} string.
+If @var{target} is a relative file name, the resulting symbolic link
is interpreted relative to the directory containing the symbolic link.
@xref{Relative File Names}.
instead of to utf-8. Before this change, Emacs would sometimes
mishandle file names containing these control characters.
++++
+** 'file-attributes', 'file-symlink-p' and 'make-symbolic-link' no
+longer quietly mutate the target of a local symbolic link, so that
+Emacs can access and copy them reliably regardless of their contents.
+The following changes are involved.
+
+*** 'file-attributes' and 'file-symlink-p' no longer prepend "/:" to
+symbolic links whose targets begin with "/" and contain ":". For
+example, if a symbolic link "x" has a target "/y:z", (file-symlink-p
+"x") now returns "/y:z" rather than "/:/y:z".
+
+*** 'make-symbolic-link' no longer looks for file name handlers when
+creating a local symbolic link. For example, (make-symbolic-link
+"/y:z" "x") now creates a symlink to "/y:z" instead of failing.
+
+*** 'make-symbolic-link' now expands a link target with leading "~"
+only when the optional third arg is an integer, as when invoked
+interactively. For example, (make-symbolic-link "~y" "x") now creates
+a link with target the literal string "~y"; to get the old behavior,
+use (make-symbolic-link (expand-file-name "~y") "x"). To avoid this
+expansion in interactive use, you can now prefix the link target with
+"/:". For example, (make-symbolic-link "/:~y" "x" 1) now creates a
+link to literal "~y".
+
+++
** Module functions are now implemented slightly differently; in
particular, the function 'internal--module-call' has been removed.
(if (and enable-multibyte-characters
(not (multibyte-string-p file)))
(setq file (string-to-multibyte file)))))
- (and file (file-name-absolute-p file)
- ;; A relative file name can start with ~.
- ;; Don't treat it as absolute in this context.
- (not (eq (aref file 0) ?~))
+ (and file (files--name-absolute-system-p file)
(setq already-absolute t))
(cond
((null file)
(funcall handler 'file-local-copy file)
nil)))
+(defun files--name-absolute-system-p (file)
+ "Return non-nil if FILE is an absolute name to the operating system.
+This is like `file-name-absolute-p', except that it returns nil for
+names beginning with `~'."
+ (and (file-name-absolute-p file)
+ (not (eq (aref file 0) ?~))))
+
(defun file-truename (filename &optional counter prev-dirs)
"Return the truename of FILENAME.
If FILENAME is not absolute, first expands it against `default-directory'.
;; since target might look like foo/../bar where foo
;; is itself a link. Instead, we handle . and .. above.
(setq filename
- (if (file-name-absolute-p target)
- target
- (concat dir target))
+ (concat (if (files--name-absolute-system-p target)
+ "/:" dir)
+ target)
done nil)
;; No, we are done!
(setq done t))))))))
(directory-file-name (file-name-directory newname))))
;; Now find the parent of that dir.
(setq newname (file-name-directory newname)))
- (setq newname (expand-file-name tem (file-name-directory newname)))
+ (setq newname (concat (if (files--name-absolute-system-p tem)
+ "/:"
+ (file-name-directory newname))
+ tem))
(setq count (1+ count))))
newname))
;; If NEWNAME is an existing directory and COPY-CONTENTS
;; is nil, copy into NEWNAME/[DIRECTORY-BASENAME].
((not copy-contents)
- (setq newname (expand-file-name
+ (setq newname (concat
+ (file-name-as-directory newname)
(file-name-nondirectory
- (directory-file-name directory))
- newname))
+ (directory-file-name directory))))
(and (file-exists-p newname)
(not (file-directory-p newname))
(error "Cannot overwrite non-directory %s with a directory"
;; We do not want to copy "." and "..".
(directory-files directory 'full
directory-files-no-dot-files-regexp))
- (let ((target (expand-file-name (file-name-nondirectory file) newname))
+ (let ((target (concat (file-name-as-directory newname)
+ (file-name-nondirectory file)))
(filetype (car (file-attributes file))))
(cond
((eq filetype t) ; Directory but not a symlink.
;; If `trash-directory' is non-nil, move the file there.
(let* ((trash-dir (expand-file-name trash-directory))
(fn (directory-file-name (expand-file-name filename)))
- (new-fn (expand-file-name (file-name-nondirectory fn)
- trash-dir)))
+ (new-fn (concat (file-name-as-directory trash-dir)
+ (file-name-nondirectory fn))))
;; We can't trash a parent directory of trash-directory.
(if (string-prefix-p fn trash-dir)
(error "Trash directory `%s' is a subdirectory of `%s'"
Both args must be strings.
Signal a `file-already-exists' error if a file LINKNAME already exists
unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
-An integer third arg means request confirmation if LINKNAME already exists.
+An integer third arg means request confirmation if LINKNAME already
+exists, and expand leading "~" or strip leading "/:" in TARGET.
This happens for interactive use with M-x. */)
(Lisp_Object target, Lisp_Object linkname, Lisp_Object ok_if_already_exists)
{
Lisp_Object encoded_target, encoded_linkname;
CHECK_STRING (target);
- /* If the link target has a ~, we must expand it to get
- a truly valid file name. Otherwise, do not expand;
- we want to permit links to relative file names. */
- if (SREF (target, 0) == '~')
- target = Fexpand_file_name (target, Qnil);
-
+ if (INTEGERP (ok_if_already_exists))
+ {
+ if (SREF (target, 0) == '~')
+ target = Fexpand_file_name (target, Qnil);
+ else if (SREF (target, 0) == '/' && SREF (target, 1) == ':')
+ target = Fsubstring_no_properties (target, make_number (2), Qnil);
+ }
linkname = expand_cp_target (target, linkname);
- /* If the file name has special constructs in it,
- call the corresponding file handler. */
- handler = Ffind_file_name_handler (target, Qmake_symbolic_link);
- if (!NILP (handler))
- return call4 (handler, Qmake_symbolic_link, target,
- linkname, ok_if_already_exists);
-
/* If the new link name has special constructs in it,
call the corresponding file handler. */
handler = Ffind_file_name_handler (linkname, Qmake_symbolic_link);
return Qnil;
val = build_unibyte_string (buf);
- if (buf[0] == '/' && strchr (buf, ':'))
- {
- AUTO_STRING (slash_colon, "/:");
- val = concat2 (slash_colon, val);
- }
if (buf != readlink_buf)
xfree (buf);
val = DECODE_FILE (val);
(require 'ert)
-(defun try-char (char link)
- (let ((target (string char)))
- (make-symbolic-link target link)
- (let* ((read-link (file-symlink-p link))
- (failure (unless (string-equal target read-link)
- (list 'string-equal target read-link))))
- (delete-file link)
- failure)))
+(defun try-link (target link)
+ (make-symbolic-link target link)
+ (let* ((read-link (file-symlink-p link))
+ (failure (unless (string-equal target read-link)
+ (list 'string-equal target read-link))))
+ (delete-file link)
+ failure))
(defun fileio-tests--symlink-failure ()
(let* ((dir (make-temp-file "fileio" t))
(char 0))
(while (and (not failure) (< char 127))
(setq char (1+ char))
- (unless (= char ?~)
- (setq failure (try-char char link))))
- failure)
+ (setq failure (try-link (string char) link)))
+ (or failure
+ (try-link "/:" link)))
(delete-directory dir t))))
(ert-deftest fileio-tests--odd-symlink-chars ()
projects / emacs.git / commitdiff