From 3aae4bce55382b32a9666bd214b87e449171e3d6 Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Sun, 3 Mar 2024 16:57:26 +0100 Subject: [PATCH] Allow completion tables to designate normal/exceptional candidates Completion tables can now provide a "normal predicate" via the new 'normal-predicate' metadata entry. The normal predicate determines which candidates are normal and which are not. Non-normal candidates are called exceptional candidates, and, by default, they are excluded. However, if all possible completions are exceptional, we make an exception, and include exceptional completions, as they are all that remains. This generalizes and subsumes the existing mechanisms of 'completion-ignored-extensions' and the internal buffer-name filtering that read-buffer performs. We also provide a new minibuffer command 'C-x ~' to toggle inclusion of exceptional candidates interactively during completion. When exceptional candidates are included among normal candidates, we highlight the exceptions with a dedicated face. --- lisp/bindings.el | 49 --------- lisp/cus-start.el | 3 - lisp/files.el | 12 ++- lisp/minibuffer.el | 244 ++++++++++++++++++++++++++++++++------------- src/dired.c | 151 +--------------------------- src/minibuf.c | 4 +- 6 files changed, 184 insertions(+), 279 deletions(-) diff --git a/lisp/bindings.el b/lisp/bindings.el index b70b22532bd..816ca49319b 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -850,55 +850,6 @@ okay. See `mode-line-format'.") ;; not really a minor mode... (defining-kbd-macro mode-line-defining-kbd-macro))) -;; These variables are used by autoloadable packages. -;; They are defined here so that they do not get overridden -;; by the loading of those packages. - -;; Names in directory that end in one of these -;; are ignored in completion, -;; making it more likely you will get a unique match. -(setq 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")))) - ;; Suffixes used for executables. (setq exec-suffixes (cond diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 3fe62c8d0da..be24f1232b8 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -223,9 +223,6 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of :match (lambda (widget value) (and value (not (functionp value))))) (function :value ignore)))) - ;; dired.c - (completion-ignored-extensions dired - (repeat (string :format "%v"))) ;; dispnew.c (baud-rate display integer) (inverse-video display boolean) diff --git a/lisp/files.el b/lisp/files.el index 8bcce8e4971..bacb07f2a9f 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1020,11 +1020,13 @@ See `file-symlink-p' to distinguish symlinks." (defun load-file (file) "Load the Lisp file named FILE." ;; This is a case where .elc and .so/.dll make a lot of sense. - (interactive (list (let ((completion-ignored-extensions - (remove module-file-suffix - (remove ".elc" - completion-ignored-extensions)))) - (read-file-name "Load file: " nil nil 'lambda)))) + (interactive (list (minibuffer-with-setup-hook + (lambda () + (setq-local completion-ignored-extensions + (remove module-file-suffix + (remove ".elc" + completion-ignored-extensions)))) + (read-file-name "Load file: " nil nil 'lambda)))) (load (expand-file-name file) nil nil t)) (put 'load-file 'minibuffer-action "load") diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index d8fa1100c2f..df2f63f380b 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -38,9 +38,6 @@ ;;; 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 @@ -54,22 +51,6 @@ ;; - 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 @@ -80,7 +61,6 @@ ;; 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. @@ -1292,6 +1272,63 @@ styles that the completion category may prescribe.") (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 @@ -1304,6 +1341,7 @@ styles that the completion category may prescribe.") ;; 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 @@ -1323,14 +1361,28 @@ styles that the completion category may prescribe.") (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) @@ -2289,6 +2341,7 @@ completions." (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) @@ -2338,6 +2391,9 @@ completions." (:eval (symbol-name completions-style)) " "))) +(defvar completions-header-exceptional-candidates + '(completions-exceptional-candidates "~ ")) + (defvar completions-header-extra nil) (dolist (sym '(completions-header-count @@ -2346,6 +2402,7 @@ completions." completions-header-restriction completions-header-action completions-header-style + completions-header-exceptional-candidates completions-header-extra)) (put sym 'risky-local-variable t)) @@ -2354,7 +2411,7 @@ completions." 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) @@ -2646,6 +2703,10 @@ when you select this sort order." (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.") @@ -2654,6 +2715,11 @@ when you select this sort order." :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: @@ -2899,6 +2965,9 @@ completions list." (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 @@ -2908,6 +2977,7 @@ completions list." (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) @@ -2920,7 +2990,8 @@ completions list." (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)) @@ -2938,11 +3009,33 @@ completions list." 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 @@ -2957,8 +3050,7 @@ completions list." ('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 @@ -2993,6 +3085,7 @@ completions list." :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) @@ -3095,6 +3188,7 @@ PLIST is a property list with optional extra information about COMPLETIONS." 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 @@ -3466,6 +3560,7 @@ The completion method is determined by `completion-at-point-functions'." "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 @@ -3638,6 +3733,14 @@ same as `substitute-in-file-name'." "")))) 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 @@ -3645,6 +3748,7 @@ same as `substitute-in-file-name'." ((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) @@ -3906,15 +4010,6 @@ and `read-file-name-function'." 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 @@ -4179,32 +4274,29 @@ See `read-file-name' for the meaning of the arguments." '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") @@ -5663,6 +5755,16 @@ members of the minibuffer history list." (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. @@ -5696,10 +5798,10 @@ remove all current restrictions without prompting." (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)" diff --git a/src/dired.c b/src/dired.c index 0f2872c6470..fdb61426e05 100644 --- a/src/dired.c +++ b/src/dired.c @@ -499,19 +499,13 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag, /* 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; @@ -559,7 +553,6 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag, for (struct dirent *dp; (dp = read_dirent (d, dirname)); ) { ptrdiff_t len = dirent_namelen (dp); - bool canexclude = 0; maybe_quit (); @@ -572,7 +565,6 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag, 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), @@ -594,138 +586,6 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag, 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 '/'. */ @@ -814,7 +674,6 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag, 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. */ @@ -1169,12 +1028,4 @@ syms_of_dired (void) 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; } diff --git a/src/minibuf.c b/src/minibuf.c index d02e87e417b..d5cf8bd9f0f 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -1530,7 +1530,7 @@ behavior. */) CONSP (def) ? XCAR (def) : def); } - result = Fcompleting_read (prompt, intern ("completion-buffer-name-table"), + result = Fcompleting_read (prompt, call0 (Qcompletion_buffer_name_table), predicate, require_match, Qnil, Qbuffer_name_history, def, Qnil); } @@ -2189,6 +2189,8 @@ syms_of_minibuf (void) DEFSYM (Qcustom_variable_p, "custom-variable-p"); + DEFSYM (Qcompletion_buffer_name_table, "completion-buffer-name-table"); + /* Normal hooks for entry to and exit from minibuffer. */ DEFSYM (Qminibuffer_setup_hook, "minibuffer-setup-hook"); DEFSYM (Qminibuffer_exit_hook, "minibuffer-exit-hook"); -- 2.39.5