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