config

Personal configuration.
git clone git://code.dwrz.net/config
Log | Files | Refs

vertico-directory.el (4972B)

      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.8
      9 ;; Package-Requires: ((emacs "27.1") (compat "29.1.4.4") (vertico "1.8"))
     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 ;; Emacs 28: Do not show Vertico commands in M-X
    120 (dolist (sym '(vertico-directory-up vertico-directory-enter
    121                vertico-directory-delete-char vertico-directory-delete-word))
    122   (put sym 'completion-predicate #'vertico--command-p))
    123 
    124 (provide 'vertico-directory)
    125 ;;; vertico-directory.el ends here