#xyzzy バッファ名を "<GIT: リポジトリ名>/そこ/からの/パス/なまえ.拡張子" みたいに

gistfile1.lisp

;;;;; 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)