How to efficiently include a repository relative path in the mode-line?

Question

Currently in the mode-line the filename %f, is absolute.

I would like to have the path relative to the version-control root, without having to find this every redraw.

How could this be cached, allowing for changes to the buffers filename to be refreshed?

Answer 1

after-set-visited-file-name-hook is a reliable way to detect changes to the filename.

This clears the cached value when a new filename if set.

;; Cache the vc-root relative name of the buffer.
(defvar-local buffer-file-name--vc-root-relative nil)

(defun buffer-file-name-vc-root-relative-fn (filepath)
  ;; Lazy initialize.
  (when (eq buffer-file-name--vc-root-relative nil)
    (let ((base-path
           (let ((vc-backend (ignore-errors (vc-responsible-backend filepath))))
             (when vc-backend
               (vc-call-backend vc-backend 'root filepath)))))
      (setq
       buffer-file-name--vc-root-relative
       (if base-path
           (concat
            "./"
            ;; Account for possibility of filepath containing a '%'.
            (replace-regexp-in-string
             "%" "%%" (file-relative-name filepath base-path)))
         ;; No base-path, set to 't',
         ;; initialized with no base (return nil).
         t))))
  (unless (eq buffer-file-name--vc-root-relative t)
    buffer-file-name--vc-root-relative))

(add-hook 'after-set-visited-file-name-hook
          (lambda () (setq buffer-file-name--vc-root-relative nil)))

Then in the mode-line, this can be used to show the filename.

(or (buffer-file-name-vc-root-relative-fn filepath) "%f")

Answer 2

I've come up with an alternative to this solution which is more efficient.

Instead of showing a longer name in the mode-line, the buffer it's self can be renamed, using the path to the vc-root when available.

This can be done using the following code:

(defun create-file-buffer--with-name-from-root (orig-fn filepath)
  (let ((buf (funcall orig-fn filepath)))
    ;; Error's are very unlikely, this is to ensure even the most remote
    ;; chance of an error doesn't make the file fail to load.
    (condition-case err
      (when buf
        (let ((vc-backend
               (ignore-errors (vc-responsible-backend filepath))))
          (when vc-backend
            (let ((vc-base-path
                   (vc-call-backend vc-backend 'root filepath)))
              (when vc-base-path
                (let* ((name-base
                        (concat
                         "./"
                         (file-relative-name filepath vc-base-path)))
                       (name-unique name-base)
                       (name-id 0))
                  (while (get-buffer name-unique)
                    (setq name-unique
                          (concat name-base (format " <%d>" name-id)))
                    (setq name-id (1+ name-id)))
                  (with-current-buffer buf
                    (rename-buffer name-unique))))))))
      (error (message "Error creating vc-backend root name: %s" err)))
    buf))

(advice-add 'create-file-buffer
            :around #'create-file-buffer--with-name-from-root)