From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Stefan Monnier Newsgroups: gmane.emacs.devel Subject: rfn-shadow Date: Mon, 27 Jun 2005 22:24:14 -0400 Message-ID: <87d5q7z0i3.fsf-monnier+emacs@gnu.org> NNTP-Posting-Host: main.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=us-ascii X-Trace: sea.gmane.org 1119934301 22712 80.91.229.2 (28 Jun 2005 04:51:41 GMT) X-Complaints-To: usenet@sea.gmane.org NNTP-Posting-Date: Tue, 28 Jun 2005 04:51:41 +0000 (UTC) Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Tue Jun 28 06:51:32 2005 Return-path: Original-Received: from lists.gnu.org ([199.232.76.165]) by ciao.gmane.org with esmtp (Exim 4.43) id 1Dn84F-0001K5-0Z for ged-emacs-devel@m.gmane.org; Tue, 28 Jun 2005 06:51:27 +0200 Original-Received: from localhost ([127.0.0.1] helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1Dn8C1-0001Y6-3m for ged-emacs-devel@m.gmane.org; Tue, 28 Jun 2005 00:59:29 -0400 Original-Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.43) id 1Dn8Aq-0001IX-LH for emacs-devel@gnu.org; Tue, 28 Jun 2005 00:58:17 -0400 Original-Received: from exim by lists.gnu.org with spam-scanned (Exim 4.43) id 1Dn8AV-00019e-P6 for emacs-devel@gnu.org; Tue, 28 Jun 2005 00:58:03 -0400 Original-Received: from [199.232.76.173] (helo=monty-python.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1Dn8AT-00016p-JA for emacs-devel@gnu.org; Tue, 28 Jun 2005 00:57:53 -0400 Original-Received: from [209.226.175.203] (helo=toq7-srv.bellnexxia.net) by monty-python.gnu.org with esmtp (Exim 4.34) id 1Dn89P-0007Kh-R1 for emacs-devel@gnu.org; Tue, 28 Jun 2005 00:56:48 -0400 Original-Received: from alfajor ([67.71.32.183]) by tomts20-srv.bellnexxia.net (InterMail vM.5.01.06.10 201-253-122-130-110-20040306) with ESMTP id <20050628022415.RVSU19894.tomts20-srv.bellnexxia.net@alfajor>; Mon, 27 Jun 2005 22:24:15 -0400 Original-Received: by alfajor (Postfix, from userid 1000) id 6885CD732C; Mon, 27 Jun 2005 22:24:15 -0400 (EDT) Original-To: emacs-devel@gnu.org User-Agent: Gnus/5.11 (Gnus v5.11) Emacs/22.0.50 (gnu/linux) X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:39742 X-Report-Spam: http://spam.gmane.org/gmane.emacs.devel:39742 rfn-shadow is still not working correctly with url-handler-mode and other things (like file names with $envvars). I've used the patch below very successfully for a while now. Any objection? Stefan --- orig/lisp/rfn-eshadow.el +++ mod/lisp/rfn-eshadow.el @@ -1,6 +1,6 @@ ;;; rfn-eshadow.el --- Highlight `shadowed' part of read-file-name input text ;; -;; Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc. +;; Copyright (C) 2000, 2001, 2002, 2005 Free Software Foundation, Inc. ;; ;; Author: Miles Bader ;; Keywords: convenience minibuffer @@ -97,7 +97,7 @@ '(face file-name-shadow field shadow) "Properties given to the `shadowed' part of a filename in the minibuffer. Only used when `file-name-shadow-mode' is active. -If emacs is not running under a window system, +If Emacs is not running under a window system, `file-name-shadow-tty-properties' is used instead." :type file-name-shadow-properties-custom-type :group 'minibuffer) @@ -120,20 +120,6 @@ ;;; Internal variables -;; Regexp to locate dividing point between shadow and real pathname -(defconst rfn-eshadow-regexp - (cond ((memq system-type '(ms-dos windows-nt)) - ;; This horrible regexp considers the following patterns as - ;; starting an absolute pathname, when following a `/' or an `\': - ;; L: / // ~ $ \\ \\\\ - "\\(.*[^/]+/+?\\|/*?\\|\\)\\(~\\|$[^$]\\|$\\'\\|[][\\^a-z]:\\|//?\\([^][\\^a-z/$~]\\|[^/$~][^:]\\|[^/$~]?\\'\\)\\)") - (t - ;; default is for unix-style filenames - "\\(.*/\\)\\([/~]\\|$[^$]\\|$\\'\\)")) - "Regular expression used to match shadowed filenames. -There should be at least one regexp group; the end of the first one -is used as the end of the shadowed portion of the filename.") - ;; A list of minibuffers to which we've added a post-command-hook. (defvar rfn-eshadow-frobbed-minibufs nil) @@ -167,31 +153,53 @@ (add-to-list 'rfn-eshadow-frobbed-minibufs (current-buffer)) (add-hook 'post-command-hook #'rfn-eshadow-update-overlay nil t))) +(defsubst rfn-eshadow-sifn-equal (goal pos) + (equal goal (condition-case nil + (substitute-in-file-name + (buffer-substring-no-properties pos (point-max))) + ;; `substitute-in-file-name' can fail on partial input. + (error nil)))) + ;; post-command-hook to update overlay (defun rfn-eshadow-update-overlay () "Update `rfn-eshadow-overlay' to cover shadowed part of minibuffer input. -This is intended to be used as a minibuffer post-command-hook for +This is intended to be used as a minibuffer `post-command-hook' for `file-name-shadow-mode'; the minibuffer should have already been set up by `rfn-eshadow-setup-minibuffer'." - ;; This is not really a correct implementation; it won't always do the - ;; right thing in the presence of environment variables that - ;; substitute-in-file-name would expand; currently it just assumes any - ;; environment variable contains an absolute filename. - (save-excursion - (let ((inhibit-point-motion-hooks t)) - (goto-char (minibuffer-prompt-end)) - ;; Update the overlay (which will evaporate if it's empty). - (move-overlay rfn-eshadow-overlay - (point) - (if (looking-at rfn-eshadow-regexp) - (match-end 1) - (point)))))) - + ;; This code usually is instantaneous, but if the file name includes + ;; a "~", substitute-in-file-name will lookup your system's list of + ;; users to see whether "" is an actual user or not, and that + ;; can sometimes take a while, so we wrap this in `while-no-input'. + ;; (while-no-input + (condition-case nil + (let ((goal (substitute-in-file-name (minibuffer-contents))) + (mid (overlay-end rfn-eshadow-overlay)) + (start (minibuffer-prompt-end)) + (end (point-max))) + (unless + ;; Catch the common case where the shadow does not need to move. + (and mid + (or (eq mid end) + (not (rfn-eshadow-sifn-equal goal (1+ mid)))) + (or (eq mid start) + (rfn-eshadow-sifn-equal goal mid))) + ;; Binary search for the greatest position still equivalent to + ;; the whole. + (while (or (< (1+ start) end) + (if (and (< (1+ end) (point-max)) + (rfn-eshadow-sifn-equal goal (1+ end))) + ;; (SIFN end) != goal, but (SIFN (1+end)) == goal, + ;; We've reached a discontinuity: this can happen + ;; e.g. if `end' point to "/:...". + (setq start (1+ end) end (point-max)))) + (setq mid (/ (+ start end) 2)) + (if (rfn-eshadow-sifn-equal goal mid) + (setq start mid) + (setq end mid))) + (move-overlay rfn-eshadow-overlay (minibuffer-prompt-end) start))) + ;; `substitute-in-file-name' can fail on partial input. + (error nil)));;) -;;; Note this definition must be at the end of the file, because -;;; `define-minor-mode' actually calls the mode-function if the -;;; associated variable is non-nil, which requires that all needed -;;; functions be already defined. [This is arguably a bug in d-m-m] ;;;###autoload (define-minor-mode file-name-shadow-mode "Toggle File-Name Shadow mode. @@ -219,5 +227,5 @@ (provide 'rfn-eshadow) -;;; arch-tag: dcf70a52-0115-4ec2-b1e3-4f8d3541a888 +;; arch-tag: dcf70a52-0115-4ec2-b1e3-4f8d3541a888 ;;; rfn-eshadow.el ends here