[ELPA] New package proposal: visual-path-abbrev.el

[Tassilo Horn <tsdh@gnu.org>]

Hi all,

I've just written a small minor mode which abbreviates file paths
visually by using overlays.  When point enters such an overlay, the path
is shown normally again.

I wrote it mostly because at work our java code has a very deeply nested
package structure which forced me to make my emacs frame running Magit
(listing all modified files) wider than I like it in normal use.

This package has been written over the last few hours and has no home
yet.  If that sounds good, I'd like to add it to ELPA (and just to
ELPA).

Also, suggestions for the code are welcome.  Especially, there are two
known problems:

- Sometimes when scrolling fast and then stopping, only parts of the
  visible buffer portion got the overlays applied.  You can try
  triggering that problem by enabling the mode in a *grep* buffer and
  then scrolling a long way.
  
- When lines are wrapped around and line-move-visual is t, the mode can
  make the line short enough so that it doesn't wrap anymore.  But
  still next-line moves point to where it would belong if the mode were
  not active, i.e., point jumps to somewhere on the same line.
  
Bye,
Tassilo

--8<---------------cut here---------------start------------->8---
;;; visual-path-abbrev.el --- Visually abbreviate paths  -*- lexical-binding: t; -*-

;; Copyright (C) 2019 Free Software Foundation, Inc

;; Author: Tassilo Horn <tsdh@gnu.org>
;; Keywords: TODO
;; Version: TODO

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:
;;
;; This minor mode abbreviates the directory part of file file paths by using
;; overlays.  For example, a longish path like
;;
;;    /home/myuser/Documents/Letters/Personal-Family/Letter-to-John.tex
;;
;; will be displayed like this:
;;
;;   /h…/m…/D…/L…/P…-F…/Letter-to-John.tex
;;
;; By default, the abbreviate display is disabled when point enters the overlay
;; so that you can edit the path normally.  Also, abbreviated path are only
;; shown if the abbreviation as actually shorter as the original path (which
;; depends on what you add as replacement).
;;
;; There's stuff to customize, just check `M-x customize-group RET
;; visual-path-abbrev RET'.

;;; Code:

(require 'seq)

(defgroup visual-path-abbrev nil
  "Visually abbreviate the directory part of paths.")

(defcustom visual-path-abbrev-regex
  (concat "\\(?:file://\\)?/?"
	  "\\(?:[[:alnum:]@_.-]+/\\)+[[:alnum:]@_.-]*\\.\\w+")
  "Regexp matching paths.")

(defcustom visual-path-abbrev-replace-regex
  "[.@]?[[:alnum:]]\\([[:alnum:]]+\\)[-_/.]"
  "Regexp which will be visually replaced in paths.
All matches of this regexp's group number 1 in the paths matching
`visual-path-abbrev-regex' will be replaced by
`visual-path-abbrev-abbrev'.")

(defcustom visual-path-abbrev-abbrev "…"
  "String to be displayed instead of the match group 1 of
`visual-path-abbrev-regex'.")

(defun visual-path-abbrev--get-abbrev (path)
  (let ((file (file-name-nondirectory path))
	(dir (file-name-directory path)))
    (concat
     (file-name-as-directory
      (replace-regexp-in-string
       visual-path-abbrev-replace-regex
       visual-path-abbrev-abbrev dir nil nil 1))
     file)))

(defun visual-path-abbrev--not-on-overlay-p (_buffer pos path abbrev)
  (when-let ((ol (car (seq-filter
		       (lambda (o) (overlay-get o 'visual-path-abbrev))
		       (overlays-at pos)))))
    (or (< (point) (overlay-start ol))
	(> (point) (overlay-end ol)))))

(defun visual-path-abbrev--abbrev-shorter-p (_buffer _pos path abbrev)
  (< (string-width abbrev)
     (string-width path)))

(defvar visual-path-abbrev-display-predicates
  (list #'visual-path-abbrev--not-on-overlay-p
	#'visual-path-abbrev--abbrev-shorter-p))

(defun visual-path-abbrev--display-p (buffer pos path abbrev)
  (seq-every-p (lambda (pred)
		 (funcall pred buffer pos path abbrev))
	       visual-path-abbrev-display-predicates))

(defun visual-path-abbrev--delete-overlays (beg end)
  (dolist (ol (overlays-in beg end))
    (when (overlay-get ol 'visual-path-abbrev)
      (delete-overlay ol))))

(defun visual-path-abbrev--place-overlays (&rest _ignored)
  (save-excursion
    (let ((ws (window-start))
	  (we (window-end)))
      (visual-path-abbrev--delete-overlays ws we)
      (goto-char ws)
      (while (re-search-forward visual-path-abbrev-regex we t)
	(let* ((beg (match-beginning 0))
	       (end (match-end 0))
	       (path (match-string 0))
	       (ol (make-overlay beg end nil t))
	       (abbrev (visual-path-abbrev--get-abbrev path)))
	  (overlay-put ol 'visual-path-abbrev t)
	  (overlay-put
	   ol 'display `(when (visual-path-abbrev--display-p
			       object buffer-position ,path ,abbrev)
			  . ,abbrev))
	  (overlay-put ol 'help-echo path))))))

(define-minor-mode visual-path-abbrev-mode
  "Visually abbreviate file paths."
  nil " VPAbbr" nil
  (if visual-path-abbrev-mode
      (progn
	(add-hook 'post-command-hook
		  #'visual-path-abbrev--place-overlays
		  t t)
	(visual-path-abbrev--place-overlays))
    (remove-hook 'post-command-hook
		 #'visual-path-abbrev--place-overlays
		 t)
    (visual-path-abbrev--delete-overlays 1 (1+ (buffer-size)))))
--8<---------------cut here---------------end--------------->8---