1;;; rfn-eshadow.el --- Highlight `shadowed' part of read-file-name input text 2;; 3;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 4;; 2005, 2006, 2007 Free Software Foundation, Inc. 5;; 6;; Author: Miles Bader <miles@gnu.org> 7;; Keywords: convenience minibuffer 8 9;; This file is part of GNU Emacs. 10 11;; GNU Emacs is free software; you can redistribute it and/or modify 12;; it under the terms of the GNU General Public License as published by 13;; the Free Software Foundation; either version 2, or (at your option) 14;; any later version. 15 16;; GNU Emacs is distributed in the hope that it will be useful, 17;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19;; GNU General Public License for more details. 20 21;; You should have received a copy of the GNU General Public License 22;; along with GNU Emacs; see the file COPYING. If not, write to the 23;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 24;; Boston, MA 02110-1301, USA. 25 26;;; Commentary: 27;; 28;; Defines the mode `file-name-shadow-mode'. 29;; 30;; The `read-file-name' function passes its result through 31;; `substitute-in-file-name', so any part of the string preceding 32;; multiple slashes (or a drive indicator on MS-DOS/MS-Windows) is 33;; ignored. 34;; 35;; If `file-name-shadow-mode' is active, any part of the 36;; minibuffer text that would be ignored because of this is given the 37;; properties in `file-name-shadow-properties', which may 38;; be used to make the ignored text invisible, dim, etc. 39;; 40 41;;; Code: 42 43 44;;; Customization 45 46(defconst file-name-shadow-properties-custom-type 47 '(list 48 (checklist :inline t 49 (const :tag "Invisible" 50 :doc "Make shadowed part of filename invisible" 51 :format "%t%n%h" 52 :inline t 53 (invisible t intangible t)) 54 (list :inline t 55 :format "%v" 56 :tag "Face" 57 :doc "Display shadowed part of filename using a different face" 58 (const :format "" face) 59 (face :value file-name-shadow)) 60 (list :inline t 61 :format "%t: %v%h" 62 :tag "Brackets" 63 ;; Note the 4 leading spaces in the doc string; 64 ;; this is hack to get around the fact that the 65 ;; newline after the second string widget comes 66 ;; from the string widget, and doesn't indent 67 ;; correctly. We could use a :size attribute to 68 ;; make the second string widget not have a 69 ;; terminating newline, but this makes it impossible 70 ;; to enter trailing whitespace, and it's desirable 71 ;; that it be possible. 72 :doc " Surround shadowed part of filename with brackets" 73 (const :format "" before-string) 74 (string :format "%v" :size 4 :value "{") 75 (const :format "" after-string) 76 ;; see above about why the 2nd string doesn't use :size 77 (string :format " and: %v" :value "} ")) 78 (list :inline t 79 :format "%t: %v%n%h" 80 :tag "String" 81 :doc "Display a string instead of the shadowed part of filename" 82 (const :format "" display) 83 (string :format "%v" :size 15 :value "<...ignored...>")) 84 (const :tag "Avoid" 85 :doc "Try to keep cursor out of shadowed part of filename" 86 :format "%t%n%h" 87 :inline t 88 (field shadow))) 89 (repeat :inline t 90 :tag "Other Properties" 91 (list :inline t 92 :format "%v" 93 (symbol :tag "Property") 94 (sexp :tag "Value"))))) 95 96(defcustom file-name-shadow-properties 97 '(face file-name-shadow field shadow) 98 "Properties given to the `shadowed' part of a filename in the minibuffer. 99Only used when `file-name-shadow-mode' is active. 100If Emacs is not running under a window system, 101`file-name-shadow-tty-properties' is used instead." 102 :type file-name-shadow-properties-custom-type 103 :group 'minibuffer 104 :version "22.1") 105 106(defcustom file-name-shadow-tty-properties 107 '(before-string "{" after-string "} " field shadow) 108 "Properties given to the `shadowed' part of a filename in the minibuffer. 109Only used when `file-name-shadow-mode' is active and Emacs 110is not running under a window-system; if Emacs is running under a window 111system, `file-name-shadow-properties' is used instead." 112 :type file-name-shadow-properties-custom-type 113 :group 'minibuffer 114 :version "22.1") 115 116(defface file-name-shadow 117 '((t :inherit shadow)) 118 "Face used by `file-name-shadow-mode' for the shadow." 119 :group 'minibuffer 120 :version "22.1") 121 122 123;;; Internal variables 124 125;; A list of minibuffers to which we've added a post-command-hook. 126(defvar rfn-eshadow-frobbed-minibufs nil) 127 128;; An overlay covering the shadowed part of the filename (local to the 129;; minibuffer). 130(defvar rfn-eshadow-overlay) 131(make-variable-buffer-local 'rfn-eshadow-overlay) 132 133 134;;; Hook functions 135 136;; This function goes on minibuffer-setup-hook 137(defun rfn-eshadow-setup-minibuffer () 138 "Set up a minibuffer for `file-name-shadow-mode'. 139The prompt and initial input should already have been inserted." 140 (when minibuffer-completing-file-name 141 (setq rfn-eshadow-overlay 142 (make-overlay (minibuffer-prompt-end) (minibuffer-prompt-end))) 143 ;; Give rfn-eshadow-overlay the user's props. 144 (let ((props 145 (if window-system 146 file-name-shadow-properties 147 file-name-shadow-tty-properties))) 148 (while props 149 (overlay-put rfn-eshadow-overlay (pop props) (pop props)))) 150 ;; Turn on overlay evaporation so that we don't have to worry about 151 ;; odd effects when the overlay sits empty at the beginning of the 152 ;; minibuffer. 153 (overlay-put rfn-eshadow-overlay 'evaporate t) 154 ;; Add our post-command hook, and make sure can remove it later. 155 (add-to-list 'rfn-eshadow-frobbed-minibufs (current-buffer)) 156 (add-hook 'post-command-hook #'rfn-eshadow-update-overlay nil t))) 157 158(defsubst rfn-eshadow-sifn-equal (goal pos) 159 (equal goal (condition-case nil 160 (substitute-in-file-name 161 (buffer-substring-no-properties pos (point-max))) 162 ;; `substitute-in-file-name' can fail on partial input. 163 (error nil)))) 164 165;; post-command-hook to update overlay 166(defun rfn-eshadow-update-overlay () 167 "Update `rfn-eshadow-overlay' to cover shadowed part of minibuffer input. 168This is intended to be used as a minibuffer `post-command-hook' for 169`file-name-shadow-mode'; the minibuffer should have already 170been set up by `rfn-eshadow-setup-minibuffer'." 171 (condition-case nil 172 (let ((goal (substitute-in-file-name (minibuffer-contents))) 173 (mid (overlay-end rfn-eshadow-overlay)) 174 (start (minibuffer-prompt-end)) 175 (end (point-max))) 176 (unless 177 ;; Catch the common case where the shadow does not need to move. 178 (and mid 179 (or (eq mid end) 180 (not (rfn-eshadow-sifn-equal goal (1+ mid)))) 181 (or (eq mid start) 182 (rfn-eshadow-sifn-equal goal mid))) 183 ;; Binary search for the greatest position still equivalent to 184 ;; the whole. 185 (while (or (< (1+ start) end) 186 (if (and (< (1+ end) (point-max)) 187 (rfn-eshadow-sifn-equal goal (1+ end))) 188 ;; (SIFN end) != goal, but (SIFN (1+end)) == goal, 189 ;; We've reached a discontinuity: this can happen 190 ;; e.g. if `end' point to "/:...". 191 (setq start (1+ end) end (point-max)))) 192 (setq mid (/ (+ start end) 2)) 193 (if (rfn-eshadow-sifn-equal goal mid) 194 (setq start mid) 195 (setq end mid))) 196 (move-overlay rfn-eshadow-overlay (minibuffer-prompt-end) start))) 197 ;; `substitute-in-file-name' can fail on partial input. 198 (error nil))) 199 200(define-minor-mode file-name-shadow-mode 201 "Toggle File-Name Shadow mode. 202When active, any part of a filename being read in the minibuffer 203that would be ignored (because the result is passed through 204`substitute-in-file-name') is given the properties in 205`file-name-shadow-properties', which can be used to make 206that portion dim, invisible, or otherwise less visually noticeable. 207 208With prefix argument ARG, turn on if positive, otherwise off. 209Returns non-nil if the new state is enabled." 210 :global t 211 :init-value t 212 :group 'minibuffer 213 :version "22.1" 214 (if file-name-shadow-mode 215 ;; Enable the mode 216 (add-hook 'minibuffer-setup-hook 'rfn-eshadow-setup-minibuffer) 217 ;; Disable the mode 218 (remove-hook 'minibuffer-setup-hook 'rfn-eshadow-setup-minibuffer) 219 ;; Remove our entry from any post-command-hook variable's it's still in 220 (dolist (minibuf rfn-eshadow-frobbed-minibufs) 221 (with-current-buffer minibuf 222 (remove-hook 'post-command-hook #'rfn-eshadow-update-overlay t))) 223 (setq rfn-eshadow-frobbed-minibufs nil))) 224 225 226(provide 'rfn-eshadow) 227 228;; arch-tag: dcf70a52-0115-4ec2-b1e3-4f8d3541a888 229;;; rfn-eshadow.el ends here 230