;;; Bugs:
-;; - completion-all-sorted-completions lists all the completions, whereas
-;; it should only lists the ones that `try-completion' would consider.
-;; E.g. it should honor completion-ignored-extensions.
;; - choose-completion can't automatically figure out the boundaries
;; corresponding to the displayed completions because we only
;; provide the start info but not the end info in
;; - Make *Completions* readable even if some of the completion
;; entries have LF chars or spaces in them (including at
;; beginning/end) or are very long.
-;; - for M-x, cycle-sort commands that have no key binding first.
-;; - Make things like icomplete-mode or lightning-completion work with
-;; completion-in-region-mode.
-;; - extend `metadata':
-;; - indicate how to turn all-completion's output into
-;; try-completion's output: e.g. completion-ignored-extensions.
-;; maybe that could be merged with the "quote" operation.
-;; - indicate that `all-completions' doesn't do prefix-completion
-;; but just returns some list that relates in some other way to
-;; the provided string (as is the case in filecache.el), in which
-;; case partial-completion (for example) doesn't make any sense
-;; and neither does the completions-first-difference highlight.
-;; - indicate how to display the completions in *Completions* (turn
-;; \n into something else, add special boundaries between
-;; completions). E.g. when completing from the kill-ring.
-
;; - case-sensitivity currently confuses two issues:
;; - whether or not a particular completion table should be case-sensitive
;; (i.e. whether strings that differ only by case are semantically
;; Maybe the trick is that we should distinguish completion-ignore-case in
;; try/all-completions (obey user's preference) from its use in
;; test-completion (obey the underlying object's semantics).
-
;; - add support for ** to pcm.
;; - Add vc-file-name-completion-table to read-file-name-internal.
(delete-dups (append (cdr over) (copy-sequence completion-styles)))
completion-styles))))
+(defcustom completions-exclude-exceptional-candidates t
+ "Whether to exclude exceptional minibuffer completion candidates."
+ :type 'boolean
+ :version "30.1")
+
+(defvar completions--only-exceptional-candidates nil
+ "Whether last completion operation produced only exceptional candidates.")
+
+(defcustom completion-ignored-extensions
+ (append
+ (cond ((memq system-type '(ms-dos windows-nt))
+ (mapcar 'purecopy
+ '(".o" "~" ".bin" ".bak" ".obj" ".map" ".ico" ".pif" ".lnk"
+ ".a" ".ln" ".blg" ".bbl" ".dll" ".drv" ".vxd" ".386")))
+ (t
+ (mapcar 'purecopy
+ '(".o" "~" ".bin" ".lbin" ".so"
+ ".a" ".ln" ".blg" ".bbl"))))
+ (mapcar 'purecopy
+ '(".elc" ".lof"
+ ".glo" ".idx" ".lot"
+ "./"
+ ;; VCS metadata directories
+ ".svn/" ".hg/" ".git/" ".bzr/" "CVS/" "_darcs/" "_MTN/"
+ ;; TeX-related
+ ".fmt" ".tfm"
+ ;; Java compiled
+ ".class"
+ ;; CLISP
+ ".fas" ".lib" ".mem"
+ ;; CMUCL
+ ".x86f" ".sparcf"
+ ;; OpenMCL / Clozure CL
+ ".dfsl" ".pfsl" ".d64fsl" ".p64fsl" ".lx64fsl" ".lx32fsl"
+ ".dx64fsl" ".dx32fsl" ".fx64fsl" ".fx32fsl" ".sx64fsl"
+ ".sx32fsl" ".wx64fsl" ".wx32fsl"
+ ;; Other CL implementations (Allegro, LispWorks)
+ ".fasl" ".ufsl" ".fsl" ".dxl"
+ ;; Libtool
+ ".lo" ".la"
+ ;; Gettext
+ ".gmo" ".mo"
+ ;; Texinfo-related
+ ;; This used to contain .log, but that's commonly used for log
+ ;; files you do want to see, not just TeX stuff. -- fx
+ ".toc" ".aux"
+ ".cp" ".fn" ".ky" ".pg" ".tp" ".vr"
+ ".cps" ".fns" ".kys" ".pgs" ".tps" ".vrs"
+ ;; Python byte-compiled
+ ".pyc" ".pyo")))
+ "Completion normally ignores file names ending with strings in this list.
+It does not ignore them if all possible completions end. Completion
+ignores directory names if they match any string in this list that ends
+in a slash."
+ :type '(repeat string)
+ :version "30.1")
+
(defun completion--nth-completion (n string table pred point metadata)
"Call the Nth method of completion styles."
;; We provide special support for quoting/unquoting here because it cannot
;; The quote/unquote function needs to come from the completion table (rather
;; than from completion-extra-properties) because it may apply only to some
;; part of the string (e.g. substitute-in-file-name).
+ (setq completions--only-exceptional-candidates nil)
(let* ((md (or metadata
(completion-metadata (substring string 0 point) table pred)))
(requote
(setq point (pop new))
(cl-assert (<= point (length string)))
(pop new))))
+ (defp (completion-metadata-get md 'normal-predicate))
+ (func (lambda (predicate)
+ (seq-some
+ (lambda (style)
+ (when-let ((probe (funcall
+ (nth n (assq style completion-styles-alist))
+ string table predicate point)))
+ (cons probe style)))
+ (completion--styles md))))
(result-and-style
- (seq-some
- (lambda (style)
- (when-let ((probe (funcall
- (nth n (assq style completion-styles-alist))
- string table pred point)))
- (cons probe style)))
- (completion--styles md)))
+ (cond
+ ((and completions-exclude-exceptional-candidates defp pred)
+ (or (funcall func (lambda (cand)
+ (and (funcall defp cand)
+ (funcall pred cand))))
+ (setq completions--only-exceptional-candidates
+ (funcall func pred))))
+ ((and completions-exclude-exceptional-candidates defp)
+ (or (funcall func defp)
+ (setq completions--only-exceptional-candidates
+ (funcall func pred))))
+ (t (funcall func pred))))
(adjust-fn (get (cdr result-and-style) 'completion--adjust-metadata)))
(setq completion--matching-style (cdr result-and-style))
(when (and adjust-fn metadata)
(defvar-local completions-sort-function nil)
(defvar-local completions-sort-orders nil)
(defvar-local completions-predicate nil)
+(defvar-local completions-exceptional-candidates nil)
(defvar-local completions-action nil)
(defvar-local completions-style nil)
(:eval (symbol-name completions-style))
" ")))
+(defvar completions-header-exceptional-candidates
+ '(completions-exceptional-candidates "~ "))
+
(defvar completions-header-extra nil)
(dolist (sym '(completions-header-count
completions-header-restriction
completions-header-action
completions-header-style
+ completions-header-exceptional-candidates
completions-header-extra))
(put sym 'risky-local-variable t))
completions-header-count completions-header-category
completions-header-order completions-header-restriction
completions-header-action completions-header-style
- completions-header-extra)
+ completions-header-exceptional-candidates completions-header-extra)
"Header line format of the *Completions* buffer.")
(defun completion--insert-strings (strings &optional group-fun)
(defface completions-previous-input '((t :underline "violet"))
"Face for highlighting previous inputs in the *Completions* buffer.")
+(defface completions-exceptional-candidate
+ '((t :underline (:style wave :color "grey")))
+ "Face for highlighting exceptional candidates in the *Completions* buffer.")
+
(defface completions-used-input '((t :inherit link-visited))
"Face for highlighting used inputs in the *Completions* buffer.")
:version "30.1"
:type 'boolean)
+(defcustom completions-highlight-exceptional-candidates t
+ "Whether to highlight exceptional candidates in the *Completions* buffer."
+ :version "30.1"
+ :type 'boolean)
+
(defvar completion-extra-properties nil
"Property list of extra properties of the current completion job.
These include:
(point-max))
""))
(style completion--matching-style)
+ (exceptional-candidates
+ (or (not completions-exclude-exceptional-candidates)
+ completions--only-exceptional-candidates))
(all-md (completion--metadata (buffer-substring-no-properties
start (point))
base-size md
(aff-fun (completion-metadata-get all-md 'affixation-function))
(sort-fun (completion-metadata-get all-md 'sort-function))
(group-fun (completion-metadata-get all-md 'group-function))
+ (def-pred (completion-metadata-get all-md 'normal-predicate))
(category (completion-metadata-get all-md 'category))
(minibuffer-completion-base
(funcall (or (alist-get 'adjust-base-function all-md) #'identity)
(minibuffer--cache-completion-input (substring string base-size)
full-base)
(when last (setcdr last nil))
- ;; Highilight previously used completions.
+
+ ;; Maybe highilight previously used completions.
(when-let
((hist (and completions-highlight-previous-inputs
(not (eq minibuffer-history-variable t))
comp))
completions)))
+ ;; Maybe highilight exceptional completion candidates.
+ (unless (or
+ ;; Exceptional candidate highilighting is disabled.
+ (not completions-highlight-exceptional-candidates)
+ ;; All candidates are normal.
+ (not def-pred)
+ ;; Exceptional candidates are excluded.
+ completions-exclude-exceptional-candidates
+ ;; All candidates are exceptional.
+ completions--only-exceptional-candidates)
+ ;; Otherwise, we have a mix of normal and exceptional
+ ;; candidates, and the mandate to highlight exceptions.
+ (setq completions
+ (mapcar
+ (lambda (comp)
+ (if (not (funcall def-pred comp))
+ ;; COMP is exceptional. Return highlighted COPY.
+ (let ((copy (copy-sequence comp)))
+ (font-lock-append-text-property
+ 0 (length copy)
+ 'face 'completions-exceptional-candidate copy)
+ copy)
+ ;; COMP is normal. Return it as-is.
+ comp))
+ completions)))
+
;; Sort first using the `sort-function'.
- ;; FIXME: This function is for the output of
- ;; all-completions, not
- ;; completion-all-completions. Often it's the
- ;; same, but not always.
(setq completions
(cond
(explicit-sort-function
('historical (minibuffer-sort-by-history completions))
(_ (funcall completions-sort completions))))))
- ;; After sorting, group the candidates using the
- ;; `group-function'.
+ ;; Group the candidates using the `group-function'.
(when group-fun
(setq completions
(minibuffer--group-by
:sort-function explicit-sort-function
:sort-orders sort-orders
:predicate cpred
+ :exceptional-candidates exceptional-candidates
:action action
:base-position (list (+ start base-size) end)
:base-affixes (list base-prefix base-suffix)
completions-sort-function (plist-get plist :sort-function)
completions-sort-orders (plist-get plist :sort-orders)
completions-predicate (plist-get plist :predicate)
+ completions-exceptional-candidates (plist-get plist :exceptional-candidates)
completions-action (plist-get plist :action)))
(run-hooks 'completion-setup-hook)
(display-buffer buf
"C-x C-v" #'minibuffer-sort-completions
"C-x n" 'minibuffer-narrow-completions-map
"C-x /" #'minibuffer-set-completion-styles
+ "C-x ~" #'minibuffer-toggle-exceptional-candidates
"C-j" #'minibuffer-apply
"C-p" #'minibuffer-previous-line-or-completion
"C-n" #'minibuffer-next-line-or-completion
""))))
files)))
+(defun completion-file-name-normal-predicate (file-name)
+ "Return non-nil if FILE-NAME is a normal file name completion candidate.
+
+Normal candidates are all file names that don't end in one of the
+strings in `completion-ignored-extensions'."
+ (not (seq-some (lambda (ext) (string-suffix-p ext file-name))
+ completion-ignored-extensions)))
+
(defun completion-file-name-table (string pred action)
"Completion table for file names."
(condition-case nil
((eq action 'metadata)
`(metadata
(category . file)
+ (normal-predicate . completion-file-name-normal-predicate)
,@(when completions-detailed
'((affixation-function . completion-file-name-affixation)))))
((string-match-p "\\`~[^/\\]*\\'" string)
table)
"Syntax table used when reading a file name in the minibuffer.")
-;; minibuffer-completing-file-name is a variable used internally in minibuf.c
-;; to determine whether to use minibuffer-local-filename-completion-map or
-;; minibuffer-local-completion-map. It shouldn't be exported to Elisp.
-;; FIXME: Actually, it is also used in rfn-eshadow.el we'd otherwise have to
-;; use (eq minibuffer-completion-table #'read-file-name-internal), which is
-;; probably even worse. Maybe We should add some read-file-name-setup-hook
-;; instead, but for now, let's keep this non-obsolete.
-;;(make-obsolete-variable 'minibuffer-completing-file-name nil "future" 'get)
-
(defun minibuffer--sort-file-names-by-last-modified-time (files)
"Sort file name completion candidates FILES by last modified time."
(let ((file-time-alist
'face 'completions-annotations))))
names)))
-(defun completion-buffer-name-table (string pred action)
- "Completion table for buffer names.
+(defun completion-buffer-name-normal-predicate (buffer-name)
+ "Return non-nil if BUFFER-NAME is a normal buffer name completion candidate.
-See Info node `(elisp)Programmed Completion' for the meaning of
-STRING, PRED and ACTION.
+Normal candidates are buffer names that don't start with a space.
+Buffer names that begin with a space are for internal buffers, so in
+other words, this function returns nil for internal buffer names."
+ (not (or (string-empty-p buffer-name) (eq (aref buffer-name 0) ?\s))))
-When the value of variable `read-buffer-to-switch-current-buffer'
-is a buffer, this function excludles that buffer from the list of
+(defun completion-buffer-name-table ()
+ "Return a completion table for buffer names.
+
+When the value of variable `read-buffer-to-switch-current-buffer' is a
+buffer, the completion table excludles that buffer from the list of
possible completions."
- (if (eq action 'metadata)
- `(metadata
- (category . buffer)
- (sort-function . identity)
- (narrow-completions-function . minibuffer-narrow-buffer-completions)
- ,@(when completions-detailed
- '((affixation-function . completion-buffer-name-affixation))))
- (let* ((buffers (remove read-buffer-to-switch-current-buffer (buffer-list)))
- (names (mapcar #'buffer-name buffers))
- (cands (all-completions string names pred))
- (nohid (seq-filter (lambda (cand)
- (not (or (string-empty-p cand)
- (eq (aref cand 0) ?\s))))
- cands)))
- (complete-with-action
- action (or (and (string-empty-p string) nohid) cands)
- string pred))))
+ (completion-table-with-metadata
+ (mapcar #'buffer-name
+ (remove read-buffer-to-switch-current-buffer (buffer-list)))
+ `((category . buffer)
+ (sort-function . identity)
+ (narrow-completions-function . minibuffer-narrow-buffer-completions)
+ (normal-predicate . completion-buffer-name-normal-predicate)
+ ,@(when completions-detailed
+ '((affixation-function . completion-buffer-name-affixation))))))
(define-obsolete-function-alias 'internal-complete-buffer-except
'completion-buffer-name-table "30.1")
(funcall func key hist)))
(concat (when exclude "not ") "previously used"))))
+(defun minibuffer-toggle-exceptional-candidates ()
+ "Toggle display of exceptional completion candidates."
+ (interactive nil minibuffer-mode)
+ (setq-local completions-exclude-exceptional-candidates
+ (not completions-exclude-exceptional-candidates))
+ (when (get-buffer-window "*Completions*" 0) (minibuffer-completion-help))
+ (minibuffer-message "Completion now %scludes exceptional canddiates"
+ (if completions-exclude-exceptional-candidates
+ "ex" "in")))
+
(defun minibuffer-widen-completions (&optional all)
"Remove restrictions on current minibuffer completions list.
(mapcar (lambda (desc)
(assoc desc desc-pred-alist))
(let ((enable-recursive-minibuffers t))
- (completing-read-multiple
- (format-prompt "Remove completions restrictions"
- (caar desc-pred-alist))
- desc-pred-alist nil t nil nil (caar desc-pred-alist)))))))
+ (completing-read-multiple
+ (format-prompt "Remove completions restrictions"
+ (caar desc-pred-alist))
+ desc-pred-alist nil t nil nil (caar desc-pred-alist)))))))
(when completion-auto-help (minibuffer-completion-help)))
(defcustom minibuffer-default-prompt-format " (default %s)"
/* If ALL_FLAG is 1, BESTMATCH is the list of all matches, decoded.
If ALL_FLAG is 0, BESTMATCH is either nil
or the best match so far, not decoded. */
- Lisp_Object bestmatch, tem, elt, name;
+ Lisp_Object bestmatch, name;
Lisp_Object encoded_file;
Lisp_Object encoded_dir;
bool directoryp;
- /* If not INCLUDEALL, exclude files in completion-ignored-extensions as
- well as "." and "..". Until shown otherwise, assume we can't exclude
- anything. */
- bool includeall = 1;
bool check_decoded = false;
specpdl_ref count = SPECPDL_INDEX ();
- elt = Qnil;
-
CHECK_STRING (file);
bestmatch = Qnil;
for (struct dirent *dp; (dp = read_dirent (d, dirname)); )
{
ptrdiff_t len = dirent_namelen (dp);
- bool canexclude = 0;
maybe_quit ();
name = make_unibyte_string (dp->d_name, len);
name = DECODE_FILE (name);
- ptrdiff_t name_blen = SBYTES (name), name_len = SCHARS (name);
if (completion_ignore_case
&& !BASE_EQ (Fcompare_strings (name, zero, file_len, file, zero,
file_len, Qt),
break;
}
- tem = Qnil;
- /* If all_flag is set, always include all.
- It would not actually be helpful to the user to ignore any possible
- completions when making a list of them. */
- if (!all_flag)
- {
- ptrdiff_t skip;
- Lisp_Object cmp_len = make_fixnum (name_len);
-
-#if 0 /* FIXME: The `scmp' call compares an encoded and a decoded string. */
- /* If this entry matches the current bestmatch, the only
- thing it can do is increase matchcount, so don't bother
- investigating it any further. */
- if (!completion_ignore_case
- /* The return result depends on whether it's the sole match. */
- && matchcount > 1
- && !includeall /* This match may allow includeall to 0. */
- && len >= bestmatchsize
- && 0 > scmp (dp->d_name, SSDATA (bestmatch), bestmatchsize))
- continue;
-#endif
-
- if (directoryp)
- {
-#ifndef TRIVIAL_DIRECTORY_ENTRY
-#define TRIVIAL_DIRECTORY_ENTRY(n) (!strcmp (n, ".") || !strcmp (n, ".."))
-#endif
- /* "." and ".." are never interesting as completions, and are
- actually in the way in a directory with only one file. */
- if (TRIVIAL_DIRECTORY_ENTRY (dp->d_name))
- canexclude = 1;
- else if (len > enc_file_len)
- /* Ignore directories if they match an element of
- completion-ignored-extensions which ends in a slash. */
- for (tem = Vcompletion_ignored_extensions;
- CONSP (tem); tem = XCDR (tem))
- {
- ptrdiff_t elt_len;
- char *p1;
-
- elt = XCAR (tem);
- if (!STRINGP (elt))
- continue;
- elt_len = SBYTES (elt) - 1; /* -1 for trailing / */
- if (elt_len <= 0)
- continue;
- p1 = SSDATA (elt);
- if (p1[elt_len] != '/')
- continue;
- skip = name_blen - elt_len;
- if (skip < 0)
- continue;
-
- if (!completion_ignore_case
- && scmp (SSDATA (name) + skip, p1, elt_len) >= 0)
- continue;
- if (completion_ignore_case)
- {
- elt_len = SCHARS (elt) - 1;
- skip = name_len - elt_len;
- cmp_len = make_fixnum (elt_len);
- if (skip < 0
- || !BASE_EQ (Fcompare_strings (name,
- make_fixnum (skip),
- Qnil,
- elt, zero, cmp_len,
- Qt),
- Qt))
- continue;
- }
- break;
- }
- }
- else
- {
- /* Compare extensions-to-be-ignored against end of this file name */
- /* if name is not an exact match against specified string */
- if (len > enc_file_len)
- /* and exit this for loop if a match is found */
- for (tem = Vcompletion_ignored_extensions;
- CONSP (tem); tem = XCDR (tem))
- {
- elt = XCAR (tem);
- if (!STRINGP (elt)) continue;
- ptrdiff_t elt_len = SBYTES (elt);
- skip = len - elt_len;
- if (skip < 0) continue;
-
- if (!completion_ignore_case
- && (scmp (SSDATA (name) + skip, SSDATA (elt), elt_len)
- >= 0))
- continue;
- if (completion_ignore_case)
- {
- elt_len = SCHARS (elt);
- skip = name_len - elt_len;
- cmp_len = make_fixnum (elt_len);
- if (skip < 0
- || !BASE_EQ (Fcompare_strings (name,
- make_fixnum (skip),
- Qnil,
- elt, zero, cmp_len,
- Qt),
- Qt))
- continue;
- }
- break;
- }
- }
-
- /* If an ignored-extensions match was found,
- don't process this name as a completion. */
- if (CONSP (tem))
- canexclude = 1;
-
- if (!includeall && canexclude)
- /* We're not including all files and this file can be excluded. */
- continue;
-
- if (includeall && !canexclude)
- { /* If we have one non-excludable file, we want to exclude the
- excludable files. */
- includeall = 0;
- /* Throw away any previous excludable match found. */
- bestmatch = Qnil;
- bestmatchsize = 0;
- matchcount = 0;
- }
- }
-
- Lisp_Object table = (completion_ignore_case ? Vascii_canon_table : Qnil);
-
/* This is a possible completion */
if (directoryp)
/* This completion is a directory; make it end with '/'. */
we're trying to complete, then we already know there's no
other completion, so there's no point looking any further. */
if (matchsize <= SCHARS (file)
- && !includeall /* A future match may allow includeall to 0. */
/* If completion-ignore-case is non-nil, don't
short-circuit because we want to find the best
possible match *including* case differences. */
defsubr (&Sfile_attributes_lessp);
defsubr (&Ssystem_users);
defsubr (&Ssystem_groups);
-
- DEFVAR_LISP ("completion-ignored-extensions", Vcompletion_ignored_extensions,
- doc: /* Completion ignores file names ending in any string in this list.
-It does not ignore them if all possible completions end in one of
-these strings or when displaying a list of completions.
-It ignores directory names if they match any string in this list which
-ends in a slash. */);
- Vcompletion_ignored_extensions = Qnil;
}
projects / emacs.git / commitdiff