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