Create a gist now

Instantly share code, notes, and snippets.

What would you like to do?
2016-10-15 - Insert Relative Path
(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))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment