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 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 \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 ;;;###autoload
  97 (defcustom file-name-shadow-properties
  98   '(face file-name-shadow field shadow)
  99   "Properties given to the `shadowed' part of a filename in the minibuffer.
 100 Only used when `file-name-shadow-mode' is active.
 101 If emacs is not running under a window system,
 102 `file-name-shadow-tty-properties' is used instead."
 103   :type file-name-shadow-properties-custom-type
 104   :group 'minibuffer)
 105
 106 ;;;###autoload
 107 (defcustom file-name-shadow-tty-properties
 108   '(before-string "{" after-string "} " field shadow)
 109   "Properties given to the `shadowed' part of a filename in the minibuffer.
 110 Only used when `file-name-shadow-mode' is active and emacs
 111 is not running under a window-system; if emacs is running under a window
 112 system, `file-name-shadow-properties' is used instead."
 113   :type file-name-shadow-properties-custom-type
 114   :group 'minibuffer)
 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
 121 \f
 122 ;;; Internal variables
 123
 124 ;; Regexp to locate dividing point between shadow and real pathname
 125 (defconst rfn-eshadow-regexp
 126   (cond ((memq system-type '(ms-dos windows-nt))
 127          ;; This horrible regexp considers the following patterns as
 128          ;; starting an absolute pathname, when following a `/' or an `\':
 129          ;;   L:  /  //  ~  $  \\  \\\\
 130          "\\(.*[^/]+/+?\\|/*?\\|\\)\\(~\\|$[^$]\\|$\\'\\|[][\\^a-z]:\\|//?\\([^][\\^a-z/$~]\\|[^/$~][^:]\\|[^/$~]?\\'\\)\\)")
 131         (t
 132          ;; default is for unix-style filenames
 133          "\\(.*/\\)\\([/~]\\|$[^$]\\|$\\'\\)"))
 134   "Regular expression used to match shadowed filenames.
 135 There should be at least one regexp group; the end of the first one
 136 is used as the end of the shadowed portion of the filename.")
 137
 138 ;; A list of minibuffers to which we've added a post-command-hook.
 139 (defvar rfn-eshadow-frobbed-minibufs nil)
 140
 141 ;; An overlay covering the shadowed part of the filename (local to the
 142 ;; minibuffer).
 143 (defvar rfn-eshadow-overlay)
 144 (make-variable-buffer-local 'rfn-eshadow-overlay)
 145
 146 \f
 147 ;;; Hook functions
 148
 149 ;; This function goes on minibuffer-setup-hook
 150 (defun rfn-eshadow-setup-minibuffer ()
 151   "Set up a minibuffer for `file-name-shadow-mode'.
 152 The prompt and initial input should already have been inserted."
 153   (when minibuffer-completing-file-name
 154     (setq rfn-eshadow-overlay
 155           (make-overlay (minibuffer-prompt-end) (minibuffer-prompt-end)))
 156     ;; Give rfn-eshadow-overlay the user's props.
 157     (let ((props
 158            (if window-system
 159                file-name-shadow-properties
 160              file-name-shadow-tty-properties)))
 161       (while props
 162         (overlay-put rfn-eshadow-overlay (pop props) (pop props))))
 163     ;; Turn on overlay evaporation so that we don't have to worry about
 164     ;; odd effects when the overlay sits empty at the beginning of the
 165     ;; minibuffer.
 166     (overlay-put rfn-eshadow-overlay 'evaporate t)
 167     ;; Add our post-command hook, and make sure can remove it later.
 168     (add-to-list 'rfn-eshadow-frobbed-minibufs (current-buffer))
 169     (add-hook 'post-command-hook #'rfn-eshadow-update-overlay nil t)))
 170
 171 ;; post-command-hook to update overlay
 172 (defun rfn-eshadow-update-overlay ()
 173   "Update `rfn-eshadow-overlay' to cover shadowed part of minibuffer input.
 174 This is intended to be used as a minibuffer post-command-hook for
 175 `file-name-shadow-mode'; the minibuffer should have already
 176 been set up by `rfn-eshadow-setup-minibuffer'."
 177   ;; This is not really a correct implementation; it won't always do the
 178   ;; right thing in the presence of environment variables that
 179   ;; substitute-in-file-name would expand; currently it just assumes any
 180   ;; environment variable contains an absolute filename.
 181   (save-excursion
 182     (let ((inhibit-point-motion-hooks t))
 183       (goto-char (minibuffer-prompt-end))
 184       ;; Update the overlay (which will evaporate if it's empty).
 185       (move-overlay rfn-eshadow-overlay
 186                     (point)
 187                     (if (looking-at rfn-eshadow-regexp)
 188                         (match-end 1)
 189                       (point))))))
 190
 191 \f
 192 ;;; Note this definition must be at the end of the file, because
 193 ;;; `define-minor-mode' actually calls the mode-function if the
 194 ;;; associated variable is non-nil, which requires that all needed
 195 ;;; functions be already defined.  [This is arguably a bug in d-m-m]
 196 ;;;###autoload
 197 (define-minor-mode file-name-shadow-mode
 198   "Toggle File-Name Shadow mode.
 199 When active, any part of a filename being read in the minibuffer
 200 that would be ignored (because the result is passed through
 201 `substitute-in-file-name') is given the properties in
 202 `file-name-shadow-properties', which can be used to make
 203 that portion dim, invisible, or otherwise less visually noticeable.
 204
 205 With prefix argument ARG, turn on if positive, otherwise off.
 206 Returns non-nil if the new state is enabled."
 207   :global t
 208   :group 'minibuffer
 209   (if file-name-shadow-mode
 210       ;; Enable the mode
 211       (add-hook 'minibuffer-setup-hook 'rfn-eshadow-setup-minibuffer)
 212     ;; Disable the mode
 213     (remove-hook 'minibuffer-setup-hook 'rfn-eshadow-setup-minibuffer)
 214     ;; Remove our entry from any post-command-hook variable's it's still in
 215     (dolist (minibuf rfn-eshadow-frobbed-minibufs)
 216       (with-current-buffer minibuf
 217         (remove-hook 'post-command-hook #'rfn-eshadow-update-overlay t)))
 218     (setq rfn-eshadow-frobbed-minibufs nil)))
 219
 220
 221 (provide 'rfn-eshadow)
 222
 223 ;;; arch-tag: dcf70a52-0115-4ec2-b1e3-4f8d3541a888
 224 ;;; rfn-eshadow.el ends here