From: Tassilo Horn <tsdh@gnu.org>
To: Eli Zaretskii <eliz@gnu.org>
Cc: emacs-devel@gnu.org
Subject: Re: [ELPA] New package proposal: visual-path-abbrev.el
Date: Sun, 03 Mar 2019 10:46:09 +0100 [thread overview]
Message-ID: <874l8k47fi.fsf@gnu.org> (raw)
In-Reply-To: <83k1hhh5mb.fsf@gnu.org> (Eli Zaretskii's message of "Sat, 02 Mar 2019 13:34:36 +0200")
Eli Zaretskii <eliz@gnu.org> writes:
> Your code seems to update the overlays in a function called from
> post-command-hook, but post-command-hook runs before redisplay updates
> the window due to last command. So you are using stale window-start
> and window-end values, and if the last command scrolls some file names
> into the view, those file names might not have overlays on them.
>
> I think the preferred method is to use jit-lock-register to register
> your function; see e.g. glasses.el for how this can be done.
Ok, here's a new version using that approach and basically it works.
However, there's a problem with the conditional 'display spec which
should in theory un-abbreviate the file name as soon as point enter's
the overlay's region. Oftentimes that doesn't happen until I explicitly
force a redisplay with C-l or M-x.
Is there a good way to cope with that?
Tassilo
--8<---------------cut here---------------start------------->8---
;;; visual-file-name-abbrev.el --- Visually abbreviate file names -*- 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 names 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 file name normally. Also, abbreviated file names
;; are only shown if the abbreviation as actually shorter as the original one
;; (which depends on what you add as replacement).
;;
;; There's stuff to customize, just check `M-x customize-group RET
;; visual-file-name-abbrev RET'.
;;; Code:
(require 'subr-x)
(require 'seq)
(defgroup visual-file-name-abbrev nil
"Visually abbreviate the directory part of paths.")
(defcustom visual-file-name-abbrev-regex
(concat "\\(?:file://\\)?/?"
"\\(?:[[:alnum:]@_.-]+/\\)+[[:alnum:]@_.-]*\\.\\w+")
"Regexp matching paths.")
(defcustom visual-file-name-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-file-name-abbrev-regex' will be replaced by
`visual-file-name-abbrev-abbrev'.")
(defcustom visual-file-name-abbrev-abbrev "…"
"String to be displayed instead of the match group 1 of
`visual-file-name-abbrev-regex'.")
(defun visual-file-name-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-file-name-abbrev-replace-regex
visual-file-name-abbrev-abbrev dir nil nil 1))
file)))
(defsubst visual-file-name-abbrev--get-overlay (pos)
(car (seq-filter
(lambda (o) (overlay-get o 'visual-file-name-abbrev))
(overlays-at pos))))
(defun visual-file-name-abbrev--not-on-overlay-p (_buffer pos path abbrev)
(when-let ((ol (visual-file-name-abbrev--get-overlay pos)))
(or (< (point) (overlay-start ol))
(> (point) (overlay-end ol)))))
(defun visual-file-name-abbrev--abbrev-shorter-p (_buffer _pos path abbrev)
(< (string-width abbrev)
(string-width path)))
(defvar visual-file-name-abbrev-display-predicates
(list #'visual-file-name-abbrev--not-on-overlay-p
#'visual-file-name-abbrev--abbrev-shorter-p))
(defun visual-file-name-abbrev--display-p (buffer pos path abbrev)
(seq-every-p (lambda (pred)
(funcall pred buffer pos path abbrev))
visual-file-name-abbrev-display-predicates))
(defun visual-file-name-abbrev--delete-overlays (beg end)
(dolist (ol (overlays-in beg end))
(when (overlay-get ol 'visual-file-name-abbrev)
(delete-overlay ol))))
(defun visual-file-name-abbrev--place-overlays (start end)
(goto-char start)
(while (re-search-forward visual-file-name-abbrev-regex end t)
(let* ((m-beg (match-beginning 0))
(m-end (match-end 0))
(path (match-string 0))
(abbrev (visual-file-name-abbrev--get-abbrev path))
(ol (or (when-let ((o (visual-file-name-abbrev--get-overlay m-beg)))
(move-overlay o m-beg m-end)
o)
(make-overlay m-beg m-end nil t))))
(overlay-put ol 'visual-file-name-abbrev t)
(overlay-put ol 'evaporate t)
(overlay-put ol 'help-echo path)
(overlay-put
ol 'display `(when (visual-file-name-abbrev--display-p
object buffer-position ,path ,abbrev)
. ,abbrev)))))
(defun visual-file-name-abbrev--jit-lock (beg end &optional _old-len)
"Function registered for jit-lock."
(let ((beg-line (save-excursion (goto-char beg) (line-beginning-position)))
(end-line (save-excursion (goto-char end) (line-end-position))))
(visual-file-name-abbrev--place-overlays beg-line end-line)))
(define-minor-mode visual-file-name-abbrev-mode
"Visually abbreviate file paths."
nil " VFNAbbr" nil
(if visual-file-name-abbrev-mode
(progn
(jit-lock-register #'visual-file-name-abbrev--jit-lock)
(visual-file-name-abbrev--jit-lock (window-start)
(window-end)))
(jit-lock-unregister #'visual-file-name-abbrev--jit-lock)
(visual-file-name-abbrev--delete-overlays 1 (1+ (buffer-size)))))
--8<---------------cut here---------------end--------------->8---
next prev parent reply other threads:[~2019-03-03 9:46 UTC|newest]
Thread overview: 23+ messages / expand[flat|nested] mbox.gz Atom feed top
2019-03-02 11:05 [ELPA] New package proposal: visual-path-abbrev.el Tassilo Horn
2019-03-02 11:34 ` Eli Zaretskii
2019-03-02 14:59 ` Tassilo Horn
2019-03-03 9:46 ` Tassilo Horn [this message]
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
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=874l8k47fi.fsf@gnu.org \
--to=tsdh@gnu.org \
--cc=eliz@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 public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).