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: Tue, 05 Mar 2019 11:01:04 +0100 Message-ID: <8736o1iqsf.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> 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="217409"; 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: Eli Zaretskii Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Tue Mar 05 11:09:24 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 1h170l-000uRz-Df for ged-emacs-devel@m.gmane.org; Tue, 05 Mar 2019 11:09:23 +0100 Original-Received: from localhost ([127.0.0.1]:40570 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1h170k-0007mD-Cx for ged-emacs-devel@m.gmane.org; Tue, 05 Mar 2019 05:09:22 -0500 Original-Received: from eggs.gnu.org ([209.51.188.92]:49576) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1h170W-0007j6-NC for emacs-devel@gnu.org; Tue, 05 Mar 2019 05:09:15 -0500 Original-Received: from fencepost.gnu.org ([2001:470:142:3::e]:46954) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1h16sm-0003pJ-Ii for emacs-devel@gnu.org; Tue, 05 Mar 2019 05:01:09 -0500 Original-Received: from auth2-smtp.messagingengine.com ([66.111.4.228]:50277) by fencepost.gnu.org with esmtpsa (TLS1.2:DHE_RSA_AES_256_CBC_SHA256:256) (Exim 4.82) (envelope-from ) id 1h16sm-0001oN-Eo; Tue, 05 Mar 2019 05:01:08 -0500 Original-Received: from compute7.internal (compute7.nyi.internal [10.202.2.47]) by mailauth.nyi.internal (Postfix) with ESMTP id 226062222E; Tue, 5 Mar 2019 05:01:08 -0500 (EST) Original-Received: from mailfrontend2 ([10.202.2.163]) by compute7.internal (MEProxy); Tue, 05 Mar 2019 05:01:08 -0500 X-ME-Sender: X-ME-Proxy-Cause: gggruggvucftvghtrhhoucdtuddrgedutddrfeefgdduudcutefuodetggdotefrodftvf curfhrohhfihhlvgemucfhrghsthforghilhdpqfgfvfdpuffrtefokffrpgfnqfghnecu uegrihhlohhuthemuceftddtnecusecvtfgvtghiphhivghnthhsucdlqddutddtmdenuc fjughrpefhvffufhffjgfkfgggtgfgsehtqhertddtreejnecuhfhrohhmpefvrghsshhi lhhoucfjohhrnhcuoehtshguhhesghhnuhdrohhrgheqnecuffhomhgrihhnpehgnhhurd horhhgnecukfhppedufeegrdduudelrddvgedrudelheenucfrrghrrghmpehmrghilhhf rhhomhepthhhohhrnhdomhgvshhmthhprghuthhhphgvrhhsohhnrghlihhthidqkeeije efkeejkeegqdeifeehvdelkedqthhsughhpeepghhnuhdrohhrghesfhgrshhtmhgrihhl rdhfmhenucevlhhushhtvghrufhiiigvpedt X-ME-Proxy: Original-Received: from jiffyarch (j289989.servers.jiffybox.net [134.119.24.195]) by mail.messagingengine.com (Postfix) with ESMTPA id 41AE210331; Tue, 5 Mar 2019 05:01:06 -0500 (EST) In-Reply-To: <83h8ciecub.fsf@gnu.org> (Eli Zaretskii's message of "Mon, 04 Mar 2019 20:03:40 +0200") 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:233844 Archived-At: Eli Zaretskii writes: > For your feature to work reliably, you need one or more overlays > examined even if the user just moves point, something that triggers a > heavily optimized version of redisplay (because moving point is a very > frequent operation). You need to disable some of these optimizations. > > One way of disabling those optimizations is to make some immaterial > change in one or more overlays, because overlay changes cause a more > thorough redisplay of the buffer. You can, for example, change some > overlay property that will have no effect on display. > > Another possibility is to have a buffer-local variable that you add to > the list of variables which trigger thorough redisplay of its buffer, > see the end of frame.el for how this is done. Then whenever you want > redisplay to re-evaluate one or more of your overlays, you change the > value of that variable. > > Both of those techniques will need to use post-command-hook, I think. > > Caveat: I didn't try any of my suggestions, so I cannot be sure they > will work, although they should, of course. (I did add the above > caveats to the ELisp manual, so they are now documented.) I'm now using option 1 and set the visual-file-name-abbrev overlay property which I'm using to know which overlays are mine to (random) instead of just t on the current and the last file name point was one in a post-command-hook function. That seems to do the trick although it's a bit sluggish when, e.g., pressing and holding C-n in a *grep* buffer in column 1 (which is probably the worst case). I haven't yet debugged what's the slow part but I guess it is the new predicate `visual-file-name-abbrev--abbrev-visually-shorter-p' which ensures that the abbreviation is only displayed if it is visually shorter than the normal file name, i.e., it takes into account the current font and the replacement ellipsis. The standard one =E2=80=A6 is twice as wide as a "normal" character on a non-terminal frame. Other than that, do you think it's ok to add this package to ELPA? If so, is the (C) FSF and "This file is part of GNU Emacs" correct for an ELPA(-only) package? Tassilo --8<---------------cut here---------------start------------->8--- ;;; visual-file-name-abbrev.el --- Visually abbreviate file names -*- lexi= cal-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-file-name-abbrev RET'. ;;; Code: (require 'subr-x) (require 'seq) (defgroup visual-file-name-abbrev nil "Visually abbreviate the directory part of file names." :group 'tools) (defcustom visual-file-name-abbrev-regex (concat "\\(?:file://\\)?/?" "\\(?:[[:alnum:]@_.-]+/\\)+[[:alnum:]@_.-]*\\.\\w+") "Regexp matching file names." :group 'visual-file-name-abbrev :type 'regexp) (defcustom visual-file-name-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-file-name-abbrev-regex' will be replaced by `visual-file-name-abbrev-ellipsis'." :group 'visual-file-name-abbrev :type 'regexp) (defcustom visual-file-name-abbrev-ellipsis "=E2=80=A6" "String displayed instead of group 1 of `visual-file-name-abbrev-regex'." :group 'visual-file-name-abbrev :type 'string) (defun visual-file-name-abbrev--get-abbrev (file-name) (let ((file (file-name-nondirectory file-name)) (dir (file-name-directory file-name))) (concat (file-name-as-directory (replace-regexp-in-string visual-file-name-abbrev-replace-regex visual-file-name-abbrev-ellipsis dir nil nil 1)) file))) (defvar visual-file-name-abbrev--last-overlay nil) (make-variable-buffer-local 'visual-file-name-abbrev--last-overlay) (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--post-command () "Modifies the last and possibly current overlay to trigger their redispla= y." (when visual-file-name-abbrev--last-overlay (overlay-put visual-file-name-abbrev--last-overlay 'visual-file-name-ab= brev (random)) (setq visual-file-name-abbrev--last-overlay nil)) (when-let ((ol (visual-file-name-abbrev--get-overlay (point)))) (overlay-put ol 'visual-file-name-abbrev (random)) (setq visual-file-name-abbrev--last-overlay ol))) (defun visual-file-name-abbrev--not-on-overlay-p (_buffer pos file-name abb= rev) "Return non-nil if point is not inside the overlay at POS." (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 file-name ab= brev) "Return non-nil if ABBREV is shorter than FILE-NAME. Shorter means less characters here." (< (string-width abbrev) (string-width file-name))) (defsubst visual-file-name-abbrev--get-visual-width (str font) (with-current-buffer (get-buffer-create " *VFNAbbr work*") (setq buffer-undo-list t) (erase-buffer) (insert str) (seq-reduce (lambda (acc g) (+ acc (aref g 4))) (font-get-glyphs font (point-min) (point-max)) 0))) (defun visual-file-name-abbrev--abbrev-visually-shorter-p (_buffer pos file= -name abbrev) "Return non-nil if ABBREV's display representation is shorter than FILE-N= AME. This takes the font into account." (let ((font (font-at pos))) (< (visual-file-name-abbrev--get-visual-width abbrev font) (visual-file-name-abbrev--get-visual-width file-name font)))) (defcustom visual-file-name-abbrev-display-predicates (list #'visual-file-name-abbrev--not-on-overlay-p #'visual-file-name-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-file-name-abbrev--not-on-overlay-p' ensures that an abbreviation is not shown when `point' in inside the overlays region. - `visual-file-name-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. - `visual-file-name-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." :group 'visual-file-name-abbrev :type '(repeat function)) (defun visual-file-name-abbrev--display-p (buffer pos file-name abbrev) (seq-every-p (lambda (pred) (funcall pred buffer pos file-name 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)) (file-name (match-string 0)) (abbrev (visual-file-name-abbrev--get-abbrev file-name)) (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 file-name) (overlay-put ol 'display `(when (visual-file-name-abbrev--display-p object buffer-position ,file-name ,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))) ;;###autoload (define-minor-mode visual-file-name-abbrev-mode "Visually abbreviate the directory part of file names." nil " VFNAbbr" nil (if visual-file-name-abbrev-mode (progn (jit-lock-register #'visual-file-name-abbrev--jit-lock) (add-hook 'post-command-hook #'visual-file-name-abbrev--post-command nil t) (visual-file-name-abbrev--jit-lock (window-start) (window-end))) (jit-lock-unregister #'visual-file-name-abbrev--jit-lock) (remove-hook 'post-command-hook #'visual-file-name-abbrev--post-command= t) (visual-file-name-abbrev--delete-overlays 1 (1+ (buffer-size))))) (provide 'visual-file-name-abbrev) ;;; visual-file-name-abbrev.el ends here --8<---------------cut here---------------end--------------->8---