LCOV - code coverage report
Current view: top level - lisp - rfn-eshadow.el (source / functions) Hit Total Coverage
Test: tramp-tests.info Lines: 0 47 0.0 %
Date: 2017-08-27 09:44:50 Functions: 0 4 0.0 %

          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

Generated by: LCOV version 1.12