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: Re: find-file-project Date: Tue, 19 Jan 2016 21:25:53 -0500 Message-ID: References: <86pp1j4ejm.fsf@stephe-leake.org> <55F899EA.7050700@yandex.ru> <86lhc73wog.fsf@stephe-leake.org> <55F8F2FA.6060902@yandex.ru> <867fnq1oe9.fsf@stephe-leake.org> <55F9A13A.3070101@yandex.ru> <55FB01BD.1070909@yandex.ru> <568C6DE5.8040201@yandex.ru> <568F1327.30905@yandex.ru> <569DD470.2060603@yandex.ru> <569ED9F6.3050003@yandex.ru> <569EE733.6090406@yandex.ru> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: text/plain X-Trace: ger.gmane.org 1453256777 14730 80.91.229.3 (20 Jan 2016 02:26:17 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Wed, 20 Jan 2016 02:26:17 +0000 (UTC) Cc: Stephen Leake , emacs-devel@gnu.org To: Dmitry Gutov Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Wed Jan 20 03:26:07 2016 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1aLiTG-0006ny-Ap for ged-emacs-devel@m.gmane.org; Wed, 20 Jan 2016 03:26:06 +0100 Original-Received: from localhost ([::1]:39882 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1aLiTF-0003qE-IF for ged-emacs-devel@m.gmane.org; Tue, 19 Jan 2016 21:26:05 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:34567) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1aLiTA-0003oo-5y for emacs-devel@gnu.org; Tue, 19 Jan 2016 21:26:02 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1aLiT6-00014U-Tc for emacs-devel@gnu.org; Tue, 19 Jan 2016 21:26:00 -0500 Original-Received: from chene.dit.umontreal.ca ([132.204.246.20]:60635) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1aLiT6-00014O-Ky for emacs-devel@gnu.org; Tue, 19 Jan 2016 21:25:56 -0500 Original-Received: from fmsmemgm.homelinux.net (lechon.iro.umontreal.ca [132.204.27.242]) by chene.dit.umontreal.ca (8.14.1/8.14.1) with ESMTP id u0K2PrOn015812; Tue, 19 Jan 2016 21:25:53 -0500 Original-Received: by fmsmemgm.homelinux.net (Postfix, from userid 20848) id 317FBAE9D8; Tue, 19 Jan 2016 21:25:53 -0500 (EST) In-Reply-To: <569EE733.6090406@yandex.ru> (Dmitry Gutov's message of "Wed, 20 Jan 2016 04:47:31 +0300") User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.5 (gnu/linux) X-NAI-Spam-Flag: NO X-NAI-Spam-Level: X-NAI-Spam-Threshold: 5 X-NAI-Spam-Score: 0.2 X-NAI-Spam-Rules: 2 Rules triggered GEN_SPAM_FEATRE=0.2, RV5555=0 X-NAI-Spam-Version: 2.3.0.9418 : core <5555> : inlines <4200> : streams <1573743> : uri <2123387> X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-Received-From: 132.204.246.20 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:198408 Archived-At: > Were you going to attach it? I was, yes. >> Not sure in general (e.g. for attributes), but for tag names at least, >> I think that's pretty much the case. > Attribute values could be a problem, Haven't thought much about them, but I don't think so: they tend to either have few variants or offer no completion at all (allow pretty much anything). > but why not in attribute names? Yes, for attribute names that's pretty much the case as well I think. > Do we expect to work with freakish schemas, with thousands of > possible attributes? Sounds unlikely. >>> But that's a bit of a separate concern: since completion-try-completion and >>> completion-all-completions are on a higher level, I think *they* could be >>> generics, whereas the all-completions/etc could stay as they are. >> But the only argument they receive is the completion-table, so we need >> them to be "dispatchable". > They who? completion-try-completion and the other? Yes. > The default method will handle lists/alists/hash-tables and > functions. The specialized methods will handle "dispatchable" types. Right, but that still requires the a new "dispatchable" kind of completion-table. >> [ Side note: I've been toying with the idea of "callable objects", by >> which I mean thingies which have slots and dispatchable types (like >> cl-structs or eieio objects) but which can also be passed to funcall. >> We could use them for the advice objects of nadvice.el, for the stream >> objects of stream.el, and potentially here as well. ] > Like a closure, but with named fields as its environment? I can see how it > could be handy for debugging, but not how it would help with the issue > at hand. That would allow us to keep using functions (rather than add a new kind of completion-table), and simply give them a dispatchable type when we need it. Stefan diff --git a/lisp/filecache.el b/lisp/filecache.el index e754190..56b7f43 100644 --- a/lisp/filecache.el +++ b/lisp/filecache.el @@ -1,4 +1,4 @@ -;;; filecache.el --- find files using a pre-loaded cache +;;; filecache.el --- Find files using a pre-loaded cache -*- lexical-binding: t -*- ;; Copyright (C) 1996, 2000-2016 Free Software Foundation, Inc. @@ -499,7 +499,7 @@ If called interactively, read the directory names one by one." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Returns the name of a directory for a file in the cache -(defun file-cache-directory-name (file) +(defun file-cache-directory-name (file) (let* ((directory-list (cdr (assoc-string file file-cache-alist file-cache-ignore-case))) @@ -517,8 +517,11 @@ If called interactively, read the directory names one by one." (error "Filecache: no directory found for key %s" file)) ;; Multiple elements (t + ;; FIXME: the use of minibuffer-contents here means that + ;; filecache can only be used in the minibuffer :-( (let* ((minibuffer-dir (file-name-directory (minibuffer-contents))) - (dir-list (member minibuffer-dir directory-list))) + (dir-list (member (expand-file-name minibuffer-dir) + directory-list))) (setq directory ;; If the directory is in the list, return the next element ;; Otherwise, return the first element @@ -533,9 +536,9 @@ If called interactively, read the directory names one by one." directory)) ;; Returns the name of a file in the cache -(defun file-cache-file-name (file) +(defun file-cache-file-name (file) (let ((directory (file-cache-directory-name file))) - (concat directory file))) + (abbreviate-file-name (concat directory file)))) ;; Return a canonical directory for comparison purposes. ;; Such a directory ends with a forward slash. @@ -557,78 +560,151 @@ If called interactively, read the directory names one by one." ;; ;; The default is to do the former; a prefix arg forces the latter. +(defun file-cache-minibuffer-message (msg) + ;; Can't output a minibuffer-message naively from the + ;; completion-table because the completion hasn't been performed + ;; yet, so the sit-for would do the wrong thing. + ;; (minibuffer-message file-cache-multiple-directory-message) + (let ((buf (current-buffer)) + (ol (if (minibufferp (current-buffer)) + (make-overlay (point-max) (point-max) + nil t t))) + (timer ()) + (fun ())) + (if (null ol) + (message msg) + (unless (zerop (length msg)) + ;; The current C cursor code doesn't know to use the overlay's + ;; marker's stickiness to figure out whether to place the cursor + ;; before or after the string, so let's spoon-feed it the pos. + (setq msg (copy-sequence msg)) + (put-text-property 0 1 'cursor t msg)) + (overlay-put ol 'after-string msg)) + (setq fun (lambda () + (with-current-buffer buf + (if (overlay-buffer ol) + (delete-overlay ol) + (message nil)) + (when timer (cancel-timer timer) (setq timer nil)) + (remove-hook 'pre-command-hook fun 'local)))) + (add-hook 'pre-command-hook fun nil 'local) + (when minibuffer-message-timeout + (setq timer (run-with-timer minibuffer-message-timeout nil fun))))) + +(defun file-cache-completion-table (minibuffer-contents pred action) + (let* ((completion-ignore-case file-cache-completion-ignore-case) + (case-fold-search file-cache-case-fold-search) + (string (file-name-nondirectory minibuffer-contents)) + ;; Ignore completion-regexp-list since it applies to the complete + ;; filenames, where here we're mostly just handling the + ;; nondirectory parts. + (completion-regexp-list nil) + ;; First look at the nondirectory part. + (completion-string (try-completion string file-cache-alist)) + (dirs (assoc-string (if (stringp completion-string) + completion-string string) + file-cache-alist file-cache-ignore-case))) + (cond + ;; If it's an exact match, complete on the directories by cycling. + ((or current-prefix-arg (eq completion-string t) + (and (equal string completion-string) dirs + ;; FIXME: This use of this/last-command to decide + ;; whether to start cycling or not is an ugly + ;; hack. Previous code used a global + ;; `file-cache-last-completion' var, but that + ;; doesn't work now that we're in a completion + ;; table that can be called several times + ;; for a single completion command. + (setq this-command 'file-cache-complete-but-no-unique) + (eq last-command this-command)) + ;; Also start cycling right away if there's only one + ;; completion for the filename part. + + ;; FIXME: this has one bug, which was already present in the + ;; old code, in that if the current file is already in the + ;; first dir, we skip straight to the second. + ;; Then again, maybe this is a feature, tho, since the user + ;; could have used normal completion if he wanted the file + ;; in the current dir. + (and completion-string + (eq t (try-completion completion-string file-cache-alist)))) + (if (eq completion-string t) (setq completion-string string)) + (let ((file-cache-string (file-cache-file-name completion-string))) + (cond + ;; FIXME: to cycle, we have to behave in a non-standard way, + ;; e.g. the list of completions returned for all-completions + ;; will mostly not match the given "prefix". + ;; Instead, we should have a way for the completion table to + ;; say "use cycling now" or "this completion table is not + ;; prefix-based". This will imply things like "don't use + ;; partial matching". + ;; Return the next directory. + ((eq action nil) + (cond + ((string= file-cache-string minibuffer-contents) t) + (current-prefix-arg + ;; By returning the same string, we hopefully cause + ;; minibuffer-complete to call minibuffer-completion-help. + ;; But subsequent completions will then try to scroll that + ;; window unless we change this-command. + (setq this-command 'file-cache-completion-help) + ;; To make sure we show completion-help even if + ;; completion-auto-help is `lazy', we also set + ;; last-command. + (setq last-command 'file-cache-completion-help) + minibuffer-contents) + (t + (when file-cache-multiple-directory-message + (file-cache-minibuffer-message + file-cache-multiple-directory-message)) + file-cache-string))) + (t + ;; FIXME: if action is t (i.e. all-completions), we + ;; return a list of completions which don't match the + ;; prefix. This is necessary for the completion-help to display + ;; the actual list of possible directories, but it also has + ;; some undesirable side-effects. E.g. completion-help will + ;; tend to assume that the returned completions match the + ;; prefix and will blindly highlight the "following" char. + (complete-with-action + action + (mapcar (lambda (d) (abbreviate-file-name + (concat d completion-string))) + (cdr dirs)) + (if (or (not (memq action '(t))) + (string= file-cache-string minibuffer-contents)) + minibuffer-contents "") + pred))))) + + ;; We don't want to cycle, instead do normal completion on the + ;; filename part. Here partial-completion and friends should + ;; work just fine. We could even make `initials' completion + ;; working there. + (t + (completion-table-with-context + (or (file-name-directory minibuffer-contents) "") + ;; Ignore the predicate here since this is only an intermediate + ;; state where we complete file names that will usually not be yet + ;; in the right directory. + file-cache-alist string nil action))))) + ;;;###autoload -(defun file-cache-minibuffer-complete (arg) +(defun file-cache-minibuffer-complete (_arg) "Complete a filename in the minibuffer using a preloaded cache. Filecache does two kinds of substitution: it completes on names in the cache, and, once it has found a unique name, it cycles through -the directories that the name is available in. With a prefix argument, -the name is considered already unique; only the second substitution -\(directories) is done." +the directories that the name is available in." (interactive "P") - (let* - ( - (completion-ignore-case file-cache-completion-ignore-case) - (case-fold-search file-cache-case-fold-search) - (string (file-name-nondirectory (minibuffer-contents))) - (completion-string (try-completion string file-cache-alist)) - (completion-list) - (len) - (file-cache-string)) - (cond - ;; If it's the only match, replace the original contents - ((or arg (eq completion-string t)) - (setq file-cache-string (file-cache-file-name string)) - (if (string= file-cache-string (minibuffer-contents)) - (minibuffer-message file-cache-sole-match-message) - (delete-minibuffer-contents) - (insert file-cache-string) - (if file-cache-multiple-directory-message - (minibuffer-message file-cache-multiple-directory-message)))) - - ;; If it's the longest match, insert it - ((stringp completion-string) - ;; If we've already inserted a unique string, see if the user - ;; wants to use that one - (if (and (string= string completion-string) - (assoc-string string file-cache-alist - file-cache-ignore-case)) - (if (and (eq last-command this-command) - (string= file-cache-last-completion completion-string)) - (progn - (delete-minibuffer-contents) - (insert (file-cache-file-name completion-string)) - (setq file-cache-last-completion nil)) - (minibuffer-message file-cache-non-unique-message) - (setq file-cache-last-completion string)) - (setq file-cache-last-completion string) - (setq completion-list (all-completions string file-cache-alist) - len (length completion-list)) - (if (> len 1) - (progn - (goto-char (point-max)) - (insert - (substring completion-string (length string))) - ;; Add our own setup function to the Completions Buffer - (let ((completion-setup-hook - (append completion-setup-hook - (list 'file-cache-completion-setup-function)))) - (with-output-to-temp-buffer file-cache-completions-buffer - (display-completion-list - (completion-hilit-commonality completion-list - (length string)))))) - (setq file-cache-string (file-cache-file-name completion-string)) - (if (string= file-cache-string (minibuffer-contents)) - (minibuffer-message file-cache-sole-match-message) - (delete-minibuffer-contents) - (insert file-cache-string) - (if file-cache-multiple-directory-message - (minibuffer-message file-cache-multiple-directory-message))) - ))) - - ;; No match - ((eq completion-string nil) - (minibuffer-message file-cache-no-match-message))))) + (let ((minibuffer-completion-table 'file-cache-completion-table) + ;; When cycling, partial completion doesn't work at all. + (completion-styles (if (eq 'partial-completion (car completion-styles)) + (cons 'basic completion-styles) + completion-styles)) + (completion-setup-hook + (append completion-setup-hook + (list 'file-cache-completion-setup-function)))) + ;; FIXME: Use completion-in-region? + (minibuffer-complete))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Completion functions @@ -636,7 +712,14 @@ the name is considered already unique; only the second substitution (defun file-cache-completion-setup-function () (with-current-buffer standard-output ;; i.e. file-cache-completions-buffer - (use-local-map file-cache-completions-keymap))) + (if (save-excursion + (goto-char (point-min)) + (next-completion 1) + (file-name-absolute-p + (buffer-substring (point) (line-end-position)))) + ;; FIXME: we could strip the bogus highlighting here, actually. + nil + (use-local-map file-cache-completions-keymap)))) (defun file-cache-choose-completion (&optional event) "Choose a completion in the `*Completions*' buffer."