From: Tassilo Horn <tsdh@gnu.org>
To: Stefan Monnier <monnier@iro.umontreal.ca>
Cc: emacs-devel@gnu.org
Subject: Re: [ELPA] New package proposal: visual-path-abbrev.el
Date: Fri, 08 Mar 2019 18:34:11 +0100 [thread overview]
Message-ID: <875zstz2wc.fsf@gnu.org> (raw)
In-Reply-To: <87zhq51n1q.fsf@gnu.org> (Tassilo Horn's message of "Fri, 08 Mar 2019 15:02:57 +0100")
Tassilo Horn <tsdh@gnu.org> writes:
Hi Stefan,
>> Another option might be to use cursor-sensor-mode to open/close those
>> abbreviations.
>
> Hm, that also sounds good. Is cursor-sensor-functions only a text
> property or can I also add that to my overlay?
Works also with overlays. Perfect!
> I guess I could change my code so that only those file names get an
> overlay where all predicates are satisfied (abbrev shorter or visually
> shorter than file name), and handle the uncollapsing using
> cursor-sensor-mode. Then I would't need a conditional display spec at
> all.
>
> How'd I do the uncollapsing in my cursor-sensor-function? Delete the
> overlay on 'entered and add it again on 'left?
What I do now is swapping the 'display property value to a custom
property on 'entered and moving it back on 'left.
That's really much, much better than before, so thanks a lot for the
pointer to `cursor-sensor-mode'!
Ok, now after the hymn of praise, here's the caveat which I couldn't
solve so far: When point leaves one of my overlays and immediately
appears in another one, the `cursor-sensor-functions' are NOT CALLED.
Of course, I expected to get a one call with 'left followed by a call
with 'entered.
Can we consider that a bug in cursor-sensor or is that the expected
behavior? And more importantly, can I influence it so that it works for
my use-case?
An easy recipe for reproduction is to run M-x rgrep, then activate my
mode in the *grep* buffer, and then move up and down using C-p / C-n.
Tassilo
--8<---------------cut here---------------start------------->8---
;;; visual-filename-abbrev.el --- Visually abbreviate filenames -*- lexical-binding: t; -*-
;; Copyright (C) 2019 Free Software Foundation, Inc
;; Author: Tassilo Horn <tsdh@gnu.org>
;; Keywords: tools
;; 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 file name 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-filename-abbrev RET'.
;;; Code:
(require 'subr-x)
(require 'seq)
(defgroup visual-filename-abbrev nil
"Visually abbreviate the directory part of file names."
:group 'tools)
(defcustom visual-filename-abbrev-regex
(concat "\\(?:file://\\)?/?"
"\\(?:[[:alnum:]@_.-]+/\\)+[[:alnum:]@_.-]*\\.\\w+")
"Regexp matching file names."
:group 'visual-filename-abbrev
:type 'regexp)
(defcustom visual-filename-abbrev-replace-regex
"[.@]?[[:alnum:]]\\([[:alnum:]]\\{2,\\}\\)[-_/.@]"
"Regexp which will be visually replaced in file names.
All matches of this regexp's group number 1 in the file names
matching `visual-filename-abbrev-regex' will be replaced by
`visual-filename-abbrev-ellipsis'."
:group 'visual-filename-abbrev
:type 'regexp)
(defcustom visual-filename-abbrev-ellipsis "…"
"String displayed instead of group 1 of `visual-filename-abbrev-regex'."
:group 'visual-filename-abbrev
:type 'string)
(defcustom visual-filename-abbrev-unabbreviate-under-point t
"If non-nil, filenames under point are displayed unabbreviated."
:group 'visual-filename-abbrev
:type 'boolean)
(defun visual-filename-abbrev--get-abbrev (filename)
(let ((file (file-name-nondirectory filename))
(dir (file-name-directory filename)))
(concat
(file-name-as-directory
(replace-regexp-in-string
visual-filename-abbrev-replace-regex
visual-filename-abbrev-ellipsis dir nil nil 1))
file)))
(defsubst visual-filename-abbrev--get-overlay (pos)
(car (seq-filter
(lambda (o) (overlay-get o 'visual-filename-abbrev))
(overlays-at pos))))
(defun visual-filename-abbrev--abbrev-shorter-p (_buffer _pos filename abbrev)
"Return non-nil if ABBREV is shorter than FILENAME.
Shorter means less characters here."
(< (string-width abbrev)
(string-width filename)))
(defsubst visual-filename-abbrev--get-visual-width (str font)
(seq-reduce (lambda (acc g) (+ acc (aref g 4)))
(font-get-glyphs font 0 (length str) str)
0))
(defun visual-filename-abbrev--abbrev-visually-shorter-p (buffer pos filename abbrev)
"Return non-nil if ABBREV's display representation is shorter than FILENAME.
This takes the font into account."
;; NOTE: The docs say that object in an conditional display spec is always a
;; buffer, but actually it sometimes is a window. See bug#34771.
(let ((font (font-at pos (if (windowp buffer)
buffer
(get-buffer-window buffer)))))
(< (visual-filename-abbrev--get-visual-width abbrev font)
(visual-filename-abbrev--get-visual-width filename font))))
(defcustom visual-filename-abbrev-predicates
(list #'visual-filename-abbrev--abbrev-visually-shorter-p)
"A list of predicates inhibiting abbreviation of a file name.
A file name is only abbreviate if all predicates in this list
return true.
Each predicate is called with the following four arguments:
- BUFFER: The buffer holding the abbreviation overlay.
- POS: The position in BUFFER of the overlay.
- FILE: The file name to be abbreviated.
- ABBREV: The abbreviated version of the file name.
These predicates are available:
- `visual-filename-abbrev--abbrev-shorter-p' ensures that an
abbreviation is only shown if it is shorter (in the number of
characters) than the original file name. This is fast but
doesn't work too good if `visual-filename-abbrev-ellipsis' is
displayed wider than what's abbreviater (which depends on the
font).
- `visual-filename-abbrev--abbrev-visually-shorter-p' ensures
that an abbreviation is only shown if it is visually shorter
than the original file name, i.e., it takes the current font
and, e.g., double-width unicode characters into account.
This predicate is a bit more expensive to compute."
:group 'visual-filename-abbrev
:type '(repeat function))
(defun visual-filename-abbrev--abbreviate-p (buffer pos filename abbrev)
(seq-every-p (lambda (pred)
(funcall pred buffer pos filename abbrev))
visual-filename-abbrev-predicates))
(defun visual-filename-abbrev--delete-overlays (beg end)
(dolist (ol (overlays-in beg end))
(when (overlay-get ol 'visual-filename-abbrev)
(delete-overlay ol))))
(defun visual-filename-abbrev--cursor-sensor (window old-pos dir)
(message "cs: %S %S %S" window old-pos dir)
(when-let ((ol (visual-filename-abbrev--get-overlay
(if (eq dir 'entered)
(point)
;; 1- because if we leave the overlay to the right,
;; old-pos is one more that the overlay's end.
(if (> point old-pos)
(1- old-pos)
(1+ old-pos))))))
(message " => %S" ol)
(if (eq dir 'entered)
(when-let ((d (overlay-get ol 'display)))
(overlay-put ol 'visual-filename-abbrev--display-backup d)
(overlay-put ol 'display nil))
(when-let ((d (overlay-get ol 'visual-filename-abbrev--display-backup)))
(overlay-put ol 'display d)
(overlay-put ol 'visual-filename-abbrev--display-backup nil)))))
(defun visual-filename-abbrev--place-overlays (start end)
(goto-char start)
(while (re-search-forward visual-filename-abbrev-regex end t)
(let* ((m-beg (match-beginning 0))
(m-end (match-end 0))
(filename (match-string 0))
(abbrev (visual-filename-abbrev--get-abbrev filename)))
(when (visual-filename-abbrev--abbreviate-p
(current-buffer) (point) filename abbrev)
(let ((ol (or (when-let ((o (visual-filename-abbrev--get-overlay m-beg)))
(move-overlay o m-beg m-end)
o)
(make-overlay m-beg m-end nil t))))
(when visual-filename-abbrev-unabbreviate-under-point
(overlay-put ol 'cursor-sensor-functions
(list #'visual-filename-abbrev--cursor-sensor)))
(overlay-put ol 'visual-filename-abbrev t)
(overlay-put ol 'evaporate t)
(overlay-put ol 'help-echo filename)
(overlay-put ol 'display abbrev))))))
(defun visual-filename-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-filename-abbrev--place-overlays beg-line end-line)))
(defvar visual-filename-abbrev--csm-before-activation nil)
(make-variable-buffer-local 'visual-filename-abbrev--csm-before-activation)
;;###autoload
(define-minor-mode visual-filename-abbrev-mode
"Visually abbreviate the directory part of file names."
nil " VFAbbr" nil
(if visual-filename-abbrev-mode
(progn
(jit-lock-register #'visual-filename-abbrev--jit-lock)
(require 'cursor-sensor)
;; Remember if c-s-m has been enabled before we enable it.
(setq visual-filename-abbrev--csm-before-activation cursor-sensor-mode)
(cursor-sensor-mode)
(visual-filename-abbrev--jit-lock (window-start)
(window-end)))
(jit-lock-unregister #'visual-filename-abbrev--jit-lock)
;; Deactivate it only if it has been disabled before we started it.
(when visual-filename-abbrev--csm-before-activation
(cursor-sensor-mode -1))
(visual-filename-abbrev--delete-overlays 1 (1+ (buffer-size)))))
(provide 'visual-filename-abbrev)
;; Local Variables:
;; bug-reference-url-format: "https://debbugs.gnu.org/cgi/bugreport.cgi?bug=%s"
;; End:
;;; visual-filename-abbrev.el ends here
--8<---------------cut here---------------end--------------->8---
next prev parent reply other threads:[~2019-03-08 17:34 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
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 [this message]
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=875zstz2wc.fsf@gnu.org \
--to=tsdh@gnu.org \
--cc=emacs-devel@gnu.org \
--cc=monnier@iro.umontreal.ca \
/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.