[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: find-file-project
From: |
Stefan Monnier |
Subject: |
Re: find-file-project |
Date: |
Tue, 19 Jan 2016 21:25:53 -0500 |
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/24.5 (gnu/linux) |
> 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."
- Re: find-file-project, (continued)
- Re: find-file-project, John Wiegley, 2016/01/07
- Re: find-file-project, Dmitry Gutov, 2016/01/07
- Re: find-file-project, Stefan Monnier, 2016/01/08
- Re: find-file-project, Dmitry Gutov, 2016/01/19
- Re: find-file-project, Stefan Monnier, 2016/01/19
- Re: find-file-project, Dmitry Gutov, 2016/01/19
- Re: find-file-project, Stefan Monnier, 2016/01/19
- Re: find-file-project, Dmitry Gutov, 2016/01/19
- Re: find-file-project,
Stefan Monnier <=
- Re: find-file-project, Dmitry Gutov, 2016/01/20
- Re: find-file-project, Stefan Monnier, 2016/01/20
- Re: find-file-project, Dmitry Gutov, 2016/01/20
- RE: find-file-project, Drew Adams, 2016/01/20
- Re: find-file-project, Dmitry Gutov, 2016/01/20
- RE: find-file-project, Drew Adams, 2016/01/20
- Re: find-file-project, Dmitry Gutov, 2016/01/20
- RE: find-file-project, Drew Adams, 2016/01/20
- Re: find-file-project, Dmitry Gutov, 2016/01/20
- RE: find-file-project, Drew Adams, 2016/01/20