lisp/rfn-eshadow.el

   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, 2008 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 3, 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 \f
  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.
  99 Only used when `file-name-shadow-mode' is active.
 100 If 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.
 109 Only used when `file-name-shadow-mode' is active and Emacs
 110 is not running under a window-system; if Emacs is running under a window
 111 system, `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 (defvar rfn-eshadow-setup-minibuffer-hook nil
 123   "Minibuffer setup functions from other packages.")
 124
 125 (defvar rfn-eshadow-update-overlay-hook nil
 126   "Customer overlay functions from other packages")
 127
 128 \f
 129 ;;; Internal variables
 130
 131 ;; A list of minibuffers to which we've added a post-command-hook.
 132 (defvar rfn-eshadow-frobbed-minibufs nil)
 133
 134 ;; An overlay covering the shadowed part of the filename (local to the
 135 ;; minibuffer).
 136 (defvar rfn-eshadow-overlay)
 137 (make-variable-buffer-local 'rfn-eshadow-overlay)
 138
 139 \f
 140 ;;; Hook functions
 141
 142 ;; This function goes on minibuffer-setup-hook
 143 (defun rfn-eshadow-setup-minibuffer ()
 144   "Set up a minibuffer for `file-name-shadow-mode'.
 145 The prompt and initial input should already have been inserted."
 146   (when minibuffer-completing-file-name
 147     (setq rfn-eshadow-overlay
 148           (make-overlay (minibuffer-prompt-end) (minibuffer-prompt-end)))
 149     ;; Give rfn-eshadow-overlay the user's props.
 150     (let ((props
 151            (if window-system
 152                file-name-shadow-properties
 153              file-name-shadow-tty-properties)))
 154       (while props
 155         (overlay-put rfn-eshadow-overlay (pop props) (pop props))))
 156     ;; Turn on overlay evaporation so that we don't have to worry about
 157     ;; odd effects when the overlay sits empty at the beginning of the
 158     ;; minibuffer.
 159     (overlay-put rfn-eshadow-overlay 'evaporate t)
 160     ;; Add our post-command hook, and make sure can remove it later.
 161     (add-to-list 'rfn-eshadow-frobbed-minibufs (current-buffer))
 162     (add-hook 'post-command-hook #'rfn-eshadow-update-overlay nil t)
 163     ;; Run custom hook
 164     (run-hooks 'rfn-eshadow-setup-minibuffer-hook)))
 165
 166 (defsubst rfn-eshadow-sifn-equal (goal pos)
 167   (equal goal (condition-case nil
 168                   (substitute-in-file-name
 169                    (buffer-substring-no-properties pos (point-max)))
 170                 ;; `substitute-in-file-name' can fail on partial input.
 171                 (error nil))))
 172
 173 ;; post-command-hook to update overlay
 174 (defun rfn-eshadow-update-overlay ()
 175   "Update `rfn-eshadow-overlay' to cover shadowed part of minibuffer input.
 176 This is intended to be used as a minibuffer `post-command-hook' for
 177 `file-name-shadow-mode'; the minibuffer should have already
 178 been set up by `rfn-eshadow-setup-minibuffer'."
 179   (condition-case nil
 180       (let ((goal (substitute-in-file-name (minibuffer-contents)))
 181             (mid (overlay-end rfn-eshadow-overlay))
 182             (start (minibuffer-prompt-end))
 183             (end (point-max)))
 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 Shadow mode.
 212 When active, any part of a filename being read in the minibuffer
 213 that would be ignored (because the result is passed through
 214 `substitute-in-file-name') is given the properties in
 215 `file-name-shadow-properties', which can be used to make
 216 that portion dim, invisible, or otherwise less visually noticeable.
 217
 218 With prefix argument ARG, turn on if positive, otherwise off.
 219 Returns non-nil if the new state is enabled."
 220   :global t
 221   :init-value t
 222   :group 'minibuffer
 223   :version "22.1"
 224   (if file-name-shadow-mode
 225       ;; Enable the mode
 226       (add-hook 'minibuffer-setup-hook 'rfn-eshadow-setup-minibuffer)
 227     ;; Disable the mode
 228     (remove-hook 'minibuffer-setup-hook 'rfn-eshadow-setup-minibuffer)
 229     ;; Remove our entry from any post-command-hook variable's it's still in
 230     (dolist (minibuf rfn-eshadow-frobbed-minibufs)
 231       (with-current-buffer minibuf
 232         (remove-hook 'post-command-hook #'rfn-eshadow-update-overlay t)))
 233     (setq rfn-eshadow-frobbed-minibufs nil)))
 234
 235
 236 (provide 'rfn-eshadow)
 237
 238 ;; arch-tag: dcf70a52-0115-4ec2-b1e3-4f8d3541a888
 239 ;;; rfn-eshadow.el ends here