diff options
| -rw-r--r-- | README.md | 1 | ||||
| -rw-r--r-- | helm-comint.el | 18 | ||||
| -rw-r--r-- | helm-command.el | 19 | ||||
| -rw-r--r-- | helm-elisp-package.el | 5 | ||||
| -rw-r--r-- | helm-eshell.el | 118 | ||||
| -rw-r--r-- | helm-files.el | 10 | ||||
| -rw-r--r-- | helm-lib.el | 64 | ||||
| -rw-r--r-- | helm-mode.el | 439 | ||||
| -rw-r--r-- | helm-multi-match.el | 80 | ||||
| -rw-r--r-- | helm-source.el | 37 | ||||
| -rw-r--r-- | helm-types.el | 5 | ||||
| -rw-r--r-- | helm-utils.el | 16 | ||||
| -rw-r--r-- | helm.el | 124 |
13 files changed, 631 insertions, 305 deletions
@@ -1,4 +1,3 @@ -<!-- -*- html -*- --> <p align="center"> <a href="http://www.gnu.org/licenses/gpl-3.0.txt"><img src="https://img.shields.io/badge/license-GPL_3-green.svg" alt="License GPL 3" /></a> <a href="https://melpa.org/#/helm"><img alt="MELPA" src="https://melpa.org/packages/helm-badge.svg"/></a> diff --git a/helm-comint.el b/helm-comint.el index 953d8a76..2cfdbe63 100644 --- a/helm-comint.el +++ b/helm-comint.el @@ -47,12 +47,23 @@ :group 'helm-comint :type 'boolean) -(defcustom helm-comint-mode-list '(comint-mode slime-repl-mode) +(defcustom helm-comint-mode-list '(comint-mode slime-repl-mode sly-mrepl-mode) "Supported modes for prompt navigation. Derived modes (e.g. Geiser's REPL) are automatically supported." :group 'helm-comint :type '(repeat (choice symbol))) +(defcustom helm-comint-next-prompt-function '((sly-mrepl-mode . (lambda () + (sly-mrepl-next-prompt) + (point)))) + "Alist of (MODE . NEXT-PROMPT-FUNCTION) to use. + If the current major mode is a key in this list, the associated function will be + used to navigate the prompts. + The function must return the point after the prompt. + Otherwise (comint-next-prompt 1) will be used." + :group 'helm-comint + :type '(alist :key-type symbol :value-type function)) + (defcustom helm-comint-max-offset 400 "Max number of chars displayed per candidate in comint-input-ring browser. When `t', don't truncate candidate, show all. @@ -84,7 +95,10 @@ If BUFFER is nil, use current buffer." (goto-char (point-min)) (let (result (count 1)) (save-mark-and-excursion - (helm-awhile (and (not (eobp)) (comint-next-prompt 1)) + (helm-awhile (and (not (eobp)) + (helm-aif (alist-get major-mode helm-comint-next-prompt-function) + (funcall it) + (comint-next-prompt 1))) (push (list (buffer-substring-no-properties it (point-at-eol)) it (buffer-name) count) diff --git a/helm-command.el b/helm-command.el index 8b0cc99d..1212e140 100644 --- a/helm-command.el +++ b/helm-command.el @@ -51,7 +51,7 @@ This have no effect when `helm-M-x-use-completion-styles' is non nil" :group 'helm-command :type 'boolean) -(defcustom helm-M-x-use-completion-styles nil +(defcustom helm-M-x-use-completion-styles t "Use `completion-styles' in helm-M-x." :group 'helm-command :type 'boolean) @@ -144,9 +144,10 @@ fuzzy matching is running its own sort function with a different algorithm." (defun helm-M-x-transformer (candidates _source) "Transformer function for `helm-M-x' candidates." + ;; Generic sort function is handling helm-flex. (helm-M-x-transformer-1 candidates (null helm--in-fuzzy))) -(defun helm-M-x-transformer-hist (candidates _source) +(defun helm-M-x-transformer-no-sort (candidates _source) "Transformer function for `helm-M-x' candidates." (helm-M-x-transformer-1 candidates)) @@ -227,26 +228,32 @@ than the default which is OBARRAY." when (and c (commandp (intern c))) do (set-text-properties 0 (length c) nil c) and collect c)) + (minibuffer-completion-confirm t) (sources (and helm-M-x-use-completion-styles `(,(helm-build-sync-source "Emacs Commands history" :candidates (helm-dynamic-completion (or history extended-command-history) - #'commandp) + #'commandp + nil nil t) :match-dynamic t :requires-pattern helm-M-x-requires-pattern + :must-match t :persistent-action 'helm-M-x-persistent-action :persistent-help "Describe this command" :help-message 'helm-M-x-help-message :nomark t + :group 'helm-command :keymap helm-M-x-map :filtered-candidate-transformer - 'helm-M-x-transformer-hist) + 'helm-M-x-transformer-no-sort) ,(helm-build-sync-source "Emacs Commands" :candidates (helm-dynamic-completion - collection #'commandp) + collection #'commandp + nil nil t) :match-dynamic t :requires-pattern helm-M-x-requires-pattern + :must-match t :filtered-candidate-transformer 'helm-M-x-transformer :persistent-action @@ -302,7 +309,7 @@ than the default which is OBARRAY." :nomark t :candidates-in-buffer t :fc-transformer 'helm-M-x-transformer - :hist-fc-transformer 'helm-M-x-transformer-hist))) + :hist-fc-transformer 'helm-M-x-transformer-no-sort))) (cancel-timer tm) (setq helm--mode-line-display-prefarg nil))))) diff --git a/helm-elisp-package.el b/helm-elisp-package.el index 615bddf0..b3ee3272 100644 --- a/helm-elisp-package.el +++ b/helm-elisp-package.el @@ -51,6 +51,11 @@ (declare-function async-byte-recompile-directory "ext:async-bytecomp.el") (defun helm-el-package--init () + ;; In emacs-27 package-show-package-list returns an empty buffer + ;; until package-initialize have been called. + (unless (or package--initialized + (null (boundp 'package-quickstart))) + (package-initialize)) (let (package-menu-async (inhibit-read-only t)) (when (null package-alist) diff --git a/helm-eshell.el b/helm-eshell.el index ac7c9003..837c70ed 100644 --- a/helm-eshell.el +++ b/helm-eshell.el @@ -71,33 +71,6 @@ (defvar helm-eshell--quit-flag nil) -(defclass helm-esh-source (helm-source-sync) - ((init :initform (lambda () - (setq pcomplete-current-completions nil - pcomplete-last-completion-raw nil) - ;; Eshell-command add this hook in all minibuffers - ;; Remove it for the helm one. (Fixed in Emacs24) - (remove-hook 'minibuffer-setup-hook 'eshell-mode))) - (candidates :initform 'helm-esh-get-candidates) - ;(nomark :initform t) - (persistent-action :initform 'ignore) - (nohighlight :initform t) - (filtered-candidate-transformer - :initform - (lambda (candidates _sources) - (cl-loop - for i in candidates - collect - (cond ((string-match "\\`~/?" helm-ec-target) - (abbreviate-file-name i)) - ((string-match "\\`/" helm-ec-target) i) - (t - (file-relative-name i))) - into lst - finally return (sort lst 'helm-generic-sort-fn)))) - (action :initform 'helm-ec-insert)) - "Helm class to define source for Eshell completion.") - ;; Internal. (defvar helm-ec-target "") (defun helm-ec-insert (_candidate) @@ -132,6 +105,33 @@ The function that call this should set `helm-ec-target' to thing at point." "") " "))))) +(defun helm-esh-transformer (candidates _sources) + (cl-loop + for i in candidates + collect + (cond ((string-match "\\`~/?" helm-ec-target) + (abbreviate-file-name i)) + ((string-match "\\`/" helm-ec-target) i) + (t + (file-relative-name i))) + into lst + finally return (sort lst 'helm-generic-sort-fn))) + +(defclass helm-esh-source (helm-source-sync) + ((init :initform (lambda () + (setq pcomplete-current-completions nil + pcomplete-last-completion-raw nil) + ;; Eshell-command add this hook in all minibuffers + ;; Remove it for the helm one. (Fixed in Emacs24) + (remove-hook 'minibuffer-setup-hook 'eshell-mode))) + (candidates :initform 'helm-esh-get-candidates) + ;(nomark :initform t) + (persistent-action :initform 'ignore) + (nohighlight :initform t) + (filtered-candidate-transformer :initform #'helm-esh-transformer) + (action :initform 'helm-ec-insert)) + "Helm class to define source for Eshell completion.") + (defun helm-esh-get-candidates () "Get candidates for eshell completion using `pcomplete'." (catch 'pcompleted @@ -214,6 +214,41 @@ The function that call this should set `helm-ec-target' to thing at point." "Helm class to define source for Eshell history.") +(defun helm-esh-pcomplete-input (target users-comp last) + (if (and (stringp last) + (not (string= last "")) + (not users-comp) + ;; Fix completion on "../" see #1832. + (or (file-exists-p last) + (helm-aand + (file-name-directory last) + (file-directory-p it)))) + (if (and (file-directory-p last) + (string-match "\\`[~.]*.*/[.]\\'" target)) + ;; Fix completion on "~/.", "~/[...]/.", and "../." + (expand-file-name + (concat (helm-basedir (file-name-as-directory last)) + (regexp-quote (helm-basename target)))) + (expand-file-name last)) + ;; Don't add "~" to input to provide completion on all users instead of only + ;; on current $HOME (#1832). + (unless users-comp last))) + +(defun helm-esh-pcomplete-default-source () + "Make and return the default source for Eshell completion." + (helm-make-source "Eshell completions" 'helm-esh-source + :fuzzy-match helm-eshell-fuzzy-match)) + +(defvar helm-esh-pcomplete-build-source-fn #'helm-esh-pcomplete-default-source + "Function that builds a source or a list of sources.") + +(defun helm-esh-pcomplete--make-helm (&optional input) + (helm :sources (funcall helm-esh-pcomplete-build-source-fn) + :buffer "*helm pcomplete*" + :keymap helm-esh-completion-map + :resume 'noresume + :input input)) + ;;;###autoload (defun helm-esh-pcomplete () "Preconfigured helm to provide helm completion in eshell." @@ -265,33 +300,8 @@ The function that call this should set `helm-ec-target' to thing at point." (add-hook 'helm-quit-hook 'helm-eshell--quit-hook-fn) (with-helm-show-completion beg end (unwind-protect - (or (helm :sources (helm-make-source "Eshell completions" 'helm-esh-source - :fuzzy-match helm-eshell-fuzzy-match) - :buffer "*helm pcomplete*" - :keymap helm-esh-completion-map - :resume 'noresume - :input (if (and (stringp last) - (not (string= last "")) - (not users-comp) - ;; Fix completion on - ;; "../" see #1832. - (or (file-exists-p last) - (helm-aand - (file-name-directory last) - (file-directory-p it)))) - (if (and (file-directory-p last) - (string-match "\\`[~.]*.*/[.]\\'" target)) - ;; Fix completion on - ;; "~/.", "~/[...]/.", and "../." - (expand-file-name - (concat (helm-basedir (file-name-as-directory last)) - (regexp-quote (helm-basename target)))) - (expand-file-name last)) - ;; Don't add "~" to input to - ;; provide completion on all - ;; users instead of only on - ;; current $HOME (#1832). - (unless users-comp last))) + (or (helm-esh-pcomplete--make-helm + (helm-esh-pcomplete-input target users-comp last)) ;; Delete removed dot on quit (and del-dot (prog1 t (insert "."))) ;; A space is needed to have completion, remove diff --git a/helm-files.el b/helm-files.el index f7af9b36..1ca2b5c2 100644 --- a/helm-files.el +++ b/helm-files.el @@ -2256,12 +2256,15 @@ or when `helm-pattern' is equal to \"~/\"." ;; so use the root of current Drive. (i.e "C:/") (let* ((directory (and (memq system-type '(windows-nt ms-dos)) (getenv "SystemDrive"))) + (subst (helm-substitute-in-filename pattern)) ;; On Windows use a simple call to `expand-file-name' to ;; avoid Issue #2004. (expand-fn (if directory #'expand-file-name #'helm-ff--expand-file-name-no-dot))) - (funcall expand-fn (helm-substitute-in-filename pattern) + ;; Fix issue #2223 with tilde in directory names e.g. "~/tmp/~test/". + (funcall expand-fn (if (string-match-p "\\`~[^/]" subst) + pattern subst) ;; directory is nil on Nix. directory))) @@ -3211,8 +3214,9 @@ Return candidates prefixed with basename of `helm-input' first." . helm-find-files-byte-compile) ("Load File(s) `M-L'" . helm-find-files-load-files)) 2)) - ((string-match "\\.elc?\\'" (helm-aif (helm-marked-candidates) - (car it) candidate)) + ((string-match (concat (regexp-opt load-suffixes) "\\'") + (helm-aif (helm-marked-candidates) + (car it) candidate)) (helm-append-at-nth actions '(("Load File(s) `M-L'" . helm-find-files-load-files)) diff --git a/helm-lib.el b/helm-lib.el index 2fcf27e4..89161cea 100644 --- a/helm-lib.el +++ b/helm-lib.el @@ -49,7 +49,6 @@ (declare-function helm-interpret-value "helm.el") (declare-function helm-get-current-source "helm.el") (declare-function helm-source--cl--print-table "helm-source.el") - (defvar helm-sources) (defvar helm-initial-frame) (defvar helm-current-position) @@ -58,6 +57,7 @@ (defvar wdired-allow-to-change-permissions) (defvar wdired-allow-to-redirect-links) (defvar helm-persistent-action-display-window) +(defvar completion-flex-nospace) ;;; User vars. ;; @@ -1343,13 +1343,54 @@ I.e. when using `helm-next-line' and friends in BODY." (let (helm-follow-mode-persistent) (progn ,@body)))) -(defun helm-dynamic-completion (collection predicate &optional point metadata) +;; Completion styles related functions +;; +(defun helm--setup-completion-styles-alist () + (cl-pushnew '(helm helm-completion-try-completion + helm-completion-all-completions + "helm multi completion style.") + completion-styles-alist + :test 'equal) + (unless (assq 'flex completion-styles-alist) + ;; Add helm-fuzzy style only if flex is not available. + (cl-pushnew '(helm-flex helm-flex-completion-try-completion + helm-flex-completion-all-completions + "helm flex completion style.\nProvide flex matching for emacs-26.") + completion-styles-alist + :test 'equal))) + +(defun helm--prepare-completion-styles (&optional nomode) + "Return a suitable list of styles for `completion-styles'." + ;; For `helm-completion-style' and `helm-completion-styles-alist'. + (require 'helm-mode) + (if (memq helm-completion-style '(helm helm-fuzzy)) + ;; Keep default settings, but probably nil is fine as well. + '(basic partial-completion emacs22) + (or + (pcase (and (null nomode) + (cdr (assq major-mode helm-completion-styles-alist))) + (`(,_l . ,ll) ll)) + ;; We need to have flex always behind helm, otherwise + ;; when matching against e.g. '(foo foobar foao frogo bar + ;; baz) with pattern "foo" helm style if before flex will + ;; return foo and foobar only defeating flex that would + ;; return foo foobar foao and frogo. + (let* ((wflex (car (or (assq 'flex completion-styles-alist) + (assq 'helm-flex completion-styles-alist)))) + (styles (append (list wflex) (remove wflex completion-styles)))) + (helm-append-at-nth styles '(helm) (if wflex 1 0)))))) + +(defun helm-dynamic-completion (collection predicate &optional point metadata nomode) "Build a function listing the possible completions of `helm-pattern' in COLLECTION. + Only the elements of COLLECTION that satisfy PREDICATE are considered. -POINT and METADATA are unused for now. +Argument POINT is same as in `completion-all-completions' and is +meaningful only when using some kind of `completion-at-point'. The return value is a list of completions that may be sorted by the sort function provided by the completion-style in use (emacs-27 only), -otherwise (emacs-26) the sort function have to be provided if needed. +otherwise (emacs-26) the sort function have to be provided if needed +either with a FCT function in source or by passing the sort function +with METADATA e.g. (metadata (display-sort-function . foo)). Example: @@ -1360,17 +1401,18 @@ Example: :match-dynamic t) :buffer \"*helm test*\") -" +When argument NOMODE is non nil don't use `completion-styles' as +specified in `helm-completion-styles-alist'." (lambda () - ;; FIXME: not working with other old syles, see comment in - ;; helm-completion-in-region--fix-completion-styles. - (let* ((completion-styles (if (memq 'flex completion-styles) - '(flex helm) - '(helm))) + (let* ((completion-styles + (helm--prepare-completion-styles nomode)) + (completion-flex-nospace t) (compsfn (lambda (str pred _action) (let* ((comps (completion-all-completions str - collection + (if (functionp collection) + (funcall collection str predicate t) + collection) pred (or point 0) (or metadata '(metadata)))) diff --git a/helm-mode.el b/helm-mode.el index 51b7e7ab..3578936c 100644 --- a/helm-mode.el +++ b/helm-mode.el @@ -24,6 +24,8 @@ (defvar crm-separator) (defvar ido-everywhere) +(defvar completion-flex-nospace) + (declare-function ido-mode "ido.el") (defgroup helm-mode nil @@ -131,7 +133,7 @@ See `helm-case-fold-search' for more info." :group 'helm-mode :type 'symbol) -(defcustom helm-mode-reverse-history nil +(defcustom helm-mode-reverse-history t "Display history source after current source when non nil. Apply only in `helm-mode' handled commands." @@ -154,20 +156,24 @@ will be used." (defcustom helm-mode-fuzzy-match nil "Enable fuzzy matching in `helm-mode' globally. -This is deprecated, use instead helm-fuzzy `helm-completion-style' or -even better if you are using emacs-27 add flex style to -`completion-styles' and use emacs `helm-completion-style'." +This is deprecated, use instead helm-fuzzy as `helm-completion-style' or +even better 'emacs as `helm-completion-style' and add 'flex to +`completion-styles' (emacs-27) or 'helm-flex if 'flex is not available +in `completion-styles-alist' (emacs-26)." :group 'helm-mode :type 'boolean) (make-obsolete-variable 'helm-mode-fuzzy-match 'helm-completion-style "3.6.0") -(defcustom helm-mode-minibuffer-setup-hook-black-list '(minibuffer-completion-help) - "Incompatible `minibuffer-setup-hook' functions go here. -A list of symbols. -Helm-mode is rejecting all lambda's, byte-code fns -and all functions belonging in this list from `minibuffer-setup-hook'." +(defcustom helm-completion-mark-suffix t + "Push mark at end of suffix when non nil." :group 'helm-mode - :type '(repeat (choice symbol))) + :type 'boolean) + +(defvar helm-mode-minibuffer-setup-hook-black-list '(minibuffer-completion-help) + "Incompatible `minibuffer-setup-hook' functions go here. +A list of symbols. Helm-mode is rejecting all lambda's, byte-code fns +and all functions belonging in this list from `minibuffer-setup-hook'. +This is mainly needed to prevent \"*Completions*\" buffers to popup.") (defface helm-mode-prefix '((t (:background "red" :foreground "black"))) @@ -223,15 +229,27 @@ i.e. `helm-completing-read-default-handler'. NB: This have nothing to do with `completion-styles', it is independent to helm, but when using emacs as helm-completion-style helm will use the `completion-styles' for its completions. +Up to the user to configure `completion-styles'. There is three possible value to use: + - helm, use multi match regular helm completion. + - helm-fuzzy, use fuzzy matching, note that as usual when entering a space helm switch to multi matching mode. + - emacs, use regular emacs completion according to `completion-styles', note that even in this style, helm allows using - multi match. Emacs-27 provide a style called flex that can be used - aside helm style (see `completion-styles-alist'). + multi match. Emacs-27 provide a style called `flex' that can be used + aside `helm' style (see `completion-styles-alist'). When `flex' style + is not available (Emacs<27) helm provide `helm-flex' style which is similar to + `flex' and helm fuzzy matching. + +For a better experience, if you don't know what to use, set +`completion-styles' to '(flex) if you are using emacs-27 or to +\'(helm-flex) if you are using emacs-26 and keep 'emacs as default +value for `helm-completion-style'. Advanced users can also have a +look to `completion-category-overrides' to set styles according to category. Please use custom interface or `customize-set-variable' to set this, NOT `setq'." @@ -245,14 +263,41 @@ NOT `setq'." (define-key helm-comp-read-map (kbd "DEL") 'helm-mode-delete-char-backward-maybe) (define-key helm-comp-read-map (kbd "DEL") 'delete-backward-char)))) +(defconst helm-completion--all-styles + (let ((flex (if (assq 'flex completion-styles-alist) + 'flex 'helm-flex))) + (helm-fast-remove-dups + (append (list 'helm flex) + (mapcar 'car completion-styles-alist))))) + +(defconst helm-completion--styles-type + `(repeat :tag "with other completion styles" + (choice ,@(mapcar (lambda (x) (list 'const x)) + helm-completion--all-styles)))) + (defcustom helm-completion-styles-alist '((gud-mode . helm)) "Allow configuring `helm-completion-style' per mode. Each entry is a cons cell like (mode . style) where style must be a -suitable value for `helm-completion-style'." +suitable value for `helm-completion-style'. +When specifying emacs as style for a mode, `completion-styles' can be +specified by using a cons cell specifying completion-styles to use +with helm emacs style, e.g. (foo-mode . (emacs helm flex)) will set +`completion-styles' to '(helm flex) for foo-mode, this affect only +completions happening in buffers and not minibuffer completions, +i.e. completing-read's." :group 'helm-mode - :type '(alist :key-type (symbol :tag "Mode") - :value-type (symbol :tag "Style"))) + :type + `(alist :key-type (symbol :tag "Major Mode") + :value-type + (choice :tag "Use helm style or completion styles" + (radio :tag "Helm Style" + (const helm) + (const helm-fuzzy) + (const emacs)) + (cons :tag "Completion Styles" + (const :tag "Using Helm `emacs' style" emacs) + ,helm-completion--styles-type)))) ;;; helm-comp-read ;; @@ -584,20 +629,7 @@ that use `helm-comp-read' See `helm-M-x' for example." (if ,marked-candidates (helm-marked-candidates) (identity candidate))))))) - ;; Assume completion have been already required, - ;; so always use 'confirm. - (when (eq must-match 'confirm-after-completion) - (setq must-match 'confirm)) (let* ((minibuffer-completion-confirm must-match) - (must-match-map (when must-match - (let ((map (make-sparse-keymap))) - (define-key map (kbd "RET") - 'helm-confirm-and-exit-minibuffer) - map))) - (loc-map (if must-match-map - (make-composed-keymap - must-match-map (or keymap helm-map)) - (or keymap helm-map))) (minibuffer-completion-predicate test) (minibuffer-completion-table collection) (helm-read-file-name-mode-line-string @@ -639,7 +671,8 @@ that use `helm-comp-read' See `helm-M-x' for example." (and hist-fc-transformer (helm-mklist hist-fc-transformer))) :persistent-action persistent-action :persistent-help persistent-help - :keymap loc-map + :keymap keymap + :must-match must-match :group group :mode-line mode-line :help-message help-message @@ -658,7 +691,8 @@ that use `helm-comp-read' See `helm-M-x' for example." :persistent-action persistent-action :persistent-help persistent-help :fuzzy-match fuzzy - :keymap loc-map + :keymap keymap + :must-match must-match :group group :mode-line mode-line :match-dynamic match-dynamic @@ -676,7 +710,8 @@ that use `helm-comp-read' See `helm-M-x' for example." :requires-pattern requires-pattern :persistent-action persistent-action :fuzzy-match fuzzy - :keymap loc-map + :keymap keymap + :must-match must-match :group group :persistent-help persistent-help :mode-line mode-line @@ -702,7 +737,7 @@ that use `helm-comp-read' See `helm-M-x' for example." :preselect preselect :prompt prompt :resume 'noresume - :keymap loc-map ;; Needed with empty collection. + :keymap keymap ;; Needed with empty collection. :allow-nest allow-nest :candidate-number-limit candidate-number-limit :case-fold-search case-fold @@ -833,10 +868,14 @@ This handler use dynamic matching which allow honouring `completion-styles'." ((pred (stringp)) init) ;; INIT is a cons cell. (`(,l . ,_ll) l))) - (completion-styles (helm-completion-in-region--fix-completion-styles)) - (metadata (or (and input predicate - (completion-metadata input collection predicate)) + (completion-flex-nospace t) + (completion-styles + (helm--prepare-completion-styles 'nomode)) + (metadata (or (completion-metadata (or input "") collection predicate) '(metadata))) + (afun (or (plist-get completion-extra-properties :annotation-function) + (completion-metadata-get metadata 'annotation-function))) + (file-comp-p (eq (completion-metadata-get metadata 'category) 'file)) (compfn (lambda (str _predicate _action) (let* ((comps (completion-all-completions @@ -848,12 +887,21 @@ This handler use dynamic matching which allow honouring `completion-styles'." (last-data (last comps)) ;; Helm syle sort fn is added to ;; metadata only in emacs-27, so in - ;; emacs-26 sort-fn is always nil - ;; and sorting will be done + ;; emacs-26 use helm-generic-sort-fn + ;; which handle both helm and + ;; helm-flex styles. When + ;; helm-completion-style is helm or + ;; helm-fuzzy, sorting will be done ;; later in FCT. - (sort-fn (and (eq helm-completion-style 'emacs) - (completion-metadata-get - metadata 'display-sort-function))) + (sort-fn + (and (eq helm-completion-style 'emacs) + (or + ;; Emacs-27 + (completion-metadata-get + metadata 'display-sort-function) + ;; Emacs-26 + (lambda (candidates) + (sort candidates #'helm-generic-sort-fn))))) all) (when (cdr last-data) ;; Remove the last element of @@ -873,7 +921,9 @@ This handler use dynamic matching which allow honouring `completion-styles'." (append (and default (memq helm-completion-style '(helm helm-fuzzy)) (list default)) - (if sort-fn (funcall sort-fn all) all))))) + (helm-completion-in-region--initial-filter + (if sort-fn (funcall sort-fn all) all) + afun file-comp-p))))) (data (if (memq helm-completion-style '(helm helm-fuzzy)) (funcall compfn (or input "") nil nil) compfn)) @@ -1113,10 +1163,6 @@ Keys description: (require 'tramp) (when (get-buffer helm-action-buffer) (kill-buffer helm-action-buffer)) - ;; Assume completion have been already required, - ;; so always use 'confirm. - (when (eq must-match 'confirm-after-completion) - (setq must-match 'confirm)) (mapc (lambda (hook) (add-hook 'helm-after-update-hook hook)) '(helm-ff-move-to-first-real-candidate @@ -1139,19 +1185,6 @@ Keys description: history nil nil alistp))) (minibuffer-completion-confirm must-match) (helm-ff--RET-disabled noret) - (must-match-map (when must-match - (let ((map (make-sparse-keymap))) - (define-key map (kbd "RET") - (let ((fn (lookup-key helm-read-file-map (kbd "RET")))) - (if (and (eq fn 'helm-ff-RET) - (null helm-ff--RET-disabled)) - #'helm-ff-RET-must-match - #'helm-confirm-and-exit-minibuffer))) - map))) - (cmap (if must-match-map - (make-composed-keymap - must-match-map helm-read-file-map) - helm-read-file-map)) (minibuffer-completion-predicate test) (minibuffer-completing-file-name t) (helm--completing-file-name t) @@ -1172,7 +1205,8 @@ Keys description: :fuzzy-match fuzzy :persistent-action-if persistent-action-if :persistent-help persistent-help - :keymap cmap + :keymap helm-read-file-map + :must-match must-match :nomark nomark :action action-fn) ;; Other source. @@ -1206,7 +1240,8 @@ Keys description: :persistent-action-if persistent-action-if :persistent-help persistent-help :volatile t - :keymap cmap + :keymap helm-read-file-map + :must-match must-match :cleanup 'helm-find-files-cleanup :nomark nomark :action action-fn))) @@ -1398,6 +1433,35 @@ The `helm-find-files' history `helm-ff-history' is used here." (propertize str 'read-only t 'face 'helm-mode-prefix 'rear-nonsticky t) str)) +(defun helm-completion-in-region--initial-filter (comps afun file-comp-p) + "Add annotations at end of candidates and filter out dot files." + (if file-comp-p + ;; Filter out dot files in file completion. + (cl-loop for f in comps unless + (string-match "\\`\\.\\{1,2\\}/\\'" f) + collect f) + (if afun + ;; Add annotation at end of + ;; candidate if needed, e.g. foo<f>, this happen when + ;; completing against a quoted symbol. + (mapcar (lambda (s) + (let ((ann (funcall afun s))) + (if ann + (cons + (concat + s + (propertize + " " 'display + (propertize + ann + 'face 'completions-annotations))) + s) + s))) + comps) + comps))) + +;; Helm multi matching style + (defun helm-completion-try-completion (string table pred point) "The try completion function for `completing-styles-alist'. Actually do nothing." @@ -1418,10 +1482,13 @@ Actually do nothing." (defun helm-completion--multi-all-completions-1 (string collection &optional predicate) "Allow `all-completions' multi matching on its candidates." - (all-completions "" collection (lambda (x) + (all-completions "" collection (lambda (x &optional _y) + ;; Second arg _y is needed when + ;; COLLECTION is a hash-table issue + ;; #2231 (C-x 8 RET). ;; Elements of collection may be - ;; lists, in this case consider the - ;; car of element #2219. + ;; lists or alists, in this case consider the + ;; car of element issue #2219 (org-refile). (let ((elm (if (listp x) (car x) x))) (if predicate (and (funcall predicate elm) @@ -1438,101 +1505,133 @@ Actually do nothing." (all (helm-completion--multi-all-completions-1 string table pred))) (list all string prefix suffix point))) -(defun helm-completion-in-region--initial-filter (comps afun file-comp-p) - "Add annotations at end of candidates and filter out dot files." - (if file-comp-p - ;; Filter out dot files in file completion. - (cl-loop for f in comps unless - (string-match "\\`\\.\\{1,2\\}/\\'" f) - collect f) - (if afun - ;; Add annotation at end of - ;; candidate if needed, e.g. foo<f>, this happen when - ;; completing against a quoted symbol. - (mapcar (lambda (s) - (let ((ann (funcall afun s))) - (if ann - (cons - (concat - s - (propertize - " " 'display - (propertize - ann - 'face 'completions-annotations))) - s) - s))) - comps) - comps))) - -;; Setup completion styles for helm-mode -(defun helm-mode--setup-completion-styles () - (cl-pushnew '(helm helm-completion-try-completion - helm-completion-all-completions - "helm completion style.") - completion-styles-alist - :test 'equal)) - -(defun helm-mode--disable-completion-styles () - (setq completion-styles-alist - (delete (assq 'helm completion-styles-alist) - completion-styles-alist))) - -(defun helm-completion-in-region--fix-completion-styles () - "Add helm style to `completion-styles' and filter out incompatibles styles." - (if (memq helm-completion-style '(helm helm-fuzzy)) - '(basic partial-completion emacs22) - ;; FIXME: When merging helm with other old styles (basic - ;; partial-completion emacs22) helm is matching fine but if it - ;; doesn't match, the other styles match all, this happen with - ;; helm-completion-dynamic but not here (at least I couldn't reproduce). - (if (memq 'flex completion-styles) - ;; We need to have flex always behind helm, otherwise - ;; when matching against e.g. '(foo foobar foao frogo bar - ;; baz) with pattern "foo" helm style if before flex will - ;; return foo and foobar only defeating flex that would - ;; return foo foobar foao and frogo. - '(flex helm) - '(helm)))) - +;; The adjust-metadata functions run only in emacs-27, they are NOT +;; used otherwise. (defun helm-completion--adjust-metadata (metadata) (if (memq helm-completion-style '(helm helm-fuzzy)) metadata - (cl-flet ((compose-helm-sort-fn - () - (lambda (candidates) - (let ((res candidates)) - (sort res #'helm-generic-sort-fn))))) - (let ((alist (cdr metadata))) - (helm-aif (assq 'display-sort-function alist) - (setq alist (remove it alist))) - `(metadata . ,(cons - (cons 'display-sort-function - (compose-helm-sort-fn)) - alist)))))) + (let ((compose-helm-sort-fn + (lambda (candidates) + (sort candidates #'helm-generic-sort-fn)))) + `(metadata + (display-sort-function + . ,compose-helm-sort-fn) + (cycle-sort-function + . ,compose-helm-sort-fn) + ,@(cdr metadata))))) (put 'helm 'completion--adjust-metadata 'helm-completion--adjust-metadata) -(defun helm--completion-in-region (start end collection &optional predicate) - "Helm replacement of `completion--in-region'. +;; Helm-flex style. -Can be used for `completion-in-region-function' by advicing it with an -:around advice to allow passing the old -`completion-in-region-function' value in ORIGFUN." +(defun helm-flex-completion-try-completion (string table pred point) + "The try completion function for `completing-styles-alist'. +Actually do nothing." + ;; AFAIU the try completion function is here to handle single + ;; element completion, in this case it throw this element without + ;; popping up *completions* buffer. If that's the case we don't need + ;; this because helm already handle this with + ;; `helm-execute-action-at-once-if-one', so returning unconditionaly + ;; nil should be fine. + (ignore string table pred point)) + +(defun helm-flex-completion-all-completions (string table pred point) + "The all completions function for `completing-styles-alist'." + ;; FIXME: No need to bind all these value. + (cl-multiple-value-bind (all pattern prefix _suffix _carbounds) + (helm-completion--flex-all-completions string table pred point) + (let ((regexp (completion-pcm--pattern->regex pattern 'group))) + (when all (nconc (helm-flex-add-score-as-prop all regexp) + (length prefix)))))) + +(defun helm-flex-add-score-as-prop (candidates regexp) + (cl-loop for cand in candidates + collect (helm-flex--style-score cand regexp))) + +(defun helm-completion--flex-all-completions-1 (_string collection &optional predicate) + "Allow `all-completions' multi matching on its candidates." + (all-completions "" collection (lambda (x &optional _y) + ;; Elements of collection may be + ;; lists, in this case consider the + ;; car of element #2219. + (let ((elm (if (listp x) (car x) x))) + (if predicate + (and (funcall predicate elm) + (helm-flex-style-match (helm-stringify elm))) + (helm-flex-style-match (helm-stringify elm))))))) + +(defun helm-completion--flex-transform-pattern (pattern) + ;; "fob" => '(prefix "f" any "o" any "b" any point) + (cl-loop for p in pattern + if (stringp p) nconc + (cl-loop for str across p + nconc (list (string str) 'any)) + else nconc (list p))) + +;; FIXME: POINT is still wrong in some cases e.g. completing against +;; "def" should return "defun" on top, it returns actually "defun*" +;; the helm style though return "defun" on top as expected. Flex with +;; emacs-27 also is correct, it returns "defun" as well. +(defun helm-completion--flex-all-completions (string table pred point) + "Collect completions from TABLE for helm completion style." + (let* ((beforepoint (substring string 0 point)) + (afterpoint (substring string point)) + (bounds (completion-boundaries beforepoint table pred afterpoint)) + (prefix (substring beforepoint 0 (car bounds))) + (suffix (substring afterpoint (cdr bounds))) + (basic-pattern (completion-basic--pattern + beforepoint afterpoint bounds)) + (pattern (if (not (stringp (car basic-pattern))) + basic-pattern + (cons 'prefix basic-pattern))) + (pattern (helm-completion--flex-transform-pattern pattern)) + (all (helm-completion--flex-all-completions-1 string table pred))) + (list all pattern prefix suffix point))) + +;; This is usable only in emacs-27, but in emacs-27 we prefer +;; using flex so this code is unused in both emacs-26 and 27. + +;; (defun helm-flex-completion--adjust-metadata (metadata) +;; (if (memq helm-completion-style '(helm helm-fuzzy)) +;; metadata +;; (cl-flet ((compose-helm-sort-fn +;; () +;; (lambda (candidates) +;; (sort +;; candidates +;; (lambda (c1 c2) +;; (let ((s1 (get-text-property 0 'completion-score c1)) +;; (s2 (get-text-property 0 'completion-score c2))) +;; (> (or s1 0) (or s2 0)))))))) +;; `(metadata +;; (display-sort-function +;; . ,(compose-helm-sort-fn)) +;; (cycle-sort-function +;; . ,(compose-helm-sort-fn)) +;; ,@(cdr metadata))))) +;; (put 'helm-flex 'completion--adjust-metadata 'helm-flex-completion--adjust-metadata) + +(defun helm--completion-in-region (start end collection &optional predicate) + "Helm replacement of `completion--in-region'." (cl-declare (special require-match prompt)) (advice-add 'lisp--local-variables :around #'helm-mode--advice-lisp--local-variables) (let ((old--helm-completion-style helm-completion-style)) (helm-aif (cdr (assq major-mode helm-completion-styles-alist)) - (customize-set-variable 'helm-completion-style it)) + (customize-set-variable 'helm-completion-style + (if (cdr-safe it) (car it) it))) (unwind-protect (let* ((enable-recursive-minibuffers t) - (completion-styles (helm-completion-in-region--fix-completion-styles)) + (completion-flex-nospace t) + (completion-styles (helm--prepare-completion-styles)) (input (buffer-substring-no-properties start end)) - ;; FIXME: Should I use prefix instead of input for - ;; initial completion? And use input for final insertion? - (prefix (and (eq helm-completion-style 'emacs) - (buffer-substring-no-properties start (point)))) + ;; Always start with prefix to allow completing without + ;; the need of inserting a space after cursor or + ;; relaying on crap old completion-styles emacs22 which + ;; add suffix after prefix. e.g. def|else. + (initial-input (buffer-substring-no-properties start (point))) + (prefix (and (eq helm-completion-style 'emacs) initial-input)) + (point (point)) (current-command (or (helm-this-command) this-command)) (crm (eq current-command 'crm-complete)) (str-command (helm-symbol-name current-command)) @@ -1544,13 +1643,14 @@ Can be used for `completion-in-region-function' by advicing it with an ;; completion-at-point or friend, so use a non--nil ;; value for require-match. (not (boundp 'prompt)))) + (metadata (completion-metadata input collection predicate)) ;; `completion-extra-properties' is let-bounded in `completion-at-point'. ;; `afun' is a closure to call against each string in `data'. ;; it provide the annotation info for each string. ;; e.g "foo" => "foo <f>" where foo is a function. ;; See Issue #407. - (afun (plist-get completion-extra-properties :annotation-function)) - (metadata (completion-metadata input collection predicate)) + (afun (or (plist-get completion-extra-properties :annotation-function) + (completion-metadata-get metadata 'annotation-function))) (init-space-suffix (unless (or (memq helm-completion-style '(helm-fuzzy emacs)) (string-suffix-p " " input) (string= input "")) @@ -1583,12 +1683,21 @@ Can be used for `completion-in-region-function' by advicing it with an 0)) ;; Helm syle sort fn is added to ;; metadata only in emacs-27, so in - ;; emacs-26 sort-fn is always nil - ;; and sorting will be done + ;; emacs-26 use helm-generic-sort-fn + ;; which handle both helm and + ;; helm-flex styles. When + ;; helm-completion-style is helm or + ;; helm-fuzzy, sorting will be done ;; later in FCT. - (sort-fn (and (eq helm-completion-style 'emacs) - (completion-metadata-get - metadata 'display-sort-function))) + (sort-fn + (and (eq helm-completion-style 'emacs) + (or + ;; Emacs-27 + (completion-metadata-get + metadata 'display-sort-function) + ;; Emacs-26 + (lambda (candidates) + (sort candidates #'helm-generic-sort-fn))))) all) ;; Reset prefix to allow using length of ;; helm-pattern on next calls (this avoid @@ -1621,17 +1730,18 @@ Can be used for `completion-in-region-function' by advicing it with an :marked-candidates crm :initial-input (cond ((and file-comp-p - (not (string-match "/\\'" input))) + (not (string-match "/\\'" initial-input))) (concat (helm-mode--completion-in-region-initial-input (if (memq helm-completion-style '(helm helm-fuzzy)) - (helm-basename input) - input)) + (helm-basename initial-input) + initial-input)) init-space-suffix)) - ((string-match "/\\'" input) input) + ((string-match "/\\'" initial-input) + (and (eq helm-completion-style 'emacs) initial-input)) ((or (null require-match) (stringp require-match)) - (helm-mode--completion-in-region-initial-input input)) - (t (concat (helm-mode--completion-in-region-initial-input input) + (helm-mode--completion-in-region-initial-input initial-input)) + (t (concat (helm-mode--completion-in-region-initial-input initial-input) init-space-suffix))) :buffer buf-name :fc-transformer @@ -1651,18 +1761,25 @@ Can be used for `completion-in-region-function' by advicing it with an (message "[No matches]"))) t) ; exit minibuffer immediately. :must-match require-match)))) - (helm-completion-in-region--insert-result result start end base-size)) + (helm-completion-in-region--insert-result result start point end base-size)) (customize-set-variable 'helm-completion-style old--helm-completion-style) (setq helm-completion--sorting-done nil) (advice-remove 'lisp--local-variables #'helm-mode--advice-lisp--local-variables)))) -(defun helm-completion-in-region--insert-result (result start end base-size) +(defun helm-completion-in-region--insert-result (result start point end base-size) (cond ((stringp result) (choose-completion-string result (current-buffer) - (list (+ start base-size) end) - completion-list-insert-choice-function)) + (list (+ start base-size) point) + completion-list-insert-choice-function) + (when helm-completion-mark-suffix + (run-with-idle-timer 0.01 nil + (lambda () + (helm-aand + (+ (- (point) point) end) + (and (> it (point)) it) + (push-mark it t t)))))) ((consp result) ; crm. (let ((beg (+ start base-size)) (sep ",")) @@ -1730,7 +1847,6 @@ Note: This mode is incompatible with Emacs23." #'helm--generic-read-buffer) (add-function :override completion-in-region-function #'helm--completion-in-region) - (helm-mode--setup-completion-styles) ;; If user have enabled ido-everywhere BEFORE enabling ;; helm-mode disable it and warn user about its ;; incompatibility with helm-mode (issue #2085). @@ -1749,7 +1865,6 @@ Note: This mode is incompatible with Emacs23." (remove-function read-file-name-function #'helm--generic-read-file-name) (remove-function read-buffer-function #'helm--generic-read-buffer) (remove-function completion-in-region-function #'helm--completion-in-region) - (helm-mode--disable-completion-styles) (remove-hook 'ido-everywhere-hook #'helm-mode--ido-everywhere-hook) (when (fboundp 'ffap-read-file-or-url-internal) (advice-remove 'ffap-read-file-or-url #'helm-advice--ffap-read-file-or-url))))) diff --git a/helm-multi-match.el b/helm-multi-match.el index e5d3c9da..591a1e94 100644 --- a/helm-multi-match.el +++ b/helm-multi-match.el @@ -98,13 +98,13 @@ If GREP-SPACE is used translate escaped space to \"\\s\" instead of \"\\s-\"." helm-mm-exact-pattern-real) -(cl-defun helm-mm-exact-match (str &optional (pattern helm-pattern)) +(cl-defun helm-mm-exact-match (candidate &optional (pattern helm-pattern)) (if case-fold-search (progn - (setq str (downcase str) + (setq candidate (downcase candidate) pattern (downcase pattern)) - (string= str pattern)) - (string= str pattern))) + (string= candidate pattern)) + (string= candidate pattern))) (defun helm-mm-exact-search (pattern &rest _ignore) (and (search-forward (helm-mm-exact-get-pattern pattern) nil t) @@ -124,14 +124,14 @@ If GREP-SPACE is used translate escaped space to \"\\s\" instead of \"\\s-\"." helm-mm-prefix-pattern-real (concat "\n" pattern))) helm-mm-prefix-pattern-real) -(defun helm-mm-prefix-match (str &optional pattern) +(defun helm-mm-prefix-match (candidate &optional pattern) ;; In filename completion basename and basedir may be ;; quoted, unquote them for string comparison (Issue #1283). (setq pattern (replace-regexp-in-string "\\\\" "" (or pattern helm-pattern))) (let ((len (length pattern))) - (and (<= len (length str)) - (string= (substring str 0 len) pattern )))) + (and (<= len (length candidate)) + (string= (substring candidate 0 len) pattern )))) (defun helm-mm-prefix-search (pattern &rest _ignore) (search-forward (helm-mm-prefix-get-pattern pattern) nil t)) @@ -151,8 +151,8 @@ If GREP-SPACE is used translate escaped space to \"\\s\" instead of \"\\s-\"." (concat "^" (helm-mm-1-make-regexp pattern)))) helm-mm-1-pattern-real) -(cl-defun helm-mm-1-match (str &optional (pattern helm-pattern)) - (string-match (helm-mm-1-get-pattern pattern) str)) +(cl-defun helm-mm-1-match (candidate &optional (pattern helm-pattern)) + (string-match (helm-mm-1-get-pattern pattern) candidate)) (defun helm-mm-1-search (pattern &rest _ignore) (re-search-forward (helm-mm-1-get-pattern pattern) nil t)) @@ -172,8 +172,8 @@ If GREP-SPACE is used translate escaped space to \"\\s\" instead of \"\\s-\"." (concat "^.*" (helm-mm-1-make-regexp pattern)))) helm-mm-2-pattern-real) -(cl-defun helm-mm-2-match (str &optional (pattern helm-pattern)) - (string-match (helm-mm-2-get-pattern pattern) str)) +(cl-defun helm-mm-2-match (candidate &optional (pattern helm-pattern)) + (string-match (helm-mm-2-get-pattern pattern) candidate)) (defun helm-mm-2-search (pattern &rest _ignore) (re-search-forward (helm-mm-2-get-pattern pattern) nil t)) @@ -183,38 +183,39 @@ If GREP-SPACE is used translate escaped space to \"\\s\" instead of \"\\s-\"." ;; ;; ;; Internal -(defvar helm-mm-3-pattern-str nil) -(defvar helm-mm-3-pattern-list nil) +(defvar helm-mm--3-pattern-str nil) +(defvar helm-mm--3-pattern-list nil) (defun helm-mm-3-get-patterns (pattern) - "Return `helm-mm-3-pattern-list', a list of predicate/regexp cons cells. -e.g ((identity . \"foo\") (identity . \"bar\")). -This is done only if `helm-mm-3-pattern-str' is same as PATTERN." - (unless (equal pattern helm-mm-3-pattern-str) - (setq helm-mm-3-pattern-str pattern - helm-mm-3-pattern-list + "Returns a list of predicate/regexp cons cells. +e.g. ((identity . \"foo\") (not . \"bar\")). +If PATTERN is inchanged, don't recompute PATTERN and return the +previous value stored in `helm-mm--3-pattern-list'." + (unless (equal pattern helm-mm--3-pattern-str) + (setq helm-mm--3-pattern-str pattern + helm-mm--3-pattern-list (helm-mm-3-get-patterns-internal pattern))) - helm-mm-3-pattern-list) + helm-mm--3-pattern-list) (defun helm-mm-3-get-patterns-internal (pattern) "Return a list of predicate/regexp cons cells. -e.g ((identity . \"foo\") (identity . \"bar\"))." +e.g. ((identity . \"foo\") (not . \"bar\"))." (unless (string= pattern "") (cl-loop for pat in (helm-mm-split-pattern pattern) collect (if (string= "!" (substring pat 0 1)) (cons 'not (substring pat 1)) (cons 'identity pat))))) -(cl-defun helm-mm-3-match (str &optional (pattern helm-pattern)) - "Check if PATTERN match STR. +(cl-defun helm-mm-3-match (candidate &optional (pattern helm-pattern)) + "Check if PATTERN match CANDIDATE. When PATTERN contain a space, it is splitted and matching is done -with the several resulting regexps against STR. +with the several resulting regexps against CANDIDATE. e.g \"bar foo\" will match \"foobar\" and \"barfoo\". Argument PATTERN, a string, is transformed in a list of cons cell with `helm-mm-3-get-patterns' if it contain a space. e.g \"foo bar\"=>((identity . \"foo\") (identity . \"bar\")). Then each predicate of cons cell(s) is called with regexp of same -cons cell against STR (a candidate). +cons cell against CANDIDATE. i.e (identity (string-match \"foo\" \"foo bar\")) => t." (let ((pat (helm-mm-3-get-patterns pattern))) (cl-loop for (predicate . regexp) in pat @@ -223,7 +224,7 @@ i.e (identity (string-match \"foo\" \"foo bar\")) => t." ;; FIXME: Probably do nothing when ;; using fuzzy leaving the job ;; to the fuzzy fn. - (string-match regexp str) + (string-match regexp candidate) (invalid-regexp nil)))))) (defun helm-mm-3-search-base (pattern searchfn1 searchfn2) @@ -260,7 +261,7 @@ i.e (identity (re-search-forward \"foo\" (point-at-eol) t)) => t." pattern 're-search-forward 're-search-forward)) ;;; mp-3 with migemo -;; +;; Needs https://github.com/emacs-jp/migemo ;; (defvar helm-mm--previous-migemo-info nil "[Internal] Cache previous migemo query.") @@ -298,10 +299,10 @@ i.e the sources which have the slot :migemo with non--nil value." helm-mm--previous-migemo-info)))) (string-match (assoc-default pattern helm-mm--previous-migemo-info) str)) -(cl-defun helm-mm-3-migemo-match (str &optional (pattern helm-pattern)) +(cl-defun helm-mm-3-migemo-match (candidate &optional (pattern helm-pattern)) (and helm-migemo-mode (cl-loop for (pred . re) in (helm-mm-3-get-patterns pattern) - always (funcall pred (helm-mm-migemo-string-match re str))))) + always (funcall pred (helm-mm-migemo-string-match re candidate))))) (defun helm-mm-migemo-forward (word &optional bound noerror count) (with-helm-buffer @@ -323,16 +324,17 @@ i.e the sources which have the slot :migemo with non--nil value." ;;; mp-3p- (multiple regexp pattern 3 with prefix search) ;; ;; -(defun helm-mm-3p-match (str &optional pattern) - "Check if PATTERN match STR. -Same as `helm-mm-3-match' but more strict, matching against prefix also. -e.g \"bar foo\" will match \"barfoo\" but not \"foobar\" contrarily to -`helm-mm-3-match'." +(defun helm-mm-3p-match (candidate &optional pattern) + "Check if PATTERN match CANDIDATE. +Same as `helm-mm-3-match' but only for the cdr of patterns, the car of +patterns must always match CANDIDATE prefix. +e.g \"bar foo baz\" will match \"barfoobaz\" or \"barbazfoo\" but not +\"foobarbaz\" whereas `helm-mm-3-match' would match all." (let* ((pat (helm-mm-3-get-patterns (or pattern helm-pattern))) (first (car pat))) - (and (funcall (car first) (helm-mm-prefix-match str (cdr first))) + (and (funcall (car first) (helm-mm-prefix-match candidate (cdr first))) (cl-loop for (predicate . regexp) in (cdr pat) - always (funcall predicate (string-match regexp str)))))) + always (funcall predicate (string-match regexp candidate)))))) (defun helm-mm-3p-search (pattern &rest _ignore) (when (stringp pattern) @@ -344,15 +346,17 @@ e.g \"bar foo\" will match \"barfoo\" but not \"foobar\" contrarily to ;;; Generic multi-match/search functions ;; ;; -(cl-defun helm-mm-match (str &optional (pattern helm-pattern)) +(cl-defun helm-mm-match (candidate &optional (pattern helm-pattern)) + "Call `helm-mm-matching-method' function against CANDIDATE." (let ((fun (cl-ecase helm-mm-matching-method (multi1 #'helm-mm-1-match) (multi2 #'helm-mm-2-match) (multi3 #'helm-mm-3-match) (multi3p #'helm-mm-3p-match)))) - (funcall fun str pattern))) + (funcall fun candidate pattern))) (defun helm-mm-search (pattern &rest _ignore) + "Search for PATTERN with `helm-mm-matching-method' function." (let ((fun (cl-ecase helm-mm-matching-method (multi1 #'helm-mm-1-search) (multi2 #'helm-mm-2-search) diff --git a/helm-source.el b/helm-source.el index 70c432d1..17895bb5 100644 --- a/helm-source.el +++ b/helm-source.el @@ -103,6 +103,9 @@ It can either be a variable name, a function called with no parameters or the actual list of candidates. + Do NOT use this for asynchronous sources, use `candidates-process' + instead. + The list must be a list whose members are strings, symbols or (DISPLAY . REAL) pairs. @@ -450,8 +453,8 @@ functions, respectively. This attribute has no effect for asynchronous sources (see - attribute `candidates'), since they perform pattern matching - themselves. + attribute `candidates'), and sources using `match-dynamic' + since they perform pattern matching themselves. Note that FUZZY-MATCH slot will overhide value of this slot.") @@ -644,6 +647,17 @@ " This slot have no more effect and is just kept for backward compatibility. Please don't use it.") + (must-match + :initarg :must-match + :initform nil + :custom symbol + :documentation + " Prevent exiting with empty helm buffer. + For this to work `minibuffer-completion-confirm' must be let-bounded + around the helm call. + Same as `completing-read' require-match arg, possible values are `t' + or `confirm'.") + (group :initarg :group :initform helm @@ -708,7 +722,10 @@ Matching is done basically with `string-match' against each candidate.") :custom function :documentation " This attribute is used to define a process as candidate. - The value must be a process. + The function called with no arguments must return a process + i.e. `processp', it use typically `start-process' or `make-process', + see (info \"(elisp) Asynchronous Processes\"). + NOTE: When building the source at runtime you can give directly a process @@ -1017,7 +1034,19 @@ an eieio class." (warn "Deprecated usage of helm `delayed' slot in `%s'" (slot-value source 'name))) (helm-aif (slot-value source 'keymap) - (and (symbolp it) (setf (slot-value source 'keymap) (symbol-value it)))) + (let* ((map (if (symbolp it) + (symbol-value it) + it)) + (must-match-map (when (slot-value source 'must-match) + (let ((map (make-sparse-keymap))) + (define-key map (kbd "RET") + 'helm-confirm-and-exit-minibuffer) + map))) + (loc-map (if must-match-map + (make-composed-keymap + must-match-map map) + map))) + (setf (slot-value source 'keymap) loc-map))) (helm-aif (slot-value source 'persistent-help) (setf (slot-value source 'header-line) (helm-source--persistent-help-string it source)) diff --git a/helm-types.el b/helm-types.el index 868e7974..9bebe4d5 100644 --- a/helm-types.el +++ b/helm-types.el @@ -215,7 +215,7 @@ (defcustom helm-type-function-actions (helm-make-actions - "Describe command" 'describe-function + "Describe command" 'helm-describe-function "Add command to kill ring" 'helm-kill-new "Go to command's definition" 'find-function "Debug on entry" 'debug-on-entry @@ -258,7 +258,8 @@ (defcustom helm-type-command-actions (append (helm-make-actions "Call interactively" 'helm-call-interactively) - (helm-actions-from-type-function)) + (symbol-value + (helm-actions-from-type-function))) "Default actions for type command." :group 'helm-command :type '(alist :key-type string :value-type function)) diff --git a/helm-utils.el b/helm-utils.el index 71cffcba..a7e26bf5 100644 --- a/helm-utils.el +++ b/helm-utils.el @@ -646,14 +646,18 @@ that is sorting is done against real value of candidate." ((string-match r2 str) 2) ((string-match r3 str) 1) (t 0))))) - (sc1 (funcall score str1 reg1 reg2 reg3 split)) - (sc2 (funcall score str2 reg1 reg2 reg3 split))) - (cond ((or (zerop (string-width qpattern)) - (and (zerop sc1) (zerop sc2))) + (sc1 (get-text-property 0 'completion-score str1)) + (sc2 (get-text-property 0 'completion-score str2)) + (sc3 (if sc1 0 (funcall score str1 reg1 reg2 reg3 split))) + (sc4 (if sc2 0 (funcall score str2 reg1 reg2 reg3 split)))) + (cond ((and sc1 sc2) ; helm-flex style. + (> sc1 sc2)) + ((or (zerop (string-width qpattern)) + (and (zerop sc3) (zerop sc4))) (string-lessp str1 str2)) - ((= sc1 sc2) + ((= sc3 sc4) (< (length str1) (length str2))) - (t (> sc1 sc2))))) + (t (> sc3 sc4))))) (cl-defun helm-file-human-size (size &optional (kbsize helm-default-kbsize)) "Return a string showing SIZE of a file in human readable form. @@ -38,6 +38,9 @@ (require 'helm-multi-match) (require 'helm-source) +;; Setup completion styles for helm-mode +(helm--setup-completion-styles-alist) + (declare-function helm-comp-read "helm-mode.el") (declare-function custom-unlispify-tag-name "cus-edit.el") @@ -3981,6 +3984,7 @@ CANDIDATE. Contiguous matches get a coefficient of 2." candidate (helm-stringify candidate))) (pat-lookup (helm--collect-pairs-in-string pattern)) (str-lookup (helm--collect-pairs-in-string cand)) + (inter (cl-nintersection pat-lookup str-lookup :test 'equal)) ;; Prefix (bonus (cond ((or (equal (car pat-lookup) (car str-lookup)) (equal (caar pat-lookup) (caar str-lookup))) @@ -4006,9 +4010,7 @@ CANDIDATE. Contiguous matches get a coefficient of 2." ;; That's mean that "wiaaaki" will not take precedence ;; on "aaawiki" when matching on "wiki" even if "wiaaaki" ;; starts by "wi". - (* (length (cl-nintersection - pat-lookup str-lookup :test 'equal)) - 2))))) + (* (length inter) 2))))) (defun helm-fuzzy-matching-default-sort-fn-1 (candidates &optional use-real basename preserve-tie-order) "The transformer for sorting candidates in fuzzy matching. @@ -4145,6 +4147,90 @@ See `helm-fuzzy-default-highlight-match'." collect (funcall helm-fuzzy-matching-highlight-fn c))) +;;; helm-flex style +;; +;; Provide the emacs-27 flex style for emacs<27. +;; Reuse the flex scoring algorithm of flex style in emacs-27. +(defvar helm--flex-style-str nil) +(defvar helm--flex-style-cache-pat nil) +(defun helm-fuzzy-style-get-pattern (pattern) + (unless (equal pattern helm--flex-style-str) + (setq helm--flex-style-str pattern + helm--flex-style-cache-pat + (helm--flex-style-set-pattern pattern))) + helm--flex-style-cache-pat) + +(defun helm--flex-style-set-pattern (pattern) + (let ((fun (if (string-match "\\`\\^" pattern) + #'identity + #'helm--mapconcat-pattern))) + ;; FIXME: Splitted part are not handled here, + ;; I must compute them in `helm-search-match-part' + ;; when negation and in-buffer are used. + (if (string-match "\\`!" pattern) + (if (> (length pattern) 1) + (funcall fun (substring pattern 1)) + "") + (if (> (length pattern) 0) + (funcall fun pattern) + "")))) + +(defun helm-flex-style-match (candidate) + "Check if `helm-pattern' fuzzy matches CANDIDATE. +This function is used with sources built with `helm-source-sync'." + (unless (string-match " " helm-pattern) + ;; When pattern have one or more spaces, let + ;; multi-match doing the job with no fuzzy matching.[1] + (let ((regexp (helm-fuzzy-style-get-pattern helm-pattern))) + (if (string-match "\\`!" helm-pattern) + (not (string-match regexp candidate)) + (string-match regexp candidate))))) + +(defun helm-flex--style-score (str regexp) + "Score STR candidate according to PATTERN. + +REGEXP should be generated from a pattern which is a list like +\'(point \"f\" any \"o\" any \"b\" any) for \"fob\" as pattern. +Such pattern is build with +`helm-completion--flex-transform-pattern' function. + +Function extracted from `completion-pcm--hilit-commonality' in +emacs-27 to provide such scoring in emacs<27." + ;; Don't modify the string itself. + (setq str (copy-sequence str)) + (unless (string-match regexp str) + (error "Internal error: %s does not match %s" regexp str)) + (let* ((md (match-data)) + (start (pop md)) + (len (length str)) + (score-numerator 0) + (score-denominator 0) + (last-b 0) + (update-score + (lambda (a b) + "Update score variables given match range (A B)." + (setq score-numerator (+ score-numerator (- b a))) + (unless (or (= a last-b) + (zerop last-b) + (= a (length str))) + (setq score-denominator (+ score-denominator + 1 + (expt (- a last-b 1) + (/ 1.0 3))))) + (setq last-b b)))) + (funcall update-score start start) + (setq md (cdr md)) + (while md + (funcall update-score start (pop md)) + (setq start (pop md))) + (funcall update-score len len) + (unless (zerop (length str)) + (put-text-property + 0 1 'completion-score + (/ score-numerator (* len (1+ score-denominator)) 1.0) str))) + str) + + ;;; Matching candidates ;; ;; @@ -5491,31 +5577,37 @@ don't exit and send message 'no match'." (let* ((src (helm-get-current-source)) (empty-buffer-p (with-current-buffer helm-buffer (eq (point-min) (point-max)))) - (sel (helm-get-selection nil nil src)) (unknown (and (not empty-buffer-p) (string= (get-text-property 0 'display (helm-get-selection nil 'withprop src)) "[?]")))) (cond ((and (or empty-buffer-p unknown) - (eq minibuffer-completion-confirm 'confirm)) + (memq minibuffer-completion-confirm + '(confirm confirm-after-completion))) (setq helm-minibuffer-confirm-state 'confirm) (setq minibuffer-completion-confirm nil) (minibuffer-message " [confirm]")) - ((and (or empty-buffer-p - (unless (if minibuffer-completing-file-name - (and minibuffer-completion-predicate - (funcall minibuffer-completion-predicate sel)) - (and (stringp sel) - ;; SEL may be a cons cell when helm-comp-read - ;; is called directly with a collection composed - ;; of (display . real) and real is a cons cell. - (try-completion sel minibuffer-completion-table - minibuffer-completion-predicate))) - unknown)) + ;; When require-match is strict (i.e. `t'), buffer + ;; should be either empty or in read-file-name have an + ;; unknown candidate ([?] prefix), if it's not the case + ;; fix it in helm-mode but not here. + ((and (or empty-buffer-p unknown) (eq minibuffer-completion-confirm t)) (minibuffer-message " [No match]")) + (empty-buffer-p + ;; This is used when helm-buffer is totally empty, + ;; i.e. the [?] have not been added because must-match + ;; is used from outside helm-comp-read i.e. from a helm + ;; source built with :must-match. + (setq helm-saved-selection helm-pattern + helm-saved-action (helm-get-default-action + (assoc-default + 'action + (car (with-helm-buffer helm-sources)))) + helm-minibuffer-confirm-state nil) + (helm-exit-minibuffer)) (t (setq helm-minibuffer-confirm-state nil) (helm-exit-minibuffer))))))) |