Skip to content

Instantly share code, notes, and snippets.

@bowbow99
Created November 4, 2012 14:37
Show Gist options
  • Save bowbow99/4012153 to your computer and use it in GitHub Desktop.
Save bowbow99/4012153 to your computer and use it in GitHub Desktop.
#xyzzy バッファ名を "<GIT: リポジトリ名>/そこ/からの/パス/なまえ.拡張子" みたいに
;;;;; relative pathname as buffer-name etc. in repository
(defvar *repository-type/landmark-alist*
'(("GIT" . ".git")
("HG" . ".hg")))
(defun repository-type (dir-pathname)
(dolist (x *repository-type/landmark-alist* nil)
(when (file-exist-p (merge-pathnames (cdr x) dir-pathname))
(return (car x)))))
(defun find-repository-root/type (dir-pathname)
(labels ((find-root (dir)
(let ((repos-type (repository-type dir))
(parent (merge-pathnames ".." dir)))
(cond (repos-type
(values dir repos-type))
((path-equal parent dir)
nil)
(t
(find-root parent))))))
(find-root dir-pathname)))
(defun relative-pathname-from (pathname base)
(let ((true-path (truename pathname))
(true-base (truename base)))
(when (and (< (length true-base) (length true-path))
(string= true-path true-base
:end1 (length true-base)))
(substring true-path (length true-base)))))
(defun rename-buffer-for-VCed-file ()
(let ((pathname (get-buffer-file-name)))
(multiple-value-bind (root type)
(find-repository-root/type (directory-namestring pathname))
(when type
(rename-buffer (format nil "<~A: ~A>~A"
type
(car (last (split-string root #\/)))
(relative-pathname-from pathname root)))
(set-default-directory root)))))
(add-hook '*find-file-hooks* 'rename-buffer-for-VCed-file)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment