vertico-directory.el (4702B)
1 ;;; vertico-directory.el --- Ido-like directory navigation for Vertico -*- lexical-binding: t -*- 2 3 ;; Copyright (C) 2021-2024 Free Software Foundation, Inc. 4 5 ;; Author: Daniel Mendler <mail@daniel-mendler.de> 6 ;; Maintainer: Daniel Mendler <mail@daniel-mendler.de> 7 ;; Created: 2021 8 ;; Package-Requires: ((emacs "28.1") (compat "30") (vertico "1.9")) 9 ;; URL: https://github.com/minad/vertico 10 11 ;; This file is part of GNU Emacs. 12 13 ;; This program is free software: you can redistribute it and/or modify 14 ;; it under the terms of the GNU General Public License as published by 15 ;; the Free Software Foundation, either version 3 of the License, or 16 ;; (at your option) any later version. 17 18 ;; This program is distributed in the hope that it will be useful, 19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 21 ;; GNU General Public License for more details. 22 23 ;; You should have received a copy of the GNU General Public License 24 ;; along with this program. If not, see <https://www.gnu.org/licenses/>. 25 26 ;;; Commentary: 27 28 ;; This package is a Vertico extension, which provides Ido-like 29 ;; directory navigation commands. The commands can be bound in the 30 ;; `vertico-map'. Furthermore a cleanup function for shadowed file 31 ;; paths is provided. 32 ;; 33 ;; (keymap-set vertico-map "RET" #'vertico-directory-enter) 34 ;; (keymap-set vertico-map "DEL" #'vertico-directory-delete-char) 35 ;; (keymap-set vertico-map "M-DEL" #'vertico-directory-delete-word) 36 ;; (add-hook 'rfn-eshadow-update-overlay-hook #'vertico-directory-tidy) 37 38 ;;; Code: 39 40 (require 'vertico) 41 (eval-when-compile (require 'subr-x)) 42 43 ;;;###autoload 44 (defun vertico-directory-enter (&optional arg) 45 "Enter directory or exit completion with current candidate. 46 Exit with current input if prefix ARG is given." 47 (interactive "P") 48 (if-let (((not arg)) 49 ((>= vertico--index 0)) 50 ((eq 'file (vertico--metadata-get 'category))) 51 ;; Check vertico--base for stepwise file path completion 52 ((not (equal vertico--base ""))) 53 (cand (vertico--candidate)) 54 ((or (string-suffix-p "/" cand) 55 (and (vertico--remote-p cand) 56 (string-suffix-p ":" cand)))) 57 ;; Handle /./ and /../ manually instead of via `expand-file-name' 58 ;; and `abbreviate-file-name', such that we don't accidentally 59 ;; perform unwanted substitutions in the existing completion. 60 ((progn 61 (setq cand (string-replace "/./" "/" cand)) 62 (unless (string-suffix-p "/../../" cand) 63 (setq cand (replace-regexp-in-string "/[^/|:]+/\\.\\./\\'" "/" cand))) 64 (not (equal (minibuffer-contents-no-properties) cand))))) 65 (progn 66 (delete-minibuffer-contents) 67 (insert cand)) 68 (vertico-exit arg))) 69 70 ;;;###autoload 71 (defun vertico-directory-up (&optional n) 72 "Delete N names before point." 73 (interactive "p") 74 (when (and (> (point) (minibuffer-prompt-end)) 75 (eq 'file (vertico--metadata-get 'category))) 76 (let ((path (buffer-substring-no-properties (minibuffer-prompt-end) (point))) 77 found) 78 (when (string-match-p "\\`~[^/]*/\\'" path) 79 (delete-minibuffer-contents) 80 (insert (expand-file-name path))) 81 (dotimes (_ (or n 1) found) 82 (save-excursion 83 (let ((end (point))) 84 (goto-char (1- end)) 85 (when (search-backward "/" (minibuffer-prompt-end) t) 86 (delete-region (1+ (point)) end) 87 (setq found t)))))))) 88 89 ;;;###autoload 90 (defun vertico-directory-delete-char (&optional n) 91 "Delete N directories or chars before point." 92 (interactive "p") 93 (unless (and (eq (char-before) ?/) (vertico-directory-up n)) 94 (delete-char (- n)))) 95 96 ;;;###autoload 97 (defun vertico-directory-delete-word (&optional n) 98 "Delete N directories or words before point." 99 (interactive "p") 100 (unless (and (eq (char-before) ?/) (vertico-directory-up n)) 101 (let ((pt (point))) 102 (backward-word n) 103 (delete-region pt (point))))) 104 105 ;;;###autoload 106 (defun vertico-directory-tidy () 107 "Tidy shadowed file name, see `rfn-eshadow-overlay'." 108 (when (eq this-command #'self-insert-command) 109 (dolist (ov '(tramp-rfn-eshadow-overlay rfn-eshadow-overlay)) 110 (when (and (boundp ov) 111 (setq ov (symbol-value ov)) 112 (overlay-buffer ov) 113 (= (point) (point-max)) 114 (or (>= (- (point) (overlay-end ov)) 2) 115 (eq ?/ (char-before (- (point) 2))))) 116 (delete-region (overlay-start ov) (overlay-end ov)))))) 117 118 (provide 'vertico-directory) 119 ;;; vertico-directory.el ends here