Function: dired-make-relative-symlink

dired-make-relative-symlink is an interactive and byte-compiled function defined in dired-aux.el.gz.

Signature

(dired-make-relative-symlink FILE1 FILE2 &optional OK-IF-ALREADY-EXISTS)

Documentation

Make a symbolic link (pointing to FILE1) in FILE2.

The link is relative (if possible), for example

    "/vol/tex/bin/foo" "/vol/local/bin/foo"

results in

    "../../tex/bin/foo" "/vol/local/bin/foo"

Key Bindings

Source Code

;; Defined in /usr/src/emacs/lisp/dired-aux.el.gz
(defun dired-make-relative-symlink (file1 file2 &optional ok-if-already-exists)
  "Make a symbolic link (pointing to FILE1) in FILE2.
The link is relative (if possible), for example

    \"/vol/tex/bin/foo\" \"/vol/local/bin/foo\"

results in

    \"../../tex/bin/foo\" \"/vol/local/bin/foo\""
  (interactive "FRelSymLink: \nFRelSymLink %s: \np")
  (let (name1 name2 len1 len2 (index 0) sub)
    (setq file1 (expand-file-name file1)
          file2 (expand-file-name file2)
          len1 (length file1)
          len2 (length file2))
    ;; Find common initial file name components:
    (let (next)
      (while (and (setq next (string-search "/" file1 index))
                  (< (setq next (1+ next)) (min len1 len2))
                  ;; For the comparison, both substrings must end in
                  ;; `/', so NEXT is *one plus* the result of the
                  ;; string-search.
                  ;; E.g., consider the case of linking "/tmp/a/abc"
                  ;; to "/tmp/abc" erroneously giving "/tmp/a" instead
                  ;; of "/tmp/" as common initial component
                  (string-equal (substring file1 0 next)
                                (substring file2 0 next)))
        (setq index next))
      (setq name2 file2
            sub (substring file1 0 index)
            name1 (substring file1 index)))
    (if (string-equal sub "/")
        ;; No common initial file name found
        (setq name1 file1)
      ;; Else they have a common parent directory
      (let ((tem (substring file2 index))
            (start 0)
            (count 0))
        ;; Count number of slashes we must compensate for ...
        (while (setq start (string-search "/" tem start))
          (setq count (1+ count)
                start (1+ start)))
        ;; ... and prepend a "../" for each slash found:
        (dotimes (_ count)
          (setq name1 (concat "../" name1)))))
    (make-symbolic-link
     (directory-file-name name1)        ; must not link to foo/
                                        ; (trailing slash!)
     name2 ok-if-already-exists)))