lisp/rfn-eshadow.el

   1 ;;; rfn-eshadow.el --- Highlight `shadowed' part of read-file-name input text
   2 ;;
   3 ;; Copyright (C) 2000-2012 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 \f
  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 \f
 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 \f
 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   (when minibuffer-completing-file-name
 146     (setq rfn-eshadow-overlay
 147           (make-overlay (minibuffer-prompt-end) (minibuffer-prompt-end)))
 148     ;; Give rfn-eshadow-overlay the user's props.
 149     (let ((props
 150            (if window-system
 151                file-name-shadow-properties
 152              file-name-shadow-tty-properties)))
 153       (while props
 154         (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     (overlay-put rfn-eshadow-overlay 'evaporate t)
 159     ;; Add our post-command hook, and make sure can remove it later.
 160     (add-to-list 'rfn-eshadow-frobbed-minibufs (current-buffer))
 161     (add-hook 'post-command-hook #'rfn-eshadow-update-overlay nil t)
 162     ;; Run custom hook
 163     (run-hooks 'rfn-eshadow-setup-minibuffer-hook)))
 164
 165 (defsubst rfn-eshadow-sifn-equal (goal pos)
 166   (equal goal (condition-case nil
 167                   (substitute-in-file-name
 168                    (buffer-substring-no-properties pos (point-max)))
 169                 ;; `substitute-in-file-name' can fail on partial input.
 170                 (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   (condition-case nil
 179       (let ((goal (substitute-in-file-name (minibuffer-contents)))
 180             (mid (overlay-end rfn-eshadow-overlay))
 181             (start (minibuffer-prompt-end))
 182             (end (point-max))
 183             (non-essential t))
 184         (unless
 185             ;; Catch the common case where the shadow does not need to move.
 186             (and mid
 187                  (or (eq mid end)
 188                      (not (rfn-eshadow-sifn-equal goal (1+ mid))))
 189                  (or (eq mid start)
 190                      (rfn-eshadow-sifn-equal goal mid)))
 191           ;; Binary search for the greatest position still equivalent to
 192           ;; the whole.
 193           (while (or (< (1+ start) end)
 194                      (if (and (< (1+ end) (point-max))
 195                               (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                          (setq start (1+ end) end (point-max))))
 200             (setq mid (/ (+ start end) 2))
 201             (if (rfn-eshadow-sifn-equal goal mid)
 202                 (setq start mid)
 203               (setq end mid)))
 204           (move-overlay rfn-eshadow-overlay (minibuffer-prompt-end) start))
 205         ;; Run custom hook
 206         (run-hooks 'rfn-eshadow-update-overlay-hook))
 207     ;; `substitute-in-file-name' can fail on partial input.
 208     (error nil)))
 209 \f
 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   (if file-name-shadow-mode
 232       ;; Enable the mode
 233       (add-hook 'minibuffer-setup-hook 'rfn-eshadow-setup-minibuffer)
 234     ;; Disable the mode
 235     (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     (dolist (minibuf rfn-eshadow-frobbed-minibufs)
 238       (with-current-buffer minibuf
 239         (remove-hook 'post-command-hook #'rfn-eshadow-update-overlay t)))
 240     (setq rfn-eshadow-frobbed-minibufs nil)))
 241
 242
 243 (provide 'rfn-eshadow)
 244
 245 ;;; rfn-eshadow.el ends here