From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED.blaine.gmane.org!not-for-mail From: Tassilo Horn Newsgroups: gmane.emacs.devel Subject: Re: [ELPA] New package proposal: visual-path-abbrev.el Date: Fri, 08 Mar 2019 18:34:11 +0100 Message-ID: <875zstz2wc.fsf@gnu.org> References: <87tvglpmcx.fsf@gnu.org> <83k1hhh5mb.fsf@gnu.org> <874l8k47fi.fsf@gnu.org> <83imx0f0x0.fsf@gnu.org> <87k1hg6jl3.fsf@gnu.org> <83h8ciecub.fsf@gnu.org> <8736o1iqsf.fsf@gnu.org> <87zhq51n1q.fsf@gnu.org> Mime-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Injection-Info: blaine.gmane.org; posting-host="blaine.gmane.org:195.159.176.226"; logging-data="107247"; mail-complaints-to="usenet@blaine.gmane.org" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/27.0.50 (gnu/linux) Cc: emacs-devel@gnu.org To: Stefan Monnier Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Fri Mar 08 18:35:21 2019 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([209.51.188.17]) by blaine.gmane.org with esmtps (TLS1.0:RSA_AES_256_CBC_SHA1:256) (Exim 4.89) (envelope-from ) id 1h2JOw-000Rhn-Pt for ged-emacs-devel@m.gmane.org; Fri, 08 Mar 2019 18:35:19 +0100 Original-Received: from localhost ([127.0.0.1]:47512 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1h2JOv-0007Zn-Qu for ged-emacs-devel@m.gmane.org; Fri, 08 Mar 2019 12:35:17 -0500 Original-Received: from eggs.gnu.org ([209.51.188.92]:40087) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1h2JOF-0007ZS-2g for emacs-devel@gnu.org; Fri, 08 Mar 2019 12:34:36 -0500 Original-Received: from fencepost.gnu.org ([2001:470:142:3::e]:43241) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1h2JOD-0006my-VP; Fri, 08 Mar 2019 12:34:34 -0500 Original-Received: from auth2-smtp.messagingengine.com ([66.111.4.228]:43675) by fencepost.gnu.org with esmtpsa (TLS1.2:DHE_RSA_AES_256_CBC_SHA256:256) (Exim 4.82) (envelope-from ) id 1h2JOD-0008Ae-IV; Fri, 08 Mar 2019 12:34:33 -0500 Original-Received: from compute7.internal (compute7.nyi.internal [10.202.2.47]) by mailauth.nyi.internal (Postfix) with ESMTP id 10B7322109; Fri, 8 Mar 2019 12:34:33 -0500 (EST) Original-Received: from mailfrontend1 ([10.202.2.162]) by compute7.internal (MEProxy); Fri, 08 Mar 2019 12:34:33 -0500 X-ME-Sender: X-ME-Proxy-Cause: gggruggvucftvghtrhhoucdtuddrgedutddrgedtgddutdegucetufdoteggodetrfdotf fvucfrrhhofhhilhgvmecuhfgrshhtofgrihhlpdfqfgfvpdfurfetoffkrfgpnffqhgen uceurghilhhouhhtmecufedttdenucesvcftvggtihhpihgvnhhtshculddquddttddmne cujfgurhephffvufhfffgjkfgfgggtgfesthhqredttderjeenucfhrhhomhepvfgrshhs ihhlohcujfhorhhnuceothhsughhsehgnhhurdhorhhgqeenucffohhmrghinhepghhnuh drohhrghenucfkphepleefrddvfeeirdduvdelrdehvdenucfrrghrrghmpehmrghilhhf rhhomhepthhhohhrnhdomhgvshhmthhprghuthhhphgvrhhsohhnrghlihhthidqkeeije efkeejkeegqdeifeehvdelkedqthhsughhpeepghhnuhdrohhrghesfhgrshhtmhgrihhl rdhfmhenucevlhhushhtvghrufhiiigvpedt X-ME-Proxy: Original-Received: from thinkpad-t440p (p5dec8134.dip0.t-ipconnect.de [93.236.129.52]) by mail.messagingengine.com (Postfix) with ESMTPA id BC10BE471F; Fri, 8 Mar 2019 12:34:16 -0500 (EST) Mail-Followup-To: Stefan Monnier , emacs-devel@gnu.org In-Reply-To: <87zhq51n1q.fsf@gnu.org> (Tassilo Horn's message of "Fri, 08 Mar 2019 15:02:57 +0100") X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.21 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: "Emacs-devel" Xref: news.gmane.org gmane.emacs.devel:233933 Archived-At: Tassilo Horn 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 =20=20=20=20=20 --8<---------------cut here---------------start------------->8--- ;;; visual-filename-abbrev.el --- Visually abbreviate filenames -*- lexica= l-binding: t; -*- ;; Copyright (C) 2019 Free Software Foundation, Inc ;; Author: Tassilo Horn ;; 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 . ;;; 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=E2=80=A6/m=E2=80=A6/D=E2=80=A6/L=E2=80=A6/P=E2=80=A6-F=E2=80=A6/Let= ter-to-John.tex ;; ;; By default, the abbreviate display is disabled when point enters the ove= rlay ;; so that you can edit the file name normally. Also, abbreviated file nam= es ;; are only shown if the abbreviation as actually shorter as the original o= ne ;; (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 "=E2=80=A6" "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 abbr= ev) "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 filena= me abbrev) "Return non-nil if ABBREV's display representation is shorter than FILENA= ME. This takes the font into account." ;; NOTE: The docs say that object in an conditional display spec is alway= s 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 " =3D> %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= =3D%s" ;; End: ;;; visual-filename-abbrev.el ends here --8<---------------cut here---------------end--------------->8---