2016-10-15 - Insert Relative Path

insert-relative-path.el

(require 'f)

(defconst fn/relative-same-node "."  
    "Represents the same node on a path.")

(defconst fn/relative-parent-node ".."  
    "Represents the parent node on a path.")

(defun fn/relative-parent-node-thunk (&rest args)
    "Always returns `fn/relative-parent-node'."
    fn/relative-parent-node)

(defun fn/relative-path (source-path target-path)
    "An attempt to compute the relative path from SOURCE-PATH to TARGET-PATH."
    (letrec ((recurser
              (lambda (upward-nodes downward-nodes parent-node)
                      (cond          
                          ((null (car upward-nodes))
                           (string-join
                            (append (list fn/relative-same-node)
                                    downward-nodes)
                            (f-path-separator)))
                          ((null (car downward-nodes))
                           (string-join
                            (append (mapcar #'fn/relative-parent-node-thunk upward-nodes)
                                    (list parent-node))
                            (f-path-separator)))
                          ((string-equal (car upward-nodes)
                                         (car downward-nodes))
                            (funcall recurser
                                     (cdr upward-nodes)
                                     (cdr downward-nodes)
                                     (car upward-nodes)))
                          (t
                           (lexical-let* ((up-nodes (or (mapcar #'fn/relative-parent-node-thunk (cdr upward-nodes))
                                                        (list fn/relative-same-node)))
                                          (down-nodes downward-nodes))
                                         (string-join
                                          (append up-nodes down-nodes)
                                          (f-path-separator))))))))
            (funcall recurser (f-split source-path) (f-split target-path) fn/relative-same-node)))

(defun fn/insert-relative-file-path (arg)
    "Insert the relative file path of a source file to a target file.
    If prefix ARG is present, select the source file."
    (interactive "P")
    (let* ((source-path
            (cond
                (arg
                 (car (find-file-read-args "Find source file: " t)))
                ((buffer-file-name)
                 (buffer-file-name))
                (t (error "Source file does not have a file name."))))      
            (target-path (car (find-file-read-args "Find target file: " t))))
          (insert (fn/relative-path source-path target-path))))