From: Tassilo Horn <tsdh@gnu.org>
To: emacs-devel@gnu.org
Subject: [ELPA] New package proposal: visual-path-abbrev.el
Date: Sat, 02 Mar 2019 12:05:50 +0100 [thread overview]
Message-ID: <87tvglpmcx.fsf@gnu.org> (raw)
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---
next reply other threads:[~2019-03-02 11:05 UTC|newest]
Thread overview: 23+ messages / expand[flat|nested] mbox.gz Atom feed top
2019-03-02 11:05 Tassilo Horn [this message]
2019-03-02 11:34 ` [ELPA] New package proposal: visual-path-abbrev.el Eli Zaretskii
2019-03-02 14:59 ` Tassilo Horn
2019-03-03 9:46 ` Tassilo Horn
2019-03-03 13:48 ` Stefan Monnier
2019-03-03 15:11 ` Eli Zaretskii
2019-03-03 15:52 ` Tassilo Horn
2019-03-03 17:18 ` Eli Zaretskii
2019-03-03 17:55 ` Tassilo Horn
2019-03-04 18:03 ` Eli Zaretskii
2019-03-05 10:01 ` Tassilo Horn
2019-03-05 16:21 ` Eli Zaretskii
2019-03-05 18:32 ` Tassilo Horn
2019-03-08 5:49 ` Stefan Monnier
2019-03-08 14:02 ` Tassilo Horn
2019-03-08 17:34 ` Tassilo Horn
2019-03-08 19:01 ` Stefan Monnier
2019-03-08 22:18 ` Stefan Monnier
2019-03-09 6:52 ` Tassilo Horn
2019-03-08 18:52 ` Stefan Monnier
2019-03-02 21:25 ` Leo Liu
2019-03-03 9:25 ` Tassilo Horn
2019-03-04 0:23 ` Leo Liu
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87tvglpmcx.fsf@gnu.org \
--to=tsdh@gnu.org \
--cc=emacs-devel@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.