lisp/rfn-eshadow.el

   1 ;;; rfn-eshadow.el --- Highlight `shadowed' part of read-file-name input text
   2 ;;
   3 ;; Copyright (C) 2000, 2001 Free Software Foundation, Inc.
   4 ;;
   5 ;; Author: Miles Bader <miles@gnu.org>
   6 ;; Keywords: convenience
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Commentary:
  26 ;;
  27 ;; Defines the mode `read-file-name-electric-shadow-mode'.
  28 ;;
  29 ;; The `read-file-name' function passes its result through
  30 ;; `substitute-in-file-name', so any part of the string preceding
  31 ;; multiple slashes (or a drive indicator on MS-DOS/MS-Windows) is
  32 ;; ignored.
  33 ;;
  34 ;; If `read-file-name-electric-shadow-mode' is active, any part of the
  35 ;; minibuffer text that would be ignored because of this is given the
  36 ;; properties in `read-file-name-electric-shadow-properties', which may
  37 ;; be used to make the ignored text invisible, dim, etc.
  38 ;;
  39
  40 ;;; Code:
  41
  42 \f
  43 ;;; Customization
  44
  45 (defconst read-file-name-electric-shadow-properties-custom-type
  46   '(list
  47     (checklist :inline t
  48                (const :tag "Invisible"
  49                       :doc "Make shadowed part of filename invisible"
  50                       :format "%t%n%h"
  51                       :inline t
  52                       (invisible t intangible t))
  53                (list :inline t
  54                      :format "%v"
  55                      :tag "Face"
  56                      :doc "Display shadowed part of filename using a different face"
  57                      (const :format "" face)
  58                      (face :value read-file-name-electric-shadow))
  59                (list :inline t
  60                      :format "%t: %v%h"
  61                      :tag "Brackets"
  62                      ;; Note the 4 leading spaces in the doc string;
  63                      ;; this is hack to get around the fact that the
  64                      ;; newline after the second string widget comes
  65                      ;; from the string widget, and doesn't indent
  66                      ;; correctly.  We could use a :size attribute to
  67                      ;; make the second string widget not have a
  68                      ;; terminating newline, but this makes it impossible
  69                      ;; to enter trailing whitespace, and it's desirable
  70                      ;; that it be possible.
  71                      :doc "    Surround shadowed part of filename with brackets"
  72                      (const :format "" before-string)
  73                      (string :format "%v" :size 4 :value "{")
  74                      (const :format "" after-string)
  75                      ;; see above about why the 2nd string doesn't use :size
  76                      (string :format " and: %v" :value "} "))
  77                (list :inline t
  78                      :format "%t: %v%n%h"
  79                      :tag "String"
  80                      :doc "Display a string instead of the shadowed part of filename"
  81                      (const :format "" display)
  82                      (string :format "%v" :size 15 :value "<...ignored...>"))
  83                (const :tag "Avoid"
  84                       :doc "Try to keep cursor out of shadowed part of filename"
  85                       :format "%t%n%h"
  86                       :inline t
  87                       (field shadow)))
  88     (repeat :inline t
  89             :tag "Other Properties"
  90             (list :inline t
  91                   :format "%v"
  92                   (symbol :tag "Property")
  93                   (sexp :tag "Value")))))
  94
  95 ;;;###autoload
  96 (defcustom read-file-name-electric-shadow-properties
  97   '(face read-file-name-electric-shadow field shadow)
  98   "Properties given to the `shadowed' part of a filename in the minibuffer.
  99 Only used when `read-file-name-electric-shadow-mode' is active.
 100 If emacs is not running under a window system,
 101 `read-file-name-electric-shadow-tty-properties' is used instead."
 102   :type read-file-name-electric-shadow-properties-custom-type
 103   :group 'minibuffer)
 104
 105 ;;;###autoload
 106 (defcustom read-file-name-electric-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 `read-file-name-electric-shadow-mode' is active and emacs
 110 is not running under a window-system; if emacs is running under a window
 111 system, `read-file-name-electric-shadow-properties' is used instead."
 112   :type read-file-name-electric-shadow-properties-custom-type
 113   :group 'minibuffer)
 114
 115 ;;;###autoload
 116 (defface read-file-name-electric-shadow
 117   '((((background dark))
 118      :foreground "grey50")
 119     (t
 120      :foreground "grey70"))
 121   "Face used by `read-file-name-electric-shadow-mode' for the shadow."
 122   :group 'minibuffer)
 123
 124 \f
 125 ;;; Internal variables
 126
 127 ;; Regexp to locate dividing point between shadow and real pathname
 128 (defconst rfn-eshadow-regexp
 129   (cond ((memq system-type '(ms-dos windows-nt))
 130          ;; This horrible regexp considers the following patterns as
 131          ;; starting an absolute pathname, when following a `/' or an `\':
 132          ;;   L:  /  //  ~  $  \\  \\\\
 133          "\\(.*[^/]+/+?\\|/*?\\|\\)\\([$~]\\|[][\\^a-z]:\\|//?\\([^][\\^a-z/$~]\\|[^/$~][^:]\\|[^/$~]?\\'\\)\\)")
 134         (t
 135          ;; default is for unix-style filenames
 136          "\\(.*/\\)[/$~]"))
 137   "Regular expression used to match shadowed filenames.
 138 There should be at least one regexp group; the end of the first one
 139 is used as the end of the shadowed portion of the filename.")
 140
 141 ;; A list of minibuffers to which we've added a post-command-hook.
 142 (defvar rfn-eshadow-frobbed-minibufs nil)
 143
 144 ;; An overlay covering the shadowed part of the filename (local to the
 145 ;; minibuffer).
 146 (defvar rfn-eshadow-overlay)
 147 (make-variable-buffer-local 'rfn-eshadow-overlay)
 148
 149 \f
 150 ;;; Hook functions
 151
 152 ;; This function goes on minibuffer-setup-hook
 153 (defun rfn-eshadow-setup-minibuffer ()
 154   "Set up a minibuffer for `read-file-name-electric-shadow-mode'.
 155 The prompt and initial input should already have been inserted."
 156   (when minibuffer-completing-file-name
 157     (setq rfn-eshadow-overlay
 158           (make-overlay (minibuffer-prompt-end) (minibuffer-prompt-end)))
 159     ;; Give rfn-eshadow-overlay the user's props.
 160     (let ((props
 161            (if window-system
 162                read-file-name-electric-shadow-properties
 163              read-file-name-electric-shadow-tty-properties)))
 164       (while props
 165         (overlay-put rfn-eshadow-overlay (pop props) (pop props))))
 166     ;; Turn on overlay evaporation so that we don't have to worry about
 167     ;; odd effects when the overlay sits empty at the beginning of the
 168     ;; minibuffer.
 169     (overlay-put rfn-eshadow-overlay 'evaporate t)
 170     ;; Add our post-command hook, and make sure can remove it later.
 171     (add-to-list 'rfn-eshadow-frobbed-minibufs (current-buffer))
 172     (add-hook 'post-command-hook #'rfn-eshadow-update-overlay nil t)))
 173
 174 ;; post-command-hook to update overlay
 175 (defun rfn-eshadow-update-overlay ()
 176   "Update `rfn-eshadow-overlay' to cover shadowed part of minibuffer input.
 177 This is intended to be used as a minibuffer post-command-hook for
 178 `read-file-name-electric-shadow-mode'; the minibuffer should have already
 179 been set up by `rfn-eshadow-setup-minibuffer'."
 180   ;; This is not really a correct implementation; it won't always do the
 181   ;; right thing in the presence of environment variables that
 182   ;; substitute-in-file-name would expand; currently it just assumes any
 183   ;; environment variable contains an absolute filename.  It doesn't
 184   ;; handle MS-DOS-type drive specs like substitute-in-file-name does.
 185   (save-excursion
 186     ;; Note that this should use `minibuffer-prompt-end' instead of
 187     ;; `field-end', but for now we use the latter so that it works
 188     ;; properly with old definitions of minibuffer-prompt-end.
 189     (goto-char (field-end (point-min)))
 190     ;; Update the overlay (which will evaporate if it's empty).
 191     (move-overlay rfn-eshadow-overlay
 192                   (point)
 193                   (if (looking-at rfn-eshadow-regexp)
 194                       (match-end 1)
 195                     (point)))))
 196
 197 \f
 198 ;;; Note this definition must be at the end of the file, because
 199 ;;; `define-minor-mode' actually calls the mode-function if the
 200 ;;; associated variable is non-nil, which requires that all needed
 201 ;;; functions be already defined.  [This is arguably a bug in d-m-m]
 202 ;;;###autoload
 203 (define-minor-mode read-file-name-electric-shadow-mode
 204   "Toggle Read-File-Name Electric Shadow mode
 205 When active, any part of the a filename being read in the minibuffer
 206 that would be ignored because the result is passed through
 207 `substitute-in-file-name' is given the properties in
 208 `read-file-name-electric-shadow-properties', which can be used to make
 209 that portion dim, invisible, or otherwise less visually noticable.
 210
 211 With prefix argument ARG, turn on if positive, otherwise off.
 212 Returns non-nil if the new state is enabled."
 213   :global t
 214   :group 'minibuffer
 215   (if read-file-name-electric-shadow-mode
 216       ;; Enable the mode
 217       (add-hook 'minibuffer-setup-hook 'rfn-eshadow-setup-minibuffer)
 218     ;; Disable the mode
 219     (remove-hook 'minibuffer-setup-hook 'rfn-eshadow-setup-minibuffer)
 220     ;; Remove our entry from any post-command-hook variable's it's still in
 221     (dolist (minibuf rfn-eshadow-frobbed-minibufs)
 222       (with-current-buffer minibuf
 223         (remove-hook 'post-command-hook #'rfn-eshadow-update-overlay t)))
 224     (setq rfn-eshadow-frobbed-minibufs nil)))
 225
 226
 227 (provide 'rfn-eshadow)
 228
 229 ;;; rfn-eshadow.el ends here