From: Andreas Gerler Date: Sun, 26 Apr 2026 17:54:54 +0000 (+0200) Subject: update helm X-Git-Url: http://git.bundesbrandschatzamt.de/?a=commitdiff_plain;h=1acd6a58134699b0fb94e35ff61488ab2f1af17b;p=emacsconfig.git update helm --- diff --git a/elpa/helm-20251212.555/emacs-helm.sh b/elpa/helm-20251212.555/emacs-helm.sh deleted file mode 100755 index 1bd32f30..00000000 --- a/elpa/helm-20251212.555/emacs-helm.sh +++ /dev/null @@ -1,277 +0,0 @@ -#!/usr/bin/env sh - - -## Copyright (C) 2012 ~ 2025 Thierry Volpiatto -## -## This program is free software; you can redistribute it and/or modify -## it under the terms of the GNU General Public License as published by -## the Free Software Foundation, either version 3 of the License, or -## (at your option) any later version. -## -## This program is distributed in the hope that it will be useful, -## but WITHOUT ANY WARRANTY; without even the implied warranty of -## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -## GNU General Public License for more details. -## -## You should have received a copy of the GNU General Public License -## along with this program. If not, see . - -## Commentary: -# Preconfigured `emacs -Q' with a basic Helm configuration. - - -# If TEMP env var exists, use it, otherwise declare it. -test -z "$TEMP" && TEMP="/tmp" - -CONF_FILE="$TEMP/helm-cfg.el" -EMACS=emacs -QUICK=-Q -TOOLBARS=-1 -LOAD_PACKAGES= - -usage () { - cat >&1 < $CONF_FILE <\`helm-find-files'\\n\ -;; - \`occur'(M-s o) =>\`helm-occur'\\n\ -;; - \`list-buffers'(C-x C-b) =>\`helm-buffers-list'\\n\ -;; - \`apropos-command'(C-h a) =>\`helm-apropos'\\n\ -;; - \`dabbrev-expand'(M-/) =>\`helm-dabbrev'\\n\ -;; - \`execute-extended-command'(M-x) =>\`helm-M-x'\\n\ -;; - \`yank-pop'(M-y) =>\`helm-show-kill-ring'\\n\\n -;; \`helm-mode' is enabled which mean that most Emacs commands using completion\\n\ -;; will use helm.\\n\ - -;; To start editing a file or to create a new file, visit it with \`C-x C-f'\\n\ -;; and enter text in its buffer, to save your changes hit \`C-x C-s'. - -;; Find context help for most Helm commands with \`C-h m' while helm is running.\\n\ -;; You can also retrieve the whole user documentation with \`C-x c h h'.\\n\ -;; For online documentation see \`https://github.com/emacs-helm/helm/wiki'.\\n\ -;; \(Put cursor on url, hit \`C-x C-f' and then RETurn).\\n\ - -;; To quit this Emacs, hit \'C-x C-c'.\\n\ - -;; Note about keybindings in Emacs: \`C-' means \'Control-' and \`M-' \'Alt-'.\\n\ -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\\n\\n") - -(setq load-path (quote $LOAD_PATH)) - -(defvar default-package-manager nil) -;; /home/you/.emacs.d/.local/straight/build-27.1/helm -(defvar initial-package-directory (file-name-directory (file-truename "$0"))) - -(defvar bootstrap-version) -(let* ((packages "$LOAD_PACKAGES") - (pkg-list (and packages - (not (equal packages "")) - (split-string packages ","))) - ;; /home/you/.emacs.d/.local/straight/build-27.1 - (straight-path (file-name-directory (directory-file-name initial-package-directory))) - ;; /home/you/.emacs.d/.local/straight/build-27.1/async - (async-path (expand-file-name "async" straight-path)) - ;; /home/you/.emacs.d/.local/straight/repos/straight.el/bootstrap.el - (bootstrap-file - (expand-file-name "repos/straight.el/bootstrap.el" - (file-name-directory (directory-file-name straight-path)))) - (bootstrap-version 5)) - (when (file-exists-p bootstrap-file) - (setq default-package-manager 'straight) - (load bootstrap-file nil 'nomessage) - (add-to-list 'load-path async-path) - (when pkg-list - (dolist (pkg pkg-list) - (let* ((pkg-path (expand-file-name pkg straight-path)) - (autoload-file (expand-file-name - (format "%s-autoloads.el" pkg) - pkg-path))) - (add-to-list 'load-path pkg-path) - (if (file-exists-p autoload-file) - (load autoload-file nil 'nomessage) - (straight-use-package (intern pkg)))))))) - -(unless (eq default-package-manager 'straight) - (require 'package) - ;; User may be using a non standard \`package-user-dir'. - ;; Modify \`package-directory-list' instead of \`package-user-dir' - ;; in case the user starts Helm from a non-ELPA installation. - (unless (file-equal-p package-user-dir (locate-user-emacs-file "elpa")) - ;; Something like /home/you/.emacs.d/somedir/else/elpa/ - ;; starting from default-directory is wrong in case helm.sh is a symlink - ;; or e.g. helm --chdir foo have been used. - (add-to-list 'package-directory-list (directory-file-name - (file-name-directory - (directory-file-name initial-package-directory))))) - - (let* ((str-lst "$LOAD_PACKAGES") - (load-packages (and str-lst - (not (string= str-lst "")) - (split-string str-lst ",")))) - (setq package-load-list - (if (equal load-packages '("all")) - '(all) - (append '((helm-core t) (helm t) (async t) (wfnames t)) - (mapcar (lambda (p) (list (intern p) t)) load-packages))))) - - (package-initialize)) - -(add-to-list 'load-path initial-package-directory) - -(unless (> $TOOLBARS 0) - (setq default-frame-alist '((vertical-scroll-bars . nil) - (tool-bar-lines . 0) - (menu-bar-lines . 0) - (fullscreen . nil)))) -(blink-cursor-mode -1) -(load "helm-autoloads" nil t) -(helm-mode 1) -(with-eval-after-load 'tramp-cache (setq tramp-cache-read-persistent-data t)) -(with-eval-after-load 'auth-source (setq auth-source-save-behavior nil)) -(define-key global-map [remap find-file] 'helm-find-files) -(define-key global-map [remap occur] 'helm-occur) -(define-key global-map [remap list-buffers] 'helm-buffers-list) -(define-key global-map [remap dabbrev-expand] 'helm-dabbrev) -(define-key global-map [remap execute-extended-command] 'helm-M-x) -(define-key global-map [remap apropos-command] 'helm-apropos) -(define-key global-map [remap yank-pop] 'helm-show-kill-ring) -(add-hook 'kill-emacs-hook #'(lambda () (and (file-exists-p "$CONF_FILE") (delete-file "$CONF_FILE")))) -EOF - -$EMACS "$QUICK" -l "$CONF_FILE" "$@" diff --git a/elpa/helm-20251212.555/helm-adaptive.el b/elpa/helm-20251212.555/helm-adaptive.el deleted file mode 100644 index 68c77e2a..00000000 --- a/elpa/helm-20251212.555/helm-adaptive.el +++ /dev/null @@ -1,284 +0,0 @@ -;;; helm-adaptive.el --- Adaptive Sorting of Candidates. -*- lexical-binding: t -*- - -;; Original Author: Tamas Patrovics - -;; Copyright (C) 2007 Tamas Patrovics -;; Copyright (C) 2012 ~ 2025 Thierry Volpiatto - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Code: - -(require 'cl-lib) -(require 'helm) - - -(defgroup helm-adapt nil - "Adaptative sorting of candidates for Helm." - :group 'helm) - -(defcustom helm-adaptive-history-file - (locate-user-emacs-file "helm-adaptive-history") - "Path of file where history information is stored. -When nil history is not saved nor restored after Emacs restart -unless you save/restore `helm-adaptive-history' with something -else like psession or desktop." - :type 'string) - -(defcustom helm-adaptive-history-length 50 - "Maximum number of candidates stored for a source." - :type 'number) - -(defcustom helm-adaptive-sort-by-frequent-recent-usage t - "Try to sort on an average of frequent and recent usage when non-nil. - -When nil sort on frequency usage only. - -Only frequency: -When candidate have low frequency, you have to hit on it many -times to make it going up on top. - -Frequency+recent: -Even with a low frequency, candidate go up on top. If a candidate -have a high frequency but it is not used since some time, it goes -down slowly, but as soon you reuse it it go up on top quickly." - :type 'boolean) - -;; Internal -(defvar helm-adaptive-done nil - "nil if history information is not yet stored for the current -selection.") - -(defvar helm-adaptive-history nil - "Contains the stored history information. -Format: ((SOURCE-NAME - (SELECTED-CANDIDATE (PATTERN . NUMBER-OF-USE) ...) ...) ...)") - -(defconst helm-adaptive-freq-coefficient 5) -(defconst helm-adaptive-recent-coefficient 2) - -(defun helm-adaptive-done-reset () - (setq helm-adaptive-done nil)) - -;;;###autoload -(define-minor-mode helm-adaptive-mode - "Toggle adaptive sorting in all sources." - :global t - (if helm-adaptive-mode - (progn - (unless helm-adaptive-history - (helm-adaptive-maybe-load-history)) - (add-hook 'kill-emacs-hook #'helm-adaptive-save-history) - ;; Should run at beginning of `helm-initial-setup'. - (add-hook 'helm-before-initialize-hook #'helm-adaptive-done-reset) - ;; Should run at beginning of `helm-exit-minibuffer'. - (add-hook 'helm-before-action-hook #'helm-adaptive-store-selection) - ;; Should run at beginning of `helm-select-action'. - (add-hook 'helm-select-action-hook #'helm-adaptive-store-selection)) - (helm-adaptive-save-history) - (setq helm-adaptive-history nil) - (remove-hook 'kill-emacs-hook #'helm-adaptive-save-history) - (remove-hook 'helm-before-initialize-hook #'helm-adaptive-done-reset) - (remove-hook 'helm-before-action-hook #'helm-adaptive-store-selection) - (remove-hook 'helm-select-action-hook #'helm-adaptive-store-selection))) - -(defun helm-adapt-use-adaptive-p (&optional source-name) - "Return current source only if it use adaptive history, nil otherwise." - (when helm-adaptive-mode - (let* ((source (or source-name (helm-get-current-source))) - (adapt-source (or (assoc-default 'filtered-candidate-transformer source) - (assoc-default 'candidate-transformer source)))) - (if (listp adapt-source) - (and (memq 'helm-adaptive-sort adapt-source) source) - (and (eq adapt-source 'helm-adaptive-sort) source))))) - -(defun helm-adaptive-store-selection () - "Store history information for the selected candidate." - (unless helm-adaptive-done - (setq helm-adaptive-done t) - (let ((source (helm-adapt-use-adaptive-p))) - (when source - (let* ((source-name (assoc-default 'name source)) - (source-info (or (assoc source-name helm-adaptive-history) - (progn - (push (list source-name) helm-adaptive-history) - (car helm-adaptive-history)))) - (selection (helm-get-selection nil t)) - (selection-info (progn - (setcdr source-info - (cons - (let ((found (assoc selection (cdr source-info)))) - (if (not found) - ;; new entry - (list selection) - ;; move entry to the beginning of the - ;; list, so that it doesn't get - ;; trimmed when the history is - ;; truncated - (setcdr source-info - (delete found (cdr source-info))) - found)) - (cdr source-info))) - (cadr source-info))) - (pattern-info (progn - (setcdr selection-info - (cons - (let ((found (assoc helm-pattern (cdr selection-info)))) - (if (not found) - ;; new entry - (cons helm-pattern 0) - ;; move entry to the beginning of the - ;; list, so if two patterns used the - ;; same number of times then the one - ;; used last appears first in the list - (setcdr selection-info - (delete found (cdr selection-info))) - found)) - (cdr selection-info))) - (cadr selection-info))) - (timestamp-info (helm-aif (assq 'timestamp (cdr selection-info)) - it - (setcdr selection-info (cons (cons 'timestamp 0) (cdr selection-info))) - (cadr selection-info)))) - ;; Increase usage count. - (setcdr pattern-info (1+ (cdr pattern-info))) - ;; Update timestamp. - (setcdr timestamp-info (float-time)) - ;; Truncate history if needed. - (if (> (length (cdr selection-info)) helm-adaptive-history-length) - (setcdr selection-info - (helm-take (cdr selection-info) helm-adaptive-history-length)))))))) - -(defun helm-adaptive-maybe-load-history () - "Load `helm-adaptive-history-file' which contain `helm-adaptive-history'. -Returns nil if `helm-adaptive-history-file' doesn't exist." - (when (and helm-adaptive-history-file - (file-readable-p helm-adaptive-history-file)) - (load-file helm-adaptive-history-file))) - -(defun helm-adaptive-save-history (&optional arg) - "Save history information to the file given by `helm-adaptive-history-file'." - (interactive "p") - (when helm-adaptive-history-file - (with-temp-buffer - (insert - ";; -*- mode: emacs-lisp; lexical-binding: t -*-\n" - ";; History entries used for helm adaptive display.\n") - (let (print-length print-level) - (prin1 `(setq helm-adaptive-history ',helm-adaptive-history) - (current-buffer))) - (insert ?\n) - (write-region (point-min) (point-max) helm-adaptive-history-file nil - (unless arg 'quiet))))) - -(defun helm-adaptive-sort (candidates source) - "Sort the CANDIDATES for SOURCE by usage frequency. -This is a filtered candidate transformer you can use with the -`filtered-candidate-transformer' attribute." - (let* ((source-name (assoc-default 'name source)) - (source-info (assoc source-name helm-adaptive-history))) - (if source-info - (let ((usage - ;; Loop in the SOURCE entry of `helm-adaptive-history' - ;; and assemble a list containing the (CANDIDATE - ;; . USAGE-COUNT) pairs. - (cl-loop with cf = (if helm-adaptive-sort-by-frequent-recent-usage - helm-adaptive-freq-coefficient 1) - with cr = helm-adaptive-recent-coefficient - for (src-cand . infos) in (cdr source-info) - for count-freq = 0 - for count-rec = - (helm-aif (and helm-adaptive-sort-by-frequent-recent-usage - (assq 'timestamp infos)) - (* cr (+ (float-time) (cdr it))) - 0) - do (cl-loop for (pattern . score) in - (remove (assq 'timestamp infos) infos) - ;; If current pattern is equal to - ;; the previously used one then - ;; this candidate has priority - ;; (that's why its count-freq is - ;; boosted by 10000) and it only - ;; has to compete with other - ;; candidates which were also - ;; selected with the same pattern. - if (equal pattern helm-pattern) - return (setq count-freq (+ 10000 score)) - else do (cl-incf count-freq score)) - and collect (cons src-cand (+ (* count-freq cf) count-rec)) - into results - ;; Sort the list in descending order, so - ;; candidates with highest priority come - ;; first. - finally return - (sort results (lambda (first second) - (> (cdr first) (cdr second))))))) - (if (consp usage) - ;; Put those candidates first which have the highest usage count. - (cl-loop for (cand . _freq) in usage - for info = (or (and (assq 'multiline source) - (replace-regexp-in-string - "\n\\'" "" cand)) - ;; Some transformers like in - ;; bookmarks may add a leading - ;; space to provide additional - ;; infos like an icon as a - ;; display prop, strip out this - ;; leading space for - ;; comparison. Same for a - ;; trailing space (helm - ;; boookmark add bmk location as - ;; a display prop when - ;; displaying it). - (helm-aand (replace-regexp-in-string "\\` " "" cand) - (replace-regexp-in-string " \\'" "" it))) - when (cl-member info candidates - :test 'helm-adaptive-compare) - collect (car it) into sorted - and do (setq candidates - (cl-remove info candidates - :test 'helm-adaptive-compare)) - finally return (append sorted candidates)) - (message "Your `%s' is maybe corrupted or too old, \ -you should reinitialize it with `helm-reset-adaptive-history'" - helm-adaptive-history-file) - (sit-for 1) - candidates)) - ;; if there is no information stored for this source then do nothing - candidates))) - -;;;###autoload -(defun helm-reset-adaptive-history () - "Delete all `helm-adaptive-history' and his file. -Useful when you have a old or corrupted -`helm-adaptive-history-file'." - (interactive) - (when (y-or-n-p "Really delete all your `helm-adaptive-history'? ") - (setq helm-adaptive-history nil) - (when (and helm-adaptive-history-file - (file-exists-p helm-adaptive-history-file)) - (delete-file helm-adaptive-history-file)))) - -(defun helm-adaptive-compare (x y) - "Compare display parts if some of candidates X and Y. - -Arguments X and Y are cons cell in (DISPLAY . REAL) format or -atoms." - (equal (if (listp x) (car x) x) - (if (listp y) (car y) y))) - - -(provide 'helm-adaptive) - -;;; helm-adaptive.el ends here diff --git a/elpa/helm-20251212.555/helm-autoloads.el b/elpa/helm-20251212.555/helm-autoloads.el deleted file mode 100644 index 2c94f8be..00000000 --- a/elpa/helm-20251212.555/helm-autoloads.el +++ /dev/null @@ -1,1101 +0,0 @@ -;;; helm-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*- -;; Generated by the `loaddefs-generate' function. - -;; This file is part of GNU Emacs. - -;;; Code: - -(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path))) - - - -;;; Generated autoloads from helm-adaptive.el - -(defvar helm-adaptive-mode nil "\ -Non-nil if Helm-Adaptive mode is enabled. -See the `helm-adaptive-mode' command -for a description of this minor mode. -Setting this variable directly does not take effect; -either customize it (see the info node `Easy Customization') -or call the function `helm-adaptive-mode'.") -(custom-autoload 'helm-adaptive-mode "helm-adaptive" nil) -(autoload 'helm-adaptive-mode "helm-adaptive" "\ -Toggle adaptive sorting in all sources. - -This is a global minor mode. If called interactively, toggle the -`Helm-Adaptive mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the mode -if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `(default-value \\='helm-adaptive-mode)'. - -The mode's hook is called both when the mode is enabled and when it is -disabled. - -(fn &optional ARG)" t) -(autoload 'helm-reset-adaptive-history "helm-adaptive" "\ -Delete all `helm-adaptive-history' and his file. -Useful when you have a old or corrupted -`helm-adaptive-history-file'." t) -(register-definition-prefixes "helm-adaptive" '("helm-adapt")) - - -;;; Generated autoloads from helm-bookmark.el - -(autoload 'helm-bookmark-import-eww-bookmarks "helm-bookmark" "\ -Import EWW bookmarks into bookmark-alist." t) -(autoload 'helm-bookmarks "helm-bookmark" "\ -Preconfigured `helm' for bookmarks." t) -(autoload 'helm-filtered-bookmarks "helm-bookmark" "\ -Preconfigured `helm' for bookmarks (filtered by category). -Optional source `helm-source-bookmark-addressbook' is loaded only -if external addressbook-bookmark package is installed." t) -(register-definition-prefixes "helm-bookmark" '("bmk" "bookmark" "helm-")) - - -;;; Generated autoloads from helm-buffers.el - -(autoload 'helm-buffers-quit-and-find-file-fn "helm-buffers" "\ - - -(fn SOURCE)") -(autoload 'helm-buffers-list "helm-buffers" "\ -Preconfigured `helm' to list buffers." t) -(autoload 'helm-mini "helm-buffers" "\ -Preconfigured `helm' displaying `helm-mini-default-sources'." t) -(register-definition-prefixes "helm-buffers" '("helm-")) - - -;;; Generated autoloads from helm-color.el - -(autoload 'helm-colors "helm-color" "\ -Preconfigured `helm' for color." t) -(register-definition-prefixes "helm-color" '("helm-")) - - -;;; Generated autoloads from helm-command.el - -(autoload 'helm-M-x "helm-command" "\ -Preconfigured `helm' for Emacs commands. -It is `helm' replacement of regular `M-x' -`execute-extended-command'. - -Unlike regular `M-x' Emacs vanilla `execute-extended-command' -command, the prefix args if needed, can be passed AFTER starting -`helm-M-x'. When a prefix arg is passed BEFORE starting -`helm-M-x', the first `C-u' while in `helm-M-x' session will -disable it. - -You can get help on each command by persistent action. - -(fn ARG)" t) -(register-definition-prefixes "helm-command" '("helm-")) - - -;;; Generated autoloads from helm-dabbrev.el - -(autoload 'helm-dabbrev "helm-dabbrev" "\ -Preconfigured helm for dynamic abbreviations." t) -(register-definition-prefixes "helm-dabbrev" '("helm-dabbrev-")) - - -;;; Generated autoloads from helm-elisp.el - -(autoload 'helm-lisp-completion-at-point "helm-elisp" "\ -Preconfigured Helm for Lisp symbol completion at point." t) -(autoload 'helm-get-first-line-documentation "helm-elisp" "\ -Return first line documentation of symbol SYM truncated at END-COLUMN. -If SYM is not documented, return \"Not documented\". -Argument NAME allows specifiying what function to use to display -documentation when SYM name is the same for function and variable. - -(fn SYM &optional NAME END-COLUMN)") -(autoload 'helm-complete-file-name-at-point "helm-elisp" "\ -Preconfigured Helm to complete file name at point. - -(fn &optional FORCE)" t) -(autoload 'helm-lisp-indent "helm-elisp" nil t) -(autoload 'helm-apropos "helm-elisp" "\ -Preconfigured Helm to describe commands, functions, variables and faces. -In non interactives calls DEFAULT argument should be provided as -a string, i.e. the `symbol-name' of any existing symbol. - -(fn DEFAULT)" t) -(autoload 'helm-locate-library "helm-elisp" "\ -Preconfigured helm to locate elisp libraries. - -When `completions-detailed' or `helm-completions-detailed' is non -nil, a description of libraries is provided. The libraries are -partially cached in the variables -`helm--locate-library-doc-cache' and -`helm--locate-library-cache'. TIP: You can make these vars -persistent for faster start with the psession package, using M-x -psession-make-persistent-variable. NOTE: The caches affect as -well `find-libray' and `locate-library' when `helm-mode' is -enabled and `completions-detailed' is non nil. There is no need -to refresh the caches, they will be updated automatically if some -new libraries are found, however when a library update its -headers and the description change you can reset the caches with -a prefix arg. - -(fn &optional ARG)" t) -(autoload 'helm-timers "helm-elisp" "\ -Preconfigured `helm' for timers." t) -(autoload 'helm-complex-command-history "helm-elisp" "\ -Preconfigured `helm' for complex command history." t) -(register-definition-prefixes "helm-elisp" '("helm-" "with-helm-show-completion")) - - -;;; Generated autoloads from helm-epa.el - -(defvar helm-epa-mode nil "\ -Non-nil if Helm-Epa mode is enabled. -See the `helm-epa-mode' command -for a description of this minor mode. -Setting this variable directly does not take effect; -either customize it (see the info node `Easy Customization') -or call the function `helm-epa-mode'.") -(custom-autoload 'helm-epa-mode "helm-epa" nil) -(autoload 'helm-epa-mode "helm-epa" "\ -Enable helm completion on gpg keys in epa functions. - -This is a global minor mode. If called interactively, toggle the -`Helm-Epa mode' mode. If the prefix argument is positive, enable the -mode, and if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the mode -if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `(default-value \\='helm-epa-mode)'. - -The mode's hook is called both when the mode is enabled and when it is -disabled. - -(fn &optional ARG)" t) -(autoload 'helm-epa-list-keys "helm-epa" "\ -List all gpg keys. -This is the helm interface for `epa-list-keys'." t) -(register-definition-prefixes "helm-epa" '("helm-epa")) - - -;;; Generated autoloads from helm-eshell.el - -(autoload 'helm-esh-pcomplete "helm-eshell" "\ -Preconfigured `helm' to provide Helm completion in Eshell." t) -(autoload 'helm-eshell-history "helm-eshell" "\ -Preconfigured Helm for Eshell history." t) -(autoload 'helm-eshell-prompts "helm-eshell" "\ -Pre-configured `helm' to browse the prompts of the current Eshell." t) -(autoload 'helm-eshell-prompts-all "helm-eshell" "\ -Pre-configured `helm' to browse the prompts of all Eshell sessions." t) -(register-definition-prefixes "helm-eshell" '("helm-e")) - - -;;; Generated autoloads from helm-eval.el - -(autoload 'helm-eval-expression "helm-eval" "\ -Preconfigured `helm' for `helm-source-evaluation-result'. - -(fn ARG)" t) -(autoload 'helm-eval-expression-with-eldoc "helm-eval" "\ -Preconfigured `helm' for `helm-source-evaluation-result' with `eldoc' support." t) -(autoload 'helm-calcul-expression "helm-eval" "\ -Preconfigured `helm' for `helm-source-calculation-result'." t) -(register-definition-prefixes "helm-eval" '("helm-")) - - -;;; Generated autoloads from helm-external.el - -(autoload 'helm-run-external-command "helm-external" "\ -Preconfigured `helm' to run External PROGRAM asyncronously from Emacs. -If program is already running try to run `helm-raise-command' if -defined otherwise exit with error. You can set your own list of -commands with `helm-external-commands-list'." t) -(register-definition-prefixes "helm-external" '("helm-")) - - -;;; Generated autoloads from helm-fd.el - -(register-definition-prefixes "helm-fd" '("helm-fd-")) - - -;;; Generated autoloads from helm-files.el - -(defvar helm-ff-icon-mode nil "\ -Non-nil if Helm-Ff-Icon mode is enabled. -See the `helm-ff-icon-mode' command -for a description of this minor mode. -Setting this variable directly does not take effect; -either customize it (see the info node `Easy Customization') -or call the function `helm-ff-icon-mode'.") -(custom-autoload 'helm-ff-icon-mode "helm-files" nil) -(autoload 'helm-ff-icon-mode "helm-files" "\ -Display icons from `helm-x-icons-provider' package in HFF when enabled. - -This is a global minor mode. If called interactively, toggle the -`Helm-Ff-Icon mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the mode -if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `(default-value \\='helm-ff-icon-mode)'. - -The mode's hook is called both when the mode is enabled and when it is -disabled. - -(fn &optional ARG)" t) -(autoload 'helm-ff-clear-image-dired-thumbnails-cache "helm-files" "\ -Clear `helm-ff-image-dired-thumbnails-cache'. -You may want to do this after customizing -`image-dired-thumbnail-storage' which may change the place where -thumbnail files are stored." t) -(autoload 'helm-ff-cleanup-image-dired-dir-and-cache "helm-files" "\ -Cleanup `image-dired-dir' directory. -Delete all thumb files that are no more associated with an existing -image file in `helm-ff-image-dired-thumbnails-cache'." t) -(autoload 'helm-projects-history "helm-files" "\ -Jump to project already visisted with `helm-browse-project'. -Prefix arg allows browsing files recursively under a project not handled -by git or hg, otherwise it has no effect. - -(fn &optional ARG)" t) -(autoload 'helm-browse-project "helm-files" "\ -Preconfigured helm to browse projects. -Browse files and see status of project with its VCS. -GIT, HG and SVN are supported for now, but only git is fully featured with -`helm-ls-git' package. -Fall back to `helm-browse-project-find-files' if current -directory is not under control or one of those VCS. -With a prefix ARG browse files recursively, with two prefix ARG -rebuild the cache. -If the current directory is found in the cache, start -`helm-browse-project-find-files' even with no prefix ARG. -NOTE: The prefix ARG have no effect on the VCS controlled -directories. - -Needed dependencies for VCS (not mandatory, pickup what you need): - - -. - -(fn ARG)" t) -(autoload 'helm-find-files "helm-files" "\ -Preconfigured `helm' for helm implementation of `find-file'. -Called with a prefix arg show history if some. -Don't call it from programs, use `helm-find-files-1' instead. -This is the starting point for nearly all actions you can do on -files. - -(fn ARG)" t) -(register-definition-prefixes "helm-files" '("eshell-command-aliases-list" "helm-")) - - -;;; Generated autoloads from helm-find.el - -(autoload 'helm-find "helm-find" "\ -Preconfigured `helm' for the find shell command. - -Recursively find files whose names are matched by all specified -globbing PATTERNs under the current directory using the external -program specified in `find-program' (usually \"find\"). Every -input PATTERN is silently wrapped into two stars: *PATTERN*. - -With prefix argument, prompt for a directory to search. - -When user option `helm-findutils-search-full-path' is non-nil, -match against complete paths, otherwise, against file names -without directory part. - -The (possibly empty) list of globbing PATTERNs can be followed by -the separator \"*\" plus any number of additional arguments that -are passed to \"find\" literally. - -(fn ARG)" t) -(register-definition-prefixes "helm-find" '("helm-")) - - -;;; Generated autoloads from helm-font.el - -(autoload 'helm-select-xfont "helm-font" "\ -Preconfigured `helm' to select Xfont." t) -(autoload 'helm-ucs "helm-font" "\ -Preconfigured `helm' for `ucs-names'. - -Called with a prefix arg force reloading cache. - -(fn ARG)" t) -(register-definition-prefixes "helm-font" '("helm-")) - - -;;; Generated autoloads from helm-for-files.el - -(autoload 'helm-highlight-files "helm-for-files" "\ -A basic transformer for helm files sources. -Colorize only symlinks, directories and files. - -(fn FILES SOURCE)") -(autoload 'helm-for-files "helm-for-files" "\ -Preconfigured `helm' for opening files. -Run all sources defined in `helm-for-files-preferred-list'." t) -(autoload 'helm-multi-files "helm-for-files" "\ -Preconfigured helm like `helm-for-files' but running locate only on demand. - -Allow toggling back and forth from locate to others sources with -`helm-multi-files-toggle-locate-binding' key. -This avoids launching locate needlessly when what you are -searching for is already found." t) -(autoload 'helm-recentf "helm-for-files" "\ -Preconfigured `helm' for `recentf'." t) -(register-definition-prefixes "helm-for-files" '("helm-")) - - -;;; Generated autoloads from helm-global-bindings.el - -(register-definition-prefixes "helm-global-bindings" '("helm-command-")) - - -;;; Generated autoloads from helm-grep.el - -(autoload 'helm-goto-precedent-file "helm-grep" "\ -Go to previous file in Helm grep/etags buffers." t) -(autoload 'helm-goto-next-file "helm-grep" "\ -Go to previous file in Helm grep/etags buffers." t) -(autoload 'helm-revert-next-error-last-buffer "helm-grep" "\ -Revert last `next-error' buffer from `current-buffer'. - -Accept to revert only `helm-grep-mode' or `helm-occur-mode' buffers. -Use this when you want to revert the `next-error' buffer after -modifications in `current-buffer'." t) -(autoload 'helm-do-grep-ag "helm-grep" "\ -Preconfigured `helm' for grepping with AG in `default-directory'. -With prefix arg prompt for type if available with your AG -version. - -(fn ARG)" t) -(autoload 'helm-do-grep-ag-project "helm-grep" "\ -Preconfigured `helm' for grepping with AG from the current project root. -If no project found use `default-directory'. -With prefix arg prompt for type if available with your AG version. - -(fn ARG)" t) -(autoload 'helm-grep-do-git-grep "helm-grep" "\ -Preconfigured `helm' for git-grepping `default-directory'. -With a prefix arg ARG git-grep the whole repository. - -(fn ARG)" t) -(register-definition-prefixes "helm-grep" '("helm-")) - - -;;; Generated autoloads from helm-help.el - -(autoload 'helm-documentation "helm-help" "\ -Preconfigured `helm' for Helm documentation. -With a prefix arg refresh the documentation. - -Find here the documentation of all documented sources." t) -(defvar helm-comp-read-mode-line "\\C/\\[helm-cr-empty-string]:Empty \\\\[helm-help]:Help \\[helm-select-action]:Act \\[helm-maybe-exit-minibuffer]/f1/f2/f-n:NthAct \\[helm-toggle-suspend-update]:Tog.suspend \\[helm-customize-group]:Conf") -(defvar helm-read-file-name-mode-line-string "\\\\[helm-help]:Help C/\\[helm-cr-empty-string]:Empty \\\\[helm-select-action]:Act \\[helm-maybe-exit-minibuffer]/f1/f2/f-n:NthAct \\[helm-toggle-suspend-update]:Tog.suspend \\[helm-customize-group]:Conf" "\ -String displayed in mode-line in `helm-source-find-files'.") -(defvar helm-top-mode-line "\\\\[helm-help]:Help \\\\[helm-select-action]:Act \\[helm-maybe-exit-minibuffer]/f1/f2/f-n:NthAct \\[helm-toggle-suspend-update]:Tog.suspend \\[helm-customize-group]:Conf") -(register-definition-prefixes "helm-help" '("helm-")) - - -;;; Generated autoloads from helm-id-utils.el - -(autoload 'helm-gid "helm-id-utils" "\ -Preconfigured `helm' for `gid' command line of `ID-Utils'. -Need A database created with the command `mkid' above -`default-directory'. -Need id-utils as dependency which provide `mkid', `gid' etc.. -See ." t) -(register-definition-prefixes "helm-id-utils" '("helm-gid-")) - - -;;; Generated autoloads from helm-imenu.el - -(autoload 'helm-imenu "helm-imenu" "\ -Preconfigured `helm' for `imenu'." t) -(autoload 'helm-imenu-in-all-buffers "helm-imenu" "\ -Fetch Imenu entries in all buffers with similar mode as current. -A mode is similar as current if it is the same, it is derived -i.e. `derived-mode-p' or it have an association in -`helm-imenu-all-buffer-assoc'." t) -(register-definition-prefixes "helm-imenu" '("helm-")) - - -;;; Generated autoloads from helm-info.el - -(autoload 'helm-info "helm-info" "\ -Preconfigured `helm' for searching Info files' indices. - -With a prefix argument \\[universal-argument], set REFRESH to -non-nil. - -Optional parameter REFRESH, when non-nil, re-evaluates -`helm-default-info-index-list' and clears caches (see below). -If the variable has been customized, set it to its saved value. -If not, set it to its standard value. See -`custom-reevaluate-setting' for more. - -REFRESH is useful when new Info files are installed. If -`helm-default-info-index-list' has not been customized, the new -Info files are made available. - -When `completions-detailed' or `helm-completions-detailed' is non -nil, a description of Info files is provided. The Info files are -partially cached in the variables `helm-info--files-cache' and -`helm-info--files-docs-cache'. TIP: You can make these vars -persistent for faster start with the psession package, using -\\[psession-make-persistent-variable]. - -NOTE: The caches affect as well `info-dislpay-manual' when -`helm-mode' is enabled and `completions-detailed' is non nil. -When new Info files are installed, for example a library update -changed Info dir node entry, you can reset the caches with -a prefix arg. - -(fn &optional REFRESH)" t) -(autoload 'helm-info-at-point "helm-info" "\ -Preconfigured `helm' for searching info at point." t) -(register-definition-prefixes "helm-info" '("helm-")) - - -;;; Generated autoloads from helm-locate.el - -(autoload 'helm-projects-find-files "helm-locate" "\ -Find files with locate in `helm-locate-project-list'. -With a prefix arg refresh the database in each project. - -(fn UPDATE)" t) -(autoload 'helm-locate "helm-locate" "\ -Preconfigured `helm' for Locate. -Note: you can add locate options after entering pattern. -See \\='man locate' for valid options and also `helm-locate-command'. - -You can specify a local database with prefix argument ARG. -With two prefix arg, refresh the current local db or create it if -it doesn't exists. - -To create a user specific db, use -\"updatedb -l 0 -o db_path -U directory\". -Where db_path is a filename matched by -`helm-locate-db-file-regexp'. - -(fn ARG)" t) -(register-definition-prefixes "helm-locate" '("helm-")) - - -;;; Generated autoloads from helm-man.el - -(autoload 'helm-man-woman "helm-man" "\ -Preconfigured `helm' for Man and Woman pages. -With a prefix ARG reinitialize the cache. To have a popup -showing a basic description of selected candidate, turn on -`helm-popup-tip-mode'. - -(fn ARG)" t) -(register-definition-prefixes "helm-man" '("helm-")) - - -;;; Generated autoloads from helm-misc.el - -(defvar helm-minibuffer-history-mode nil "\ -Non-nil if Helm-Minibuffer-History mode is enabled. -See the `helm-minibuffer-history-mode' command -for a description of this minor mode. -Setting this variable directly does not take effect; -either customize it (see the info node `Easy Customization') -or call the function `helm-minibuffer-history-mode'.") -(custom-autoload 'helm-minibuffer-history-mode "helm-misc" nil) -(autoload 'helm-minibuffer-history-mode "helm-misc" "\ -Bind `helm-minibuffer-history-key' in al minibuffer maps. - -This mode is enabled by `helm-mode', so there is no need to enable it directly. - -This is a global minor mode. If called interactively, toggle the -`Helm-Minibuffer-History mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable the -mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the mode -if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `(default-value \\='helm-minibuffer-history-mode)'. - -The mode's hook is called both when the mode is enabled and when it is -disabled. - -(fn &optional ARG)" t) -(autoload 'helm-world-time "helm-misc" "\ -Preconfigured `helm' to show world time. -Default action change TZ environment variable locally to emacs." t) -(autoload 'helm-insert-latex-math "helm-misc" "\ -Preconfigured helm for latex math symbols completion." t) -(autoload 'helm-ratpoison-commands "helm-misc" "\ -Preconfigured `helm' to execute ratpoison commands." t) -(autoload 'helm-stumpwm-commands "helm-misc" "\ -Preconfigured helm for stumpwm commands." t) -(autoload 'helm-minibuffer-history "helm-misc" "\ -Preconfigured `helm' for `minibuffer-history'." t) -(autoload 'helm-outline "helm-misc" "\ -Basic helm navigation tool for outline buffers. - -(fn &optional ARG)" t) -(register-definition-prefixes "helm-misc" '("helm-")) - - -;;; Generated autoloads from helm-mode.el - -(autoload 'helm-comp-read "helm-mode" "\ -Read a string in the minibuffer, with helm completion. - -It is helm `completing-read' equivalent. - -- PROMPT is the prompt name to use. - -- COLLECTION can be a list, alist, vector, obarray or hash-table. - For alists and hash-tables their car are use as real value of - candidate unless ALISTP is non-nil. - It can be also a function that receives three arguments: - the values string, predicate and t. See `all-completions' for more details. - -Keys description: - -- TEST: A predicate called with one arg i.e candidate. - -- INITIAL-INPUT: Same as input arg in `helm'. - -- PRESELECT: See preselect arg of `helm'. - -- DEFAULT: This option is used only for compatibility with regular - Emacs `completing-read' (Same as DEFAULT arg of `completing-read'). - -- BUFFER: Name of helm-buffer. - -- MUST-MATCH: Candidate selected must be one of COLLECTION. - -- FUZZY: Enable fuzzy matching. - -- REVERSE-HISTORY: When non--nil display history source after current - source completion. - -- REQUIRES-PATTERN: Same as helm attribute, default is 0. - -- HISTORY: A symbol where each result will be saved. - If not specified as a symbol an error will popup. - When specified, all elements of HISTORY are displayed in - a special source before or after COLLECTION according to REVERSE-HISTORY. - The main difference with INPUT-HISTORY is that the result of the - completion is saved whereas in INPUT-HISTORY it is the minibuffer - contents which is saved when you exit. - Don't use the same symbol for INPUT-HISTORY and HISTORY. - NOTE: As mentionned above this has nothing to do with - `minibuffer-history-variable', therefore if you want to save this - history persistently, you will have to add this variable to the - relevant variable of your favorite tool for persistent emacs session - i.e. psession, desktop etc... - -- RAW-HISTORY: When non-nil do not remove backslashs if some in - HISTORY candidates. - -- INPUT-HISTORY: A symbol. The minibuffer input history will be - stored there, if nil or not provided, `minibuffer-history' - will be used instead. You can navigate in this history with - `M-p' and `M-n'. - Don't use the same symbol for INPUT-HISTORY and HISTORY. - -- CASE-FOLD: Same as `helm-case-fold-search'. - -- PERSISTENT-ACTION: A function called with one arg i.e candidate. - -- PERSISTENT-HELP: A string to document PERSISTENT-ACTION. - -- MODE-LINE: A string or list to display in mode line. - Default is `helm-comp-read-mode-line'. - -- KEYMAP: A keymap to use in this `helm-comp-read'. - (the keymap will be shared with history source) - -- NAME: The name related to this local source. - -- HEADER-NAME: A function to alter NAME, see `helm'. - -- EXEC-WHEN-ONLY-ONE: Bound `helm-execute-action-at-once-if-one' - to non--nil. (possibles values are t or nil). - -- VOLATILE: Use volatile attribute. - -- SORT: A predicate to give to `sort' e.g `string-lessp' - Use this only on small data as it is inefficient. - If you want to sort faster add a sort function to - FC-TRANSFORMER. - Note that FUZZY when enabled is already providing a sort function. - -- FC-TRANSFORMER: A `filtered-candidate-transformer' function - or a list of functions. - -- HIST-FC-TRANSFORMER: A `filtered-candidate-transformer' - function for the history source. - -- MARKED-CANDIDATES: If non-nil return candidate or marked candidates as a list. - -- NOMARK: When non--nil don't allow marking candidates. - -- ALISTP: - When non-nil (default) pass the value of (DISPLAY . REAL) - candidate in COLLECTION to action when COLLECTION is an alist or a - hash-table, otherwise DISPLAY is always returned as result on exit, - which is the default when using `completing-read'. - See `helm-comp-read-get-candidates'. - -- CANDIDATES-IN-BUFFER: when non--nil use a source build with - `helm-source-in-buffer' which is much faster. - Argument VOLATILE have no effect when CANDIDATES-IN-BUFFER is non--nil. - -- GET-LINE: Specify the :get-line slot of `helm-source-in-buffer', has no effect - when CANDIDATES-IN-BUFFER is nil. - -- MATCH-PART: Allow matching only one part of candidate. - See match-part documentation in `helm-source'. - -- MATCH-DYNAMIC: See match-dynamic in `helm-source-sync' - It has no effect when used with CANDIDATES-IN-BUFFER. - -- ALLOW-NEST: Allow nesting this `helm-comp-read' in a helm session. - See `helm'. - -- MULTILINE: See multiline in `helm-source'. - -- COERCE: See coerce in `helm-source'. - -- RAW-CANDIDATE: Do not unquote the unknown candidate coming from helm-pattern - when non nil. - -- GROUP: See group in `helm-source'. - -Any prefix args passed during `helm-comp-read' invocation will be recorded -in `helm-current-prefix-arg', otherwise if prefix args were given before -`helm-comp-read' invocation, the value of `current-prefix-arg' will be used. -That means you can pass prefix args before or after calling a command -that use `helm-comp-read'. See `helm-M-x' for example. - -(fn PROMPT COLLECTION &key TEST INITIAL-INPUT DEFAULT PRESELECT (BUFFER \"*Helm Completions*\") MUST-MATCH FUZZY REVERSE-HISTORY (REQUIRES-PATTERN 0) (HISTORY nil SHISTORY) RAW-HISTORY INPUT-HISTORY (CASE-FOLD helm-comp-read-case-fold-search) (PERSISTENT-ACTION nil) (PERSISTENT-HELP \"DoNothing\") (MODE-LINE helm-comp-read-mode-line) HELP-MESSAGE (KEYMAP helm-comp-read-map) (NAME \"Helm Completions\") HEADER-NAME CANDIDATES-IN-BUFFER (GET-LINE #\\='buffer-substring) DIACRITICS MATCH-PART MATCH-DYNAMIC EXEC-WHEN-ONLY-ONE QUIT-WHEN-NO-CAND (VOLATILE t) SORT FC-TRANSFORMER HIST-FC-TRANSFORMER (MARKED-CANDIDATES helm-comp-read-use-marked) NOMARK (ALISTP t) (CANDIDATE-NUMBER-LIMIT helm-candidate-number-limit) MULTILINE ALLOW-NEST COERCE RAW-CANDIDATE (GROUP \\='helm) POPUP-INFO)") -(autoload 'helm-read-file-name "helm-mode" "\ -Read a file name with helm completion. - -It is helm `read-file-name' emulation. - -Argument PROMPT is the default prompt to use. - -Keys description: - -- NAME: Source name, default to \"Read File Name\". - -- INITIAL-INPUT: Where to start reading file name, - default to `default-directory' or $HOME. - -- BUFFER: `helm-buffer' name, defaults to \"*Helm Completions*\". - -- TEST: A predicate called with one arg \\='candidate'. - -- NORET: Allow disabling helm-ff-RET (have no effect if helm-ff-RET - isn't bound to RET). - -- CASE-FOLD: Same as `helm-case-fold-search'. - -- PRESELECT: helm preselection. - -- HISTORY: Display HISTORY in a special source. - -- MUST-MATCH: Can be \\='confirm, nil, or t. - -- FUZZY: Enable fuzzy matching when non-nil (Enabled by default). - -- MARKED-CANDIDATES: When non--nil return a list of marked candidates - otherwise a single filename is returned. - -- ALL-MARKED: Allow marking several dummy candidates. - -- NOMARK: When non--nil don't allow marking candidates. - -- ALISTP: Don't use `all-completions' in history - (take effect only on history). - -- PERSISTENT-ACTION-IF: a persistent if action function. - -- PERSISTENT-HELP: persistent help message. - -- MODE-LINE: A mode line message, default is - `helm-read-file-name-mode-line-string'. - -(fn PROMPT &key (NAME \"Read File Name\") INITIAL-INPUT (BUFFER \"*Helm file completions*\") TEST NORET (CASE-FOLD helm-file-name-case-fold-search) PRESELECT HISTORY MUST-MATCH (FUZZY t) DEFAULT MARKED-CANDIDATES ALL-MARKED (CANDIDATE-NUMBER-LIMIT helm-ff-candidate-number-limit) NOMARK (ALISTP t) (PERSISTENT-ACTION-IF \\='helm-find-files-persistent-action-if) (PERSISTENT-HELP \"Hit1 Expand Candidate, Hit2 or (C-u) Find file\") (MODE-LINE helm-read-file-name-mode-line-string))") -(autoload 'helm-dynamic-completion "helm-mode" "\ -Build a completion function for `helm-pattern' in COLLECTION. - -Only the elements of COLLECTION that satisfy PREDICATE are considered. - -Argument POINT is the 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 has -to be provided if needed either with an FCT function in source or -by passing the sort function with METADATA -E.g.: \\='((metadata (display-sort-function . foo))). -Candidates can be modified by passing an affixation-function in METADATA. - -If you don't want the sort fn provided by style to kick -in (emacs-27) you can use as metadata value the symbol `nosort'. - -Example: - - (helm :sources (helm-build-sync-source \"test\" - :candidates (helm-dynamic-completion - \\='(foo bar baz foab) - \\='symbolp) - :match-dynamic t) - :buffer \"*helm test*\") - -When argument NOMODE is non nil don't use `completion-styles' as -specified in `helm-completion-styles-alist' for specific modes. - -When STYLES is specified use these `completion-styles', see -`helm--prepare-completion-styles'. - -Also `helm-completion-style' settings have no effect here, -`emacs' being used inconditionally as value. - -(fn COLLECTION PREDICATE &optional POINT METADATA NOMODE STYLES)") -(defvar helm-mode nil "\ -Non-nil if Helm mode is enabled. -See the `helm-mode' command -for a description of this minor mode. -Setting this variable directly does not take effect; -either customize it (see the info node `Easy Customization') -or call the function `helm-mode'.") -(custom-autoload 'helm-mode "helm-mode" nil) -(autoload 'helm-mode "helm-mode" "\ -Toggle generic helm completion. - -All functions in Emacs that use `completing-read', -`read-file-name', `completion-in-region' and friends will use helm -interface when this mode is turned on. - -However you can modify this behavior for functions of your choice -with `helm-completing-read-handlers-alist'. - -Called with a positive arg, turn on unconditionally, with a -negative arg turn off. -You can toggle it with M-x `helm-mode'. - -About `ido-mode': -DO NOT enable `ido-everywhere' when using `helm-mode'. Instead of -using `ido-mode', add the commands where you want to use ido to -`helm-completing-read-handlers-alist' with `ido' as value. - -Note: This mode is incompatible with Emacs23. - -(fn &optional ARG)" t) -(register-definition-prefixes "helm-mode" '("helm-")) - - -;;; Generated autoloads from helm-net.el - -(autoload 'helm-browse-url-firefox "helm-net" "\ -Same as `browse-url-firefox' but detach from Emacs. - -So when you quit Emacs you can keep your Firefox session open and -not be prompted to kill the Firefox process. - -NOTE: Probably not supported on some systems (e.g., Windows). - -(fn URL &optional IGNORE)" t) -(autoload 'helm-browse-url-opera "helm-net" "\ -Browse URL with Opera browser and detach from Emacs. - -So when you quit Emacs you can keep your Opera session open and -not be prompted to kill the Opera process. - -NOTE: Probably not supported on some systems (e.g., Windows). - -(fn URL &optional IGNORE)" t) -(autoload 'helm-browse-url-chromium "helm-net" "\ -Same as `browse-url-chromium' but detach from emacs. - -So when you quit Emacs you can keep your Chromium session open and -not be prompted to kill the Chromium process. - -NOTE: Probably not supported on some systems (e.g., Windows). - -(fn URL &optional IGNORE)" t) -(autoload 'helm-browse-url-brave "helm-net" "\ -Browse URL with Brave browser and detach from emacs. - -Brave browser executable is determined by `helm-browse-url-brave-program'. - -So when you quit Emacs you can keep your Opera session open and -not be prompted to kill the Opera process. - -NOTE: Probably not supported on some systems (e.g., Windows). - -(fn URL &optional IGNORE)" t) -(autoload 'helm-browse-url-uzbl "helm-net" "\ -Browse URL with uzbl browser. - -(fn URL &optional IGNORE)" t) -(autoload 'helm-browse-url-conkeror "helm-net" "\ -Browse URL with conkeror browser. - -(fn URL &optional IGNORE)" t) -(autoload 'helm-browse-url-nyxt "helm-net" "\ -Browse URL with nyxt browser. - -(fn URL &optional IGNORE)" t) -(autoload 'helm-surfraw "helm-net" "\ -Preconfigured `helm' to search PATTERN with search ENGINE. - -(fn PATTERN ENGINE)" t) -(autoload 'helm-google-suggest "helm-net" "\ -Preconfigured `helm' for Google search with Google suggest." t) -(register-definition-prefixes "helm-net" '("helm-")) - - -;;; Generated autoloads from helm-occur.el - -(autoload 'helm-occur "helm-occur" "\ -Preconfigured helm for searching lines matching pattern in `current-buffer'. - -When `helm-source-occur' is member of -`helm-sources-using-default-as-input' which is the default, -symbol at point is searched at startup. - -When a region is marked search only in this region by narrowing. - -To search in multiples buffers start from one of the commands listing -buffers (i.e. a helm command using `helm-source-buffers-list' like -`helm-mini') and use the multi occur buffers action. - -This is the helm implementation that collect lines matching pattern -like vanilla Emacs `occur' but have nothing to do with it, the search -engine beeing completely different and also much faster." t) -(autoload 'helm-occur-visible-buffers "helm-occur" "\ -Run helm-occur on all visible buffers in frame." t) -(autoload 'helm-occur-from-isearch "helm-occur" "\ -Invoke `helm-occur' from isearch. - -To use this bind it to a key in `isearch-mode-map'." t) -(autoload 'helm-multi-occur-from-isearch "helm-occur" "\ -Invoke `helm-multi-occur' from isearch. - -With a prefix arg, reverse the behavior of -`helm-moccur-always-search-in-current'. -The prefix arg can be set before calling -`helm-multi-occur-from-isearch' or during the buffer selection. - -To use this bind it to a key in `isearch-mode-map'." t) -(register-definition-prefixes "helm-occur" '("helm-")) - - -;;; Generated autoloads from helm-packages.el - -(autoload 'helm-packages "helm-packages" "\ -Helm interface to manage packages. - -With a prefix arg ARG refresh package list. - -When installing or upgrading ensure to refresh the package list -to avoid errors with outdated packages no more availables. - -(fn &optional ARG)" t) -(autoload 'helm-finder "helm-packages" "\ -Helm interface to find packages by keywords with `finder'. -To have more actions on packages, use `helm-packages'. - -(fn &optional ARG)" t) -(register-definition-prefixes "helm-packages" '("helm-")) - - -;;; Generated autoloads from helm-regexp.el - -(autoload 'helm-regexp "helm-regexp" "\ -Preconfigured helm to build regexps. -`query-replace-regexp' can be run from there against found regexp." t) -(register-definition-prefixes "helm-regexp" '("helm-")) - - -;;; Generated autoloads from helm-ring.el - -(autoload 'helm-mark-ring "helm-ring" "\ -Preconfigured `helm' for `helm-source-mark-ring'." t) -(autoload 'helm-global-mark-ring "helm-ring" "\ -Preconfigured `helm' for `helm-source-global-mark-ring'." t) -(autoload 'helm-all-mark-rings "helm-ring" "\ -Preconfigured `helm' for mark rings. -Source used are `helm-source-global-mark-ring' and -`helm-source-mark-ring'." t) -(autoload 'helm-register "helm-ring" "\ -Preconfigured `helm' for Emacs registers." t) -(autoload 'helm-show-kill-ring "helm-ring" "\ -Preconfigured `helm' for `kill-ring'. -It is drop-in replacement of `yank-pop'. - -First call open the kill-ring browser, next calls move to next line." t) -(autoload 'helm-execute-kmacro "helm-ring" "\ -Preconfigured helm for keyboard macros. -Define your macros with `f3' and `f4'. -See (info \"(emacs) Keyboard Macros\") for detailed infos." t) -(register-definition-prefixes "helm-ring" '("helm-")) - - -;;; Generated autoloads from helm-semantic.el - -(autoload 'helm-semantic "helm-semantic" "\ -Preconfigured `helm' for `semantic'. -If ARG is supplied, pre-select symbol at point instead of current. - -(fn ARG)" t) -(autoload 'helm-semantic-or-imenu "helm-semantic" "\ -Preconfigured helm for `semantic' or `imenu'. -If ARG is supplied, pre-select symbol at point instead of current -semantic tag in scope. - -If `semantic-mode' is active in the current buffer, then use -semantic for generating tags, otherwise fall back to `imenu'. -Fill in the symbol at point by default. - -(fn ARG)" t) -(register-definition-prefixes "helm-semantic" '("helm-s")) - - -;;; Generated autoloads from helm-sys.el - -(defvar helm-top-poll-mode nil "\ -Non-nil if Helm-Top-Poll mode is enabled. -See the `helm-top-poll-mode' command -for a description of this minor mode. -Setting this variable directly does not take effect; -either customize it (see the info node `Easy Customization') -or call the function `helm-top-poll-mode'.") -(custom-autoload 'helm-top-poll-mode "helm-sys" nil) -(autoload 'helm-top-poll-mode "helm-sys" "\ -Refresh automatically helm top buffer once enabled. - -This is a global minor mode. If called interactively, toggle the -`Helm-Top-Poll mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the mode -if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `(default-value \\='helm-top-poll-mode)'. - -The mode's hook is called both when the mode is enabled and when it is -disabled. - -(fn &optional ARG)" t) -(autoload 'helm-top "helm-sys" "\ -Preconfigured `helm' for top command. -When prefix arg ARG is non nil toggle auto updating mode `helm-top-poll-mode'. - -(fn &optional ARG)" t) -(autoload 'helm-list-emacs-process "helm-sys" "\ -Preconfigured `helm' for Emacs process." t) -(autoload 'helm-xrandr-set "helm-sys" "\ -Preconfigured helm for xrandr." t) -(register-definition-prefixes "helm-sys" '("helm-")) - - -;;; Generated autoloads from helm-tags.el - -(autoload 'helm-etags-select "helm-tags" "\ -Preconfigured helm for etags. -If called with a prefix argument REINIT -or if any of the tag files have been modified, reinitialize cache. - -This function aggregates three sources of tag files: - - 1) An automatically located file in the parent directories, - by `helm-etags-get-tag-file'. - 2) `tags-file-name', which is commonly set by `find-tag' command. - 3) `tags-table-list' which is commonly set by `visit-tags-table' command. - -(fn REINIT)" t) -(register-definition-prefixes "helm-tags" '("helm-")) - - -;;; Generated autoloads from helm-types.el - -(register-definition-prefixes "helm-types" '("helm-")) - - -;;; Generated autoloads from helm-utils.el - -(defvar helm-popup-tip-mode nil "\ -Non-nil if Helm-Popup-Tip mode is enabled. -See the `helm-popup-tip-mode' command -for a description of this minor mode. -Setting this variable directly does not take effect; -either customize it (see the info node `Easy Customization') -or call the function `helm-popup-tip-mode'.") -(custom-autoload 'helm-popup-tip-mode "helm-utils" nil) -(autoload 'helm-popup-tip-mode "helm-utils" "\ -Show additional informations in a popup tip at end of line. - -When the mode is enabled, popup showup when the source -has a `popup-info' attribute which define a specific function for -this source to fetch infos on candidate. - -This is a global minor mode. If called interactively, toggle the -`Helm-Popup-Tip mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the mode -if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `(default-value \\='helm-popup-tip-mode)'. - -The mode's hook is called both when the mode is enabled and when it is -disabled. - -(fn &optional ARG)" t) -(register-definition-prefixes "helm-utils" '("helm-" "with-helm-display-marked-candidates")) - - -;;; Generated autoloads from helm-x-files.el - -(register-definition-prefixes "helm-x-files" '("helm-")) - - -;;; Generated autoloads from helm-x-icons.el - -(register-definition-prefixes "helm-x-icons" '("helm-x-icons-")) - -;;; End of scraped data - -(provide 'helm-autoloads) - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; no-native-compile: t -;; coding: utf-8-emacs-unix -;; End: - -;;; helm-autoloads.el ends here diff --git a/elpa/helm-20251212.555/helm-bookmark.el b/elpa/helm-20251212.555/helm-bookmark.el deleted file mode 100644 index 98e6d7f8..00000000 --- a/elpa/helm-20251212.555/helm-bookmark.el +++ /dev/null @@ -1,964 +0,0 @@ -;;; helm-bookmark.el --- Helm for Emacs regular Bookmarks. -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2025 Thierry Volpiatto - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Code: -(require 'cl-lib) -(require 'bookmark) -(require 'helm) -(require 'helm-lib) -(require 'helm-help) -(require 'helm-types) -(require 'helm-utils) -(require 'helm-info) -(require 'helm-adaptive) -(require 'helm-net) -(require 'helm-x-icons) - -(declare-function helm-browse-project "helm-files" (arg)) -(declare-function addressbook-bookmark-edit "ext:addressbook-bookmark.el" (bookmark)) -(declare-function eww-read-bookmarks "eww") - -(defvar eww-bookmarks) - - -(defgroup helm-bookmark nil - "Predefined configurations for `helm.el'." - :group 'helm) - -(defcustom helm-bookmark-show-location nil - "Show location of bookmark on display." - :type 'boolean) - -(defcustom helm-bookmark-default-filtered-sources - (append '(helm-source-bookmark-org - helm-source-bookmark-files&dirs - helm-source-bookmark-helm-find-files - helm-source-bookmark-info - helm-source-bookmark-gnus - helm-source-bookmark-mu4e - helm-source-bookmark-man - helm-source-bookmark-images - helm-source-bookmark-w3m) - (list 'helm-source-bookmark-uncategorized - 'helm-source-bookmark-set)) - "List of sources to use in `helm-filtered-bookmarks'." - :type '(repeat (choice symbol))) - -(defcustom helm-bookmark-use-icon nil - "Display candidates with an icon with `all-the-icons' when non nil. -Don't use `setq' to set this." - :type 'boolean - :set (lambda (var val) - (set var (and (require helm-x-icons-provider nil t) val)))) - -(defcustom helm-bookmark-default-sort-method 'adaptive - "Sort method for `helm-filtered-bookmarks'. - -Value can be either \\='native' or \\='adaptive'. - -See `helm-adaptive-sort' for infos on \\='native'. - -Once you use \\='native' the bookmark variable `bookmark-sort-flag' -will be honored." - :type '(choice - (symbol :tag "Helm adaptive sort method" adaptive) - (symbol :tag "Native bookmark sort method" native)) - ;; Don't use the :set function until functions and variables below - ;; are not loaded i.e. use set-default only for now. - :initialize 'custom-initialize-changed - :set (lambda (var val) - (set var val) - (cl-loop for s in (remove 'helm-source-bookmark-set - helm-bookmark-default-filtered-sources) - for fn = (intern (format "%s-builder" s)) - do (set s (funcall fn))))) - -(defcustom helm-bookmark-annotation-sign "*" - "Boomarks with annotation are prefixed with this string." - :type 'string) - -(defgroup helm-bookmark-faces nil - "Customize the appearance of helm-bookmark." - :prefix "helm-" - :group 'helm-bookmark - :group 'helm-faces) - -(defface helm-bookmark-info - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :foreground "green")) - "Face used for W3m Emacs bookmarks (not w3m bookmarks)." - :group 'helm-bookmark-faces) - -(defface helm-bookmark-w3m - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :foreground "yellow")) - "Face used for W3m Emacs bookmarks (not w3m bookmarks)." - :group 'helm-bookmark-faces) - -(defface helm-bookmark-gnus - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :foreground "magenta")) - "Face used for Gnus bookmarks." - :group 'helm-bookmark-faces) - -(defface helm-bookmark-man - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :foreground "orange4")) - "Face used for Woman/man bookmarks." - :group 'helm-bookmark-faces) - -(defface helm-bookmark-file - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :foreground "DeepSkyBlue2")) - "Face used for file bookmarks." - :group 'helm-bookmark-faces) - -(defface helm-bookmark-file-not-found - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :foreground "SlateGray4")) - "Face used for file bookmarks." - :group 'helm-bookmark-faces) - -(defface helm-bookmark-directory - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :inherit helm-ff-directory)) - "Face used for file bookmarks." - :group 'helm-bookmark-faces) - -(defface helm-bookmark-addressbook - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :foreground "tomato")) - "Face used for addressbook bookmarks." - :group 'helm-bookmark-faces) - - -(defvar helm-bookmark-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-map) - (define-key map (kbd "C-c o") #'helm-bookmark-run-jump-other-window) - (define-key map (kbd "C-c C-o") #'helm-bookmark-run-jump-other-frame) - (define-key map (kbd "C-c C-t") #'helm-bookmark-run-jump-other-tab) - (define-key map (kbd "C-d") #'helm-bookmark-run-delete) - (define-key map (kbd "C-]") #'helm-bookmark-toggle-filename) - (define-key map (kbd "M-e") #'helm-bookmark-run-edit) - map) - "Generic Keymap for Emacs bookmark sources.") - -(defclass helm-source-basic-bookmarks (helm-source-in-buffer helm-type-bookmark) - ((init :initform (lambda () - (bookmark-maybe-load-default-file) - (helm-init-candidates-in-buffer - 'global - (if (and (fboundp 'bookmark-maybe-sort-alist) - (fboundp 'bookmark-name-from-full-record)) - (mapcar 'bookmark-name-from-full-record - (bookmark-maybe-sort-alist)) - (bookmark-all-names))))) - (filtered-candidate-transformer :initform 'helm-bookmark-transformer) - (find-file-target :initform #'helm-bookmarks-quit-an-find-file-fn))) - -(defvar helm-source-bookmarks - (helm-make-source "Bookmarks" 'helm-source-basic-bookmarks) - "See (info \"(emacs)Bookmarks\").") - -(defun helm-bookmark-transformer (candidates _source) - (cl-loop for i in candidates - for loc = (bookmark-location i) - for len = (string-width i) - for trunc = (if (> len bookmark-bmenu-file-column) - (helm-substring i bookmark-bmenu-file-column) - i) - for sep = (make-string (- (+ bookmark-bmenu-file-column 2) - (length trunc)) - ? ) - if helm-bookmark-show-location - collect (cons (concat trunc sep (if (listp loc) (car loc) loc)) i) - else collect i)) - -(defun helm-bookmark-toggle-filename-1 (_candidate) - (let* ((real (helm-get-selection helm-buffer)) - (trunc (if (> (string-width real) bookmark-bmenu-file-column) - (helm-substring real bookmark-bmenu-file-column) - real))) - (setq helm-bookmark-show-location (not helm-bookmark-show-location)) - (helm-update (if helm-bookmark-show-location - (regexp-quote trunc) - (regexp-quote real))))) - -(helm-make-persistent-command-from-action helm-bookmark-toggle-filename - "Toggle bookmark location visibility." - 'toggle-filename 'helm-bookmark-toggle-filename-1) - -(defun helm-bookmark-jump-1 (candidate &optional fn) - (let (;; FIXME Why is prefarg necessary here? - (current-prefix-arg helm-current-prefix-arg) - non-essential) - (bookmark-jump candidate fn))) - -(defun helm-bookmark-jump (candidate) - "Jump to bookmark action." - (helm-bookmark-jump-1 candidate)) - -(defun helm-bookmark-jump-other-frame (candidate) - "Jump to bookmark in other frame action." - (helm-bookmark-jump-1 candidate #'switch-to-buffer-other-frame)) - -(defun helm-bookmark-jump-other-window (candidate) - "Jump to bookmark in other window action." - (helm-bookmark-jump-1 candidate #'switch-to-buffer-other-window)) - -(defun helm-bookmark-jump-other-tab (candidate) - "Jump to bookmark action." - (cl-assert (fboundp 'tab-bar-mode) nil "Tab-bar-mode not available") - (helm-bookmark-jump-1 candidate #'switch-to-buffer-other-tab)) - -;;; bookmark-set -;; -(defvar helm-source-bookmark-set - (helm-build-dummy-source "Set Bookmark" - :filtered-candidate-transformer - (lambda (_candidates _source) - (list (or (and (not (string= helm-pattern "")) - helm-pattern) - "Enter a bookmark name to record"))) - :action `(("Set bookmark" . ,(lambda (candidate) - (if (string= helm-pattern "") - (message "No bookmark name given for record") - (bookmark-set candidate)))))) - "See (info \"(emacs)Bookmarks\").") - - -;;; Predicates -;; -(defconst helm-bookmark--non-file-filename " - no file -" - "Name to use for `filename' entry, for non-file bookmarks.") - -(defun helm-bookmark-gnus-bookmark-p (bookmark) - "Return non-nil if BOOKMARK is a Gnus bookmark. -BOOKMARK is a bookmark name or a bookmark record." - (or (eq (bookmark-get-handler bookmark) 'bmkext-jump-gnus) - (eq (bookmark-get-handler bookmark) 'gnus-summary-bookmark-jump) - (eq (bookmark-get-handler bookmark) 'bookmarkp-jump-gnus) - (eq (bookmark-get-handler bookmark) 'bmkp-jump-gnus))) - -(defun helm-bookmark-mu4e-bookmark-p (bookmark) - "Return non nil if BOOKMARK is a mu4e bookmark. -BOOKMARK is a bookmark name or a bookmark record." - (memq (bookmark-get-handler bookmark) - '(mu4e-bookmark-jump mu4e--jump-to-bookmark))) - -(defun helm-bookmark-w3m-bookmark-p (bookmark) - "Return non-nil if BOOKMARK is a W3m bookmark. -BOOKMARK is a bookmark name or a bookmark record." - (or (eq (bookmark-get-handler bookmark) 'bmkext-jump-w3m) - (eq (bookmark-get-handler bookmark) 'bookmark-w3m-bookmark-jump) - (eq (bookmark-get-handler bookmark) 'bookmarkp-jump-w3m) - (eq (bookmark-get-handler bookmark) 'bmkp-jump-w3m))) - -(defun helm-bookmark-eww-bookmark-p (bookmark) - "Return non-nil if BOOKMARK is an Eww bookmark. -BOOKMARK is a bookmark name or a bookmark record." - (eq (bookmark-get-handler bookmark) 'eww-bookmark-jump)) - -(defun helm-bookmark-woman-bookmark-p (bookmark) - "Return non-nil if BOOKMARK is a Woman bookmark. -BOOKMARK is a bookmark name or a bookmark record." - (or (eq (bookmark-get-handler bookmark) 'bmkext-jump-woman) - (eq (bookmark-get-handler bookmark) 'woman-bookmark-jump) - (eq (bookmark-get-handler bookmark) 'bookmarkp-jump-woman) - (eq (bookmark-get-handler bookmark) 'bmkp-jump-woman))) - -(defun helm-bookmark-man-bookmark-p (bookmark) - "Return non-nil if BOOKMARK is a Man bookmark. -BOOKMARK is a bookmark name or a bookmark record." - (or (eq (bookmark-get-handler bookmark) 'bmkext-jump-man) - (eq (bookmark-get-handler bookmark) 'Man-bookmark-jump) - (eq (bookmark-get-handler bookmark) 'bookmarkp-jump-man) - (eq (bookmark-get-handler bookmark) 'bmkp-jump-man))) - -(defun helm-bookmark-woman-man-bookmark-p (bookmark) - "Return non-nil if BOOKMARK is a Man or Woman bookmark. -BOOKMARK is a bookmark name or a bookmark record." - (or (helm-bookmark-man-bookmark-p bookmark) - (helm-bookmark-woman-bookmark-p bookmark))) - -(defun helm-bookmark-info-bookmark-p (bookmark) - "Return non-nil if BOOKMARK is an Info bookmark. -BOOKMARK is a bookmark name or a bookmark record." - (eq (bookmark-get-handler bookmark) 'Info-bookmark-jump)) - -(defun helm-bookmark-image-bookmark-p (bookmark) - "Return non-nil if BOOKMARK bookmarks an image file." - (if (stringp bookmark) - (assq 'image-type (assq bookmark bookmark-alist)) - (assq 'image-type bookmark))) - -(defun helm-bookmark-file-p (bookmark) - "Return non-nil if BOOKMARK bookmarks a file or directory. -BOOKMARK is a bookmark name or a bookmark record. -This excludes bookmarks of a more specific kind (Info, Gnus, and W3m)." - (let* ((filename (bookmark-get-filename bookmark)) - (isnonfile (equal filename helm-bookmark--non-file-filename))) - (and filename - (not isnonfile) - (not (helm-bookmark-org-file-p bookmark)) - (not (bookmark-get-handler bookmark))))) - -(defun helm-bookmark-org-file-p (bookmark) - (let* ((filename (bookmark-get-filename bookmark))) - (or (string-suffix-p ".org" filename t) - (string-suffix-p ".org_archive" filename t)))) - -(defun helm-bookmark-helm-find-files-p (bookmark) - "Return non-nil if BOOKMARK bookmarks a `helm-find-files' session. -BOOKMARK is a bookmark name or a bookmark record." - (eq (bookmark-get-handler bookmark) 'helm-ff-bookmark-jump)) - -(defun helm-bookmark-addressbook-p (bookmark) - "Return non--nil if BOOKMARK is a contact recorded with addressbook-bookmark. -BOOKMARK is a bookmark name or a bookmark record." - (if (listp bookmark) - (string= (assoc-default 'type bookmark) "addressbook") - (string= (assoc-default - 'type (assoc bookmark bookmark-alist)) "addressbook"))) - -(defun helm-bookmark-uncategorized-bookmark-p (bookmark) - "Return non--nil if BOOKMARK match no known category." - (cl-loop for pred in '(helm-bookmark-org-file-p - helm-bookmark-addressbook-p - helm-bookmark-gnus-bookmark-p - helm-bookmark-mu4e-bookmark-p - helm-bookmark-w3m-bookmark-p - helm-bookmark-woman-man-bookmark-p - helm-bookmark-info-bookmark-p - helm-bookmark-image-bookmark-p - helm-bookmark-file-p - helm-bookmark-helm-find-files-p - helm-bookmark-addressbook-p - helm-bookmark-eww-bookmark-p) - never (funcall pred bookmark))) - -(defun helm-bookmark-filter-setup-alist (fn) - "Return a filtered `bookmark-alist' sorted alphabetically." - (cl-loop for b in (if (and (fboundp 'bookmark-maybe-sort-alist) - (eq helm-bookmark-default-sort-method 'native)) - (bookmark-maybe-sort-alist) - bookmark-alist) - for name = (car b) - when (funcall fn b) collect - (propertize name 'location (bookmark-location name)))) - -;;; Bookmark handlers -;; -(defvar w3m-async-exec) -(defun helm-bookmark-jump-w3m (bookmark) - "Jump to W3m bookmark BOOKMARK, setting a new tab. -If `browse-url-browser-function' is set to something else than -`w3m-browse-url' use it." - (require 'helm-net) - (let* ((file (or (bookmark-prop-get bookmark 'filename) - (bookmark-prop-get bookmark 'url))) - (buf (generate-new-buffer-name "*w3m*")) - (w3m-async-exec nil) - ;; If user don't have anymore w3m installed let it browse its - ;; bookmarks with default browser otherwise assume bookmark - ;; have been bookmarked from w3m and use w3m. - (browse-url-browser-function (or (and (fboundp 'w3m-browse-url) - (executable-find "w3m") - 'w3m-browse-url) - browse-url-browser-function)) - (really-use-w3m (equal browse-url-browser-function 'w3m-browse-url))) - (helm-browse-url file really-use-w3m) - (when really-use-w3m - (bookmark-default-handler - `("" (buffer . ,buf) . ,(bookmark-get-bookmark-record bookmark)))))) - -;; All bookmarks recorded with the handler provided with w3m -;; (`bookmark-w3m-bookmark-jump') will use our handler which open -;; the bookmark in a new tab or in an external browser depending -;; on `browse-url-browser-function'. -(defalias 'bookmark-w3m-bookmark-jump #'helm-bookmark-jump-w3m) - -;; Provide compatibility with old handlers provided in external -;; packages bookmark-extensions.el and bookmark+. -(defalias 'bmkext-jump-woman #'woman-bookmark-jump) -(defalias 'bmkext-jump-man #'Man-bookmark-jump) -(defalias 'bmkext-jump-w3m #'helm-bookmark-jump-w3m) -(defalias 'bmkext-jump-gnus #'gnus-summary-bookmark-jump) -(defalias 'bookmarkp-jump-gnus #'gnus-summary-bookmark-jump) -(defalias 'bookmarkp-jump-w3m #'helm-bookmark-jump-w3m) -(defalias 'bookmarkp-jump-woman #'woman-bookmark-jump) -(defalias 'bookmarkp-jump-man #'Man-bookmark-jump) -(defalias 'bmkp-jump-gnus #'gnus-summary-bookmark-jump) -(defalias 'bmkp-jump-w3m #'helm-bookmark-jump-w3m) -(defalias 'bmkp-jump-woman #'woman-bookmark-jump) -(defalias 'bmkp-jump-man #'Man-bookmark-jump) - - -;;;; Filtered bookmark sources -;; -;; -(defclass helm-source-filtered-bookmarks (helm-source-in-buffer helm-type-bookmark) - ((filtered-candidate-transformer - :initform (delq nil - `(,(and (eq helm-bookmark-default-sort-method 'adaptive) - 'helm-adaptive-sort) - helm-highlight-bookmark))) - (find-file-target :initform #'helm-bookmarks-quit-an-find-file-fn))) - -(defun helm-bookmarks-quit-an-find-file-fn (source) - (let* ((sel (helm-get-selection nil nil source)) - (bmk (assoc (replace-regexp-in-string "\\`\\*" "" sel) - bookmark-alist))) - (helm-aif (bookmark-get-filename bmk) - (if (and helm--url-regexp - (string-match helm--url-regexp it)) - it (expand-file-name it)) - (expand-file-name default-directory)))) - -(defun helm-bookmark-build-source (name buildfn &optional class &rest args) - (apply #'helm-make-source name - (or class 'helm-source-filtered-bookmarks) - :init (lambda () - (bookmark-maybe-load-default-file) - (helm-init-candidates-in-buffer - 'global (funcall buildfn))) - args)) - -;;; W3m bookmarks. -;; -(defun helm-bookmark-w3m-setup-alist () - "Specialized filter function for bookmarks w3m." - (helm-bookmark-filter-setup-alist 'helm-bookmark-w3m-bookmark-p)) - -(defun helm-source-bookmark-w3m-builder () - (helm-bookmark-build-source "Bookmark W3m" #'helm-bookmark-w3m-setup-alist)) - -(defvar helm-source-bookmark-w3m (helm-source-bookmark-w3m-builder)) - -;;; Images -;; -(defun helm-bookmark-images-setup-alist () - "Specialized filter function for images bookmarks." - (helm-bookmark-filter-setup-alist 'helm-bookmark-image-bookmark-p)) - -(defun helm-source-bookmark-images-builder () - (helm-bookmark-build-source "Bookmark Images" #'helm-bookmark-images-setup-alist)) - -(defvar helm-source-bookmark-images (helm-source-bookmark-images-builder)) - -;;; EWW bookmarks -;; -(defun helm-bookmark-normalize-eww-bmks () - (unless eww-bookmarks (eww-read-bookmarks)) - (cl-loop for (_url url _title title _time _time) in eww-bookmarks do - (unless (bookmark-get-bookmark title t) - (push (list title (cons 'location url) - '(imported . t) - '(handler . eww-bookmark-jump)) - bookmark-alist) - (cl-incf bookmark-alist-modification-count)))) - -;;;###autoload -(defun helm-bookmark-import-eww-bookmarks () - "Import EWW bookmarks into bookmark-alist." - (interactive) - (when (y-or-n-p "Really import eww-bookmarks into bookmark-alist?") - (bookmark-maybe-load-default-file) - (helm-bookmark-normalize-eww-bmks))) - -(defun helm-bookmark-eww-setup-alist () - "Specialized filter function for Eww bookmarks." - (helm-bookmark-filter-setup-alist 'helm-bookmark-eww-bookmark-p)) - -(defun helm-source-bookmark-eww-builder () - (helm-bookmark-build-source "Bookmark EWW" #'helm-bookmark-eww-setup-alist)) - -(defvar helm-source-bookmark-eww (helm-source-bookmark-eww-builder)) - -;;; Woman Man -;; -(defun helm-bookmark-man-setup-alist () - "Specialized filter function for Man pages bookmarks." - (helm-bookmark-filter-setup-alist 'helm-bookmark-woman-man-bookmark-p)) - -(defun helm-source-bookmark-man-builder () - (helm-bookmark-build-source "Bookmark Woman&Man" #'helm-bookmark-man-setup-alist)) - -(defvar helm-source-bookmark-man (helm-source-bookmark-man-builder)) - -;;; Org files -;; -(defun helm-bookmark-org-setup-alist () - "Specialized filter function for Org file bookmarks." - (helm-bookmark-filter-setup-alist 'helm-bookmark-org-file-p)) - -(defun helm-source-bookmark-org-builder () - (helm-bookmark-build-source "Bookmark Org files" #'helm-bookmark-org-setup-alist)) - -(defvar helm-source-bookmark-org (helm-source-bookmark-org-builder)) - -;;; Gnus -;; -(defun helm-bookmark-gnus-setup-alist () - "Specialized filter function for bookmarks gnus." - (helm-bookmark-filter-setup-alist 'helm-bookmark-gnus-bookmark-p)) - -(defun helm-source-bookmark-gnus-builder () - (helm-bookmark-build-source "Bookmark Gnus" #'helm-bookmark-gnus-setup-alist)) - -(defvar helm-source-bookmark-gnus (helm-source-bookmark-gnus-builder)) - -;;; Mu4e -;; -(defun helm-bookmark-mu4e-setup-alist () - (helm-bookmark-filter-setup-alist 'helm-bookmark-mu4e-bookmark-p)) - -(defun helm-source-bookmark-mu4e-builder () - (helm-bookmark-build-source "Bookmark Mu4e" #'helm-bookmark-mu4e-setup-alist)) - -(defvar helm-source-bookmark-mu4e (helm-source-bookmark-mu4e-builder)) - -;;; Info -;; -(defun helm-bookmark-info-setup-alist () - "Specialized filter function for bookmarks info." - (helm-bookmark-filter-setup-alist 'helm-bookmark-info-bookmark-p)) - -(defun helm-source-bookmark-info-builder () - (helm-bookmark-build-source "Bookmark Info" #'helm-bookmark-info-setup-alist)) - -(defvar helm-source-bookmark-info (helm-source-bookmark-info-builder)) - -;;; Files and directories -;; -(defun helm-bookmark-local-files-setup-alist () - "Specialized filter function for bookmarks locals files." - (helm-bookmark-filter-setup-alist 'helm-bookmark-file-p)) - -(defun helm-source-bookmark-files&dirs-builder () - (helm-bookmark-build-source - "Bookmark Files&Directories" #'helm-bookmark-local-files-setup-alist)) - -(defvar helm-source-bookmark-files&dirs - (helm-source-bookmark-files&dirs-builder)) - -;;; Helm find files sessions. -;; -(defun helm-bookmark-helm-find-files-setup-alist () - "Specialized filter function for `helm-find-files' bookmarks." - (helm-bookmark-filter-setup-alist 'helm-bookmark-helm-find-files-p)) - -(defun helm-bookmark-browse-project (candidate) - "Run `helm-browse-project' from action." - (with-helm-default-directory - (bookmark-get-filename candidate) - (helm-browse-project nil))) - -(helm-make-command-from-action helm-bookmark-run-browse-project - "Run `helm-bookmark-browse-project' from keyboard." - 'helm-bookmark-browse-project) - -(defvar helm-bookmark-find-files-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-bookmark-map) - (define-key map (kbd "C-x C-d") #'helm-bookmark-run-browse-project) - map)) - -(defclass helm-bookmark-find-files-class (helm-source-filtered-bookmarks) ()) - -(cl-defmethod helm--setup-source ((source helm-bookmark-find-files-class)) - ;; Ensure `helm-source-in-buffer' method is called. - (setf (slot-value source 'action) - (helm-append-at-nth - (cl-loop for (name . action) in helm-type-bookmark-actions - ;; We don't want those actions in helm-find-files bookmarks. - unless (memq action '(helm-bookmark-jump-other-frame - helm-bookmark-jump-other-window - helm-bookmark-jump-other-tab - bookmark-set)) - collect (cons name action)) - '(("Browse project" . helm-bookmark-browse-project)) 1)) - (setf (slot-value source 'keymap) helm-bookmark-find-files-map)) - -(defun helm-source-bookmark-helm-find-files-builder () - (helm-bookmark-build-source - "Bookmark helm-find-files sessions" - #'helm-bookmark-helm-find-files-setup-alist - 'helm-bookmark-find-files-class - :persistent-action (lambda (_candidate) (ignore)) - :persistent-help "Do nothing")) - -(defvar helm-source-bookmark-helm-find-files - (helm-source-bookmark-helm-find-files-builder)) - -;;; Uncategorized bookmarks -;; -(defun helm-bookmark-uncategorized-setup-alist () - "Specialized filter function for uncategorized bookmarks." - (helm-bookmark-filter-setup-alist 'helm-bookmark-uncategorized-bookmark-p)) - -(defun helm-source-bookmark-uncategorized-builder () - (helm-bookmark-build-source - "Bookmark uncategorized" #'helm-bookmark-uncategorized-setup-alist)) - -(defvar helm-source-bookmark-uncategorized - (helm-source-bookmark-uncategorized-builder)) - - -;;; Transformer -;; -(defun helm-highlight-bookmark (bookmarks _source) - "Used as `filtered-candidate-transformer' to colorize bookmarks." - (let ((non-essential t)) - (cl-loop for i in bookmarks - for isfile = (bookmark-get-filename i) - for hff = (helm-bookmark-helm-find-files-p i) - for handlerp = (and (fboundp 'bookmark-get-handler) - (bookmark-get-handler i)) - for isw3m = (and (fboundp 'helm-bookmark-w3m-bookmark-p) - (helm-bookmark-w3m-bookmark-p i)) - for isgnus = (and (fboundp 'helm-bookmark-gnus-bookmark-p) - (helm-bookmark-gnus-bookmark-p i)) - for ismu4e = (and (fboundp 'helm-bookmark-mu4e-bookmark-p) - (helm-bookmark-mu4e-bookmark-p i)) - for isman = (and (fboundp 'helm-bookmark-man-bookmark-p) ; Man - (helm-bookmark-man-bookmark-p i)) - for iswoman = (and (fboundp 'helm-bookmark-woman-bookmark-p) ; Woman - (helm-bookmark-woman-bookmark-p i)) - for isannotation = (bookmark-get-annotation i) - for isabook = (string= (bookmark-prop-get i 'type) - "addressbook") - for isinfo = (eq handlerp 'Info-bookmark-jump) - for iseww = (eq handlerp 'eww-bookmark-jump) - for loc = (bookmark-location i) - for len = (string-width i) - for trunc = (if (and helm-bookmark-show-location - (> len bookmark-bmenu-file-column)) - (helm-substring - i bookmark-bmenu-file-column) - i) - for icon = (when helm-bookmark-use-icon - (cond ((and isfile hff) - (helm-aif (or (helm-x-icons-match-to-alist - (helm-basename (helm-basedir isfile t)) - 'dir) - (helm-x-icons-match-to-alist - (helm-basename isfile) - 'dir)) - (apply (car it) (cdr it)) - (helm-x-icons-generic "file-directory"))) - ((or isw3m iseww) - (helm-x-icons-generic "firefox")) - ((and isfile isinfo) (helm-x-icons-generic "info")) - ((or iswoman isman) - (helm-x-icons-generic "man-page")) - ((or isgnus ismu4e) - (helm-x-icons-generic "mail-read")) - (isfile (helm-x-icons-icon-for-file (helm-basename isfile))))) - ;; Add a * if bookmark have annotation - if (and isannotation (not (string-equal isannotation ""))) - do (setq trunc (concat helm-bookmark-annotation-sign - (if helm-bookmark-show-location trunc i))) - for sep = (and helm-bookmark-show-location - (make-string (- (+ bookmark-bmenu-file-column 2) - (string-width trunc)) - ? )) - for bmk = (cond ( ;; info buffers - isinfo - (propertize trunc 'face 'helm-bookmark-info - 'help-echo isfile)) - ( ;; w3m buffers - isw3m - (propertize trunc 'face 'helm-bookmark-w3m - 'help-echo isfile)) - ( ;; eww buffers - iseww - (propertize trunc 'face 'helm-bookmark-w3m - 'help-echo isfile)) - ( ;; gnus buffers - isgnus - (propertize trunc 'face 'helm-bookmark-gnus - 'help-echo isfile)) - ( ;; Man Woman - (or iswoman isman) - (propertize trunc 'face 'helm-bookmark-man - 'help-echo isfile)) - ( ;; Addressbook - isabook - (propertize trunc 'face 'helm-bookmark-addressbook)) - (;; Directories (helm-find-files) - hff - (if (and (file-remote-p isfile) - (not (file-remote-p isfile nil t))) - (propertize trunc 'face 'helm-bookmark-file-not-found - 'help-echo isfile) - (propertize trunc 'face 'helm-bookmark-directory - 'help-echo isfile))) - ( ;; Directories (dired) - (and isfile - ;; This is needed because `non-essential' - ;; is not working on Emacs-24.2 and the behavior - ;; of tramp seems to have changed since previous - ;; versions (Need to reenter password even if a - ;; first connection have been established, - ;; probably when host is named differently - ;; i.e machine/localhost) - (and (not (file-remote-p isfile)) - (file-directory-p isfile))) - (propertize trunc 'face 'helm-bookmark-directory - 'help-echo isfile)) - ( ;; Non existing files. - (and isfile - ;; Be safe and call `file-exists-p' - ;; only if file is not remote or - ;; remote but connected. - (or (and (file-remote-p isfile) - (not (file-remote-p isfile nil t))) - (not (file-exists-p isfile)))) - (propertize trunc 'face 'helm-bookmark-file-not-found - 'help-echo isfile)) - ( ;; regular files - t - (propertize trunc 'face 'helm-bookmark-file - 'help-echo isfile))) - collect (if helm-bookmark-show-location - (cons (concat (and icon (propertize " " 'display (concat icon " "))) - bmk - (propertize - " " 'display - (concat sep (if (listp loc) (car loc) loc)))) - i) - (cons (concat (and icon (propertize " " 'display (concat icon " "))) - bmk) - i))))) - - -;;; Edit/rename/save bookmarks. -;; -;; -(defun helm-bookmark-edit-bookmark (bookmark-name) - "Edit bookmark's name and file name, and maybe save them. -BOOKMARK-NAME is the current (old) name of the bookmark to be -renamed." - (let ((bmk (helm-bookmark-get-bookmark-from-name bookmark-name)) - (handler (bookmark-prop-get bookmark-name 'handler))) - (if (eq handler 'addressbook-bookmark-jump) - (addressbook-bookmark-edit - (assoc bmk bookmark-alist)) - (helm-bookmark-edit-bookmark-1 bookmark-name handler)))) - -(defun helm-bookmark-edit-bookmark-1 (bookmark-name handler) - (let* ((helm--reading-passwd-or-string t) - (bookmark-fname (bookmark-get-filename bookmark-name)) - (bookmark-loc (bookmark-prop-get bookmark-name 'location)) - (message-id (bookmark-prop-get bookmark-name 'message-id)) - (new-name (read-from-minibuffer "Name: " bookmark-name)) - (new-loc (and (or bookmark-fname bookmark-loc) - (read-from-minibuffer "FileName or Location: " - (or bookmark-fname - (if (consp bookmark-loc) - (car bookmark-loc) - bookmark-loc))))) - (new-message-id (and (memq handler '(mu4e--jump-to-bookmark - mu4e-bookmark-jump)) - (read-string "Message-id: " message-id)))) - (when (and (not (equal new-name "")) - (or (not (equal new-loc "")) - (not (equal new-message-id ""))) - (y-or-n-p "Save changes? ")) - (if bookmark-fname - (progn - (helm-bookmark-rename bookmark-name new-name 'batch) - (bookmark-set-filename new-name new-loc)) - (bookmark-prop-set - (bookmark-get-bookmark bookmark-name) - (cond (new-loc 'location) - (new-message-id 'message-id)) - (or new-loc new-message-id)) - (helm-bookmark-rename bookmark-name new-name 'batch)) - (helm-bookmark-maybe-save-bookmark) - (list new-name new-loc)))) - -(defun helm-bookmark-maybe-save-bookmark () - "Increment save counter and maybe save `bookmark-alist'." - (setq bookmark-alist-modification-count (1+ bookmark-alist-modification-count)) - (when (bookmark-time-to-save-p) (bookmark-save))) - -(defun helm-bookmark-rename (old &optional new _batch) - "Change bookmark's name from OLD to NEW. -If NEW is nil, then prompt for its string value. - -Unused arg _BATCH is kept for backward compatibility. - -While the user enters the new name, repeated `C-w' inserts -consecutive words from the buffer into the new bookmark name." - (bookmark-maybe-historicize-string old) - (bookmark-maybe-load-default-file) - (save-excursion - (skip-chars-forward " ") (setq bookmark-yank-point (point))) - (setq bookmark-current-buffer (current-buffer)) - (catch 'skip - (let ((newname - (or new (read-from-minibuffer - ;; `format-prompt' is not available in old Emacs. - (format "New name [C-RET to skip] (default %s): " old) nil - (let ((now-map (copy-keymap minibuffer-local-map))) - (define-key now-map "\C-w" #'bookmark-yank-word) - (define-key now-map (kbd "C-") - #'(lambda () (interactive) (throw 'skip 'skip))) - now-map) - nil 'bookmark-history old)))) - (bookmark-set-name old newname) - (helm-bookmark-maybe-save-bookmark) newname))) - -(defun helm-bookmark-rename-marked (_candidate) - "Rename marked bookmarks." - (let* ((bmks (helm-marked-candidates)) - (count 0) - (len (length bmks))) - (cl-loop for bmk in bmks - unless (eq (helm-bookmark-rename bmk) 'skip) - do (cl-incf count)) - (message "(%s/%s) bookmark(s) renamed" count len))) - -(helm-make-command-from-action helm-bookmark-run-edit - "Run `helm-bookmark-edit-bookmark' from keyboard." - 'helm-bookmark-edit-bookmark) - - -(helm-make-command-from-action helm-bookmark-run-jump-other-frame - "Jump to bookmark other frame from keyboard." - 'helm-bookmark-jump-other-frame) - -(helm-make-command-from-action helm-bookmark-run-jump-other-window - "Jump to bookmark other window from keyboard." - 'helm-bookmark-jump-other-window) - -(helm-make-command-from-action helm-bookmark-run-jump-other-tab - "Jump to bookmark other tab from keyboard." - 'helm-bookmark-jump-other-tab) - -(helm-make-command-from-action helm-bookmark-run-delete - "Delete bookmark from keyboard." - 'helm-delete-marked-bookmarks) - -(defun helm-bookmark-get-bookmark-from-name (bmk) - "Return bookmark name even if it is a bookmark with annotation. -E.g. prepended with *." - (let ((bookmark (replace-regexp-in-string "\\`\\*" "" bmk))) - (if (assoc bookmark bookmark-alist) bookmark bmk))) - -(defun helm-delete-marked-bookmarks (_ignore) - "Delete this bookmark or all marked bookmarks." - (dolist (i (helm-marked-candidates)) - (bookmark-delete (helm-bookmark-get-bookmark-from-name i) - 'batch))) - -(defun helm-bookmark-get-defaults () - "Get default bookmark names at point for `bookmark-set'." - (let* (bookmark-current-bookmark no-defaults - (record (condition-case _err - (bookmark-make-record) - (error (setq no-defaults t))))) - ;; Not sure `bookmark-make-record' set 'defaults prop in older Emacs. - (or (bookmark-prop-get record 'defaults) - (unless no-defaults - (list (buffer-name helm-current-buffer)))))) - -;;; bookmark annotations -;; -(defun helm-bookmark-show-annotation (bookmark-name-or-record) - "Display the annotation for BOOKMARK-NAME-OR-RECORD in a buffer." - (let ((annotation (bookmark-get-annotation bookmark-name-or-record))) - (when (and annotation (not (string-equal annotation ""))) - (let ((buf (get-buffer-create "*Bookmark Annotation*"))) - (with-current-buffer buf - (let ((inhibit-read-only t)) - (erase-buffer) - (insert annotation) - (goto-char (point-min)) - (set-buffer-modified-p nil) - (helm-bookmark-annotation-mode) - (insert (substitute-command-keys - "# Edit this buffer with \\[helm-bookmark-edit-annotation]") - (substitute-command-keys - "\n# Quit this buffer with \\[helm-bookmark-quit-annotation]\n")) - (set (make-local-variable 'bookmark-annotation-name) - bookmark-name-or-record) - (put 'bookmark-annotation-name 'permanent-local t))) - (pop-to-buffer buf))))) - -(defun helm-bookmark-edit-annotation () - "Edit bookmark annotation from the show annotation buffer." - (interactive) - (setq buffer-read-only nil) - (bookmark-edit-annotation-mode) - (save-excursion - (goto-char (point-min)) - (delete-region - (point) (save-excursion (forward-line 2) (point))) - (insert (funcall bookmark-edit-annotation-text-func - bookmark-annotation-name)))) -(put 'helm-bookmark-edit-annotation 'no-helm-mx t) - -(defun helm-bookmark-quit-annotation () - "Quit bookmark annotation buffer." - (interactive) - (quit-window t)) -(put 'helm-bookmark-quit-annotation 'no-helm-mx t) - -(defvar helm-bookmark-annotation-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map text-mode-map) - (define-key map (kbd "q") #'helm-bookmark-quit-annotation) - (define-key map (kbd "e") #'helm-bookmark-edit-annotation) - map) - "Map used in show annotation bookmark buffer.") - -(define-derived-mode helm-bookmark-annotation-mode - text-mode "helm-annotation-mode" - "Mode to display bookmark annotations. - -Special commands: -\\{helm-bookmark-annotation-mode-map}" - :interactive nil - (setq-local buffer-read-only t)) - -;;;###autoload -(defun helm-bookmarks () - "Preconfigured `helm' for bookmarks." - (interactive) - (helm :sources '(helm-source-bookmarks - helm-source-bookmark-set) - :buffer "*helm bookmarks*" - :default (buffer-name helm-current-buffer))) - -;;;###autoload -(defun helm-filtered-bookmarks () - "Preconfigured `helm' for bookmarks (filtered by category). -Optional source `helm-source-bookmark-addressbook' is loaded only -if external addressbook-bookmark package is installed." - (interactive) - (helm :sources helm-bookmark-default-filtered-sources - :prompt "Search Bookmark: " - :buffer "*helm filtered bookmarks*" - :default (helm-bookmark-get-defaults))) - -(provide 'helm-bookmark) - -;;; helm-bookmark.el ends here diff --git a/elpa/helm-20251212.555/helm-buffers.el b/elpa/helm-20251212.555/helm-buffers.el deleted file mode 100644 index 40d7595f..00000000 --- a/elpa/helm-20251212.555/helm-buffers.el +++ /dev/null @@ -1,1250 +0,0 @@ -;;; helm-buffers.el --- helm support for buffers. -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2025 Thierry Volpiatto - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Code: - -(require 'cl-lib) -(require 'helm) -(require 'helm-types) -(require 'helm-utils) -(require 'helm-grep) -(require 'helm-regexp) -(require 'helm-help) -(require 'helm-occur) -(require 'helm-x-icons) - -(declare-function helm-comp-read "helm-mode") -(declare-function helm-browse-project "helm-files") -(declare-function helm-ff-switch-to-shell "helm-files") - -(defvar dired-buffers) -(defvar org-directory) -(defvar helm-ff-default-directory) -(defvar major-mode-remap-alist) - - -(defgroup helm-buffers nil - "Buffers related Applications and libraries for Helm." - :group 'helm) - -(defcustom helm-boring-buffer-regexp-list - '("\\` " "\\`\\*helm" "\\`\\*Echo Area" "\\`\\*Minibuf") - "The regexp list that match boring buffers. -Buffer candidates matching these regular expression will be -filtered from the list of candidates if the -`helm-skip-boring-buffers' candidate transformer is used." - :type '(repeat (choice regexp))) - -(defcustom helm-white-buffer-regexp-list nil - "The regexp list of not boring buffers. -These buffers will be displayed even if they match one of -`helm-boring-buffer-regexp-list'." - :type '(repeat (choice regexp))) - -(defcustom helm-buffers-favorite-modes '(lisp-interaction-mode - emacs-lisp-mode - text-mode - org-mode) - "List of preferred mode to open new buffers with." - :type '(repeat (choice function))) - -(defcustom helm-buffer-max-length 20 - "Max length of buffer names before truncate. -When disabled (nil) use the longest `buffer-name' length found." - :type '(choice (const :tag "Disabled" nil) - (integer :tag "Length before truncate"))) - -(defcustom helm-buffer-details-flag t - "Always show details in buffer list when non-nil." - :type 'boolean) - -(defcustom helm-buffers-fuzzy-matching nil - "Fuzzy matching buffer names when non-nil. -Only buffer names are fuzzy matched when this is enabled, -`major-mode' matching is not affected by this." - :type 'boolean) - -(defcustom helm-buffer-skip-remote-checking nil - "Ignore checking for `file-exists-p' on remote files." - :type 'boolean) - -(defcustom helm-buffers-truncate-lines t - "Truncate lines in `helm-buffers-list' when non-nil." - :type 'boolean) - -(defcustom helm-buffers-left-margin-width helm-left-margin-width - "`left-margin-width' value for `helm-mini' and `helm-buffers-list'." - :type 'integer) - -(defcustom helm-mini-default-sources '(helm-source-buffers-list - helm-source-recentf - helm-source-buffer-not-found) - "Default sources list used in `helm-mini'. - -When adding a source here it is up to you to ensure the library -of this source is accessible and properly loaded." - :type '(repeat (choice symbol))) - -(defcustom helm-buffers-end-truncated-string - ;; `truncate-string-ellipsis', the function is not available in 27.1 - ;; See issue#2673. - (if (char-displayable-p ?…) "…" "...") - "The string to display at end of truncated buffer names." - :type 'string) - -(defcustom helm-buffers-column-separator " " - "Separator for columns in buffer listing." - :type 'string) - -(defcustom helm-buffer--pretty-names '((dired-mode . "Dired") - (lisp-interaction-mode . "Lisp Inter")) - "An alist specifying pretty names for modes. -Most of the time buffer's `mode-name' is a string so no need to -add it here as there is no need to compute it, but sometimes it -may be a mode-line specification which may be costly to compute, -in this case add here the pretty name as a string to avoid this -costly computation. Also if some pretty names are too long you -can add your own abbreviation here." - :type '(alist :key-type symbol :value-type string)) - -(defcustom helm-buffers-maybe-switch-to-tab nil - "Switch to buffer in its tab when non nil. -Setting this change `tab-bar-tab-name-function' to `tab-bar-tab-name-all'. -Do not use `setq' to set this variable. - -This variable takes effect only when `tab-bar-mode' is available (emacs-27.1+)." - :type 'boolean - :set (lambda (var val) - ;; We should be able to retrieve all buffers assigned to a tab whatever - ;; the value used for `tab-bar-tab-name-function', unfortunately this - ;; is not the case, it seems the alist contains the buffer names only - ;; when `tab-bar-tab-name-all' is used and set globally. Then when the - ;; mode-line/header-line is rebuilded some code (probably C code in - ;; `force-mode-line-update' or elsewhare) changes the alist so just - ;; let-binding `tab-bar-tab-name-function' is not enough. This is - ;; reproductible when we have more than one window visible and we turn - ;; on `tab-bar-mode', the alist is showing only the first buffer of - ;; window-list omitting the others, however when starting with only one - ;; window, calling `tab-bar-mode' and splitting window afterward the - ;; alist is updated. Looks it is a bug or a limitation of - ;; `tab-bar-mode'. - (set var val) - (if val - (customize-set-variable - 'tab-bar-tab-name-function - #'tab-bar-tab-name-all) - (let* ((sym 'tab-bar-tab-name-function) - (standard-value (eval (car (get sym 'standard-value)) t))) - (unless (equal standard-value (symbol-value sym)) - (set sym standard-value)))))) - -(defcustom helm-buffer-list-reorder-fn #'helm-buffers-reorder-buffer-list - "A function in charge of ordering the initial buffer list. -It takes two arguments VISIBLES buffers and OTHERS buffers. -Arg VISIBLES handles the buffers visibles in this frame. -Arg OTHERS handles all the other buffers. -You can write a function that reorder VISIBLES and OTHERS as you -want. -Default function returns OTHERS buffers on top and VISIBLES -buffer at the end. See `helm-buffers-reorder-buffer-list'." - :type 'function) - -(defcustom helm-buffers-sort-fn helm-fuzzy-sort-fn - "The sort function to use in `helm-buffers-list'. - -Default to `helm-fuzzy-sort-fn' you can use -`helm-fuzzy-matching-sort-fn-preserve-ties-order' as alternative if -you want to keep the recentest order when narrowing candidates." - :type 'function) - -(defcustom helm-buffers-show-icons nil - "Prefix buffer names with an icon when non nil. -Don't use `setq' to set this." - :type 'boolean - :set (lambda (var val) - (set var (and (require helm-x-icons-provider nil t) val)))) - - -;;; Faces -;; -;; -(defgroup helm-buffers-faces nil - "Customize the appearance of helm-buffers." - :prefix "helm-" - :group 'helm-buffers - :group 'helm-faces) - -(defface helm-buffer-saved-out - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :foreground "red" :background "black")) - "Face used for buffer files modified outside of emacs." - :group 'helm-buffers-faces) - -(defface helm-buffer-not-saved - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :foreground "IndianRed2")) - "Face used for buffer files not already saved on disk." - :group 'helm-buffers-faces) - -(defface helm-buffer-modified - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :inherit font-lock-comment-face)) - "Face used for modified buffers." - :group 'helm-buffers-faces) - -(defface helm-no-file-buffer-modified - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :foreground "orange" :background "black")) - "Face used for modified buffers." - :group 'helm-buffers-faces) - -(defface helm-indirect-buffer - `((t :foreground "DimGray" :background "black")) - "Face used for indirect buffers." - :group 'helm-buffers-faces) - -(defface helm-buffer-size - `((((background dark)) - ,@(and (>= emacs-major-version 27) '(:extend t)) - :foreground "RosyBrown") - (((background light)) - ,@(and (>= emacs-major-version 27) '(:extend t)) - :foreground "SlateGray")) - "Face used for buffer size." - :group 'helm-buffers-faces) - -(defface helm-buffer-process - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :foreground "sienna3")) - "Face used for process status in buffer." - :group 'helm-buffers-faces) - -(defface helm-buffer-directory - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :foreground "DarkRed" :background "LightGray")) - "Face used for directories in `helm-buffers-list'." - :group 'helm-buffers-faces) - -(defface helm-buffer-file - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :inherit font-lock-builtin-face)) - "Face for buffer file names in `helm-buffers-list'." - :group 'helm-buffers-faces) - -(defface helm-buffer-archive - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :foreground "gold")) - "Face for archive file names in `helm-buffers-list'." - :group 'helm-buffers-faces) - -(defface helm-non-file-buffer - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :inherit italic)) - "Face used for non-file buffers in `helm-buffers-list'." - :group 'helm-buffers-faces) - -(defvar helm-buffers-tick-counter nil - "Allows recording local changes to a non-file buffer. -Typical usage of this var is for modes that want to see if their -buffers have changed since last visit. -Such programs may want to record tick counter after visiting -their buffers like this: - - (setq helm-buffers-tick-counter (buffer-modified-tick)) - -See bug#1917. - -Note that this variable is buffer-local.") -(make-variable-buffer-local 'helm-buffers-tick-counter) - - -;;; Buffers keymap -;; -(defvar helm-buffer-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-map) - ;; No need to have separate command for grep and zgrep - ;; as we don't use recursivity for buffers. - ;; So use zgrep for both as it is capable to handle non--compressed files. - (define-key map (kbd "M-g s") #'helm-buffer-run-zgrep) - (define-key map (kbd "C-s") #'helm-buffers-run-occur) - (define-key map (kbd "C-x C-d") #'helm-buffers-run-browse-project) - (define-key map (kbd "C-c o") #'helm-buffer-switch-other-window) - (define-key map (kbd "C-c C-o") #'helm-buffer-switch-other-frame) - (define-key map (kbd "M-g M-g") #'helm-buffer-run-goto-line) - (define-key map (kbd "C-c =") #'helm-buffer-run-ediff) - (define-key map (kbd "M-=") #'helm-buffer-run-ediff-merge) - (define-key map (kbd "C-=") #'helm-buffer-diff-persistent) - (define-key map (kbd "M-G") #'helm-buffer-revert-persistent) - (define-key map (kbd "C-c d") #'helm-buffer-run-kill-persistent) - (define-key map (kbd "M-D") #'helm-buffer-run-kill-buffers) - (define-key map (kbd "C-x C-s") #'helm-buffer-save-persistent) - (define-key map (kbd "C-x s") #'helm-buffer-run-save-some-buffers) - (define-key map (kbd "C-M-%") #'helm-buffer-run-query-replace-regexp) - (define-key map (kbd "M-%") #'helm-buffer-run-query-replace) - (define-key map (kbd "M-R") #'helm-buffer-run-rename-buffer) - (define-key map (kbd "M-e") #'helm-buffer-run-switch-to-shell) - (define-key map (kbd "C-]") #'helm-toggle-buffers-details) - (define-key map (kbd "C-c a") #'helm-buffers-toggle-show-hidden-buffers) - (define-key map (kbd "C-M-SPC") #'helm-buffers-mark-similar-buffers) - (when (fboundp 'tab-bar-mode) - (define-key map (kbd "C-c C-t") #'helm-buffers-switch-to-buffer-new-tab)) - map) - "Keymap for buffer sources in helm.") - - -(defvar helm-buffer-max-len-mode nil) -(defvar helm-buffers-in-project-p nil) -(defvar helm-source-buffers-list nil) - -(defun helm-buffers-list--init () - (require 'dired) - ;; Bug#51 Create the list before `helm-buffer' creation. - ;; We were using a global cache in the past and 'candidates was - ;; bound to this cache, this was a problem when using more than one - ;; source with a different 'buffer-list fn as the same cache was - ;; reused in each source (Bug#1907), now 'candidates attr is set - ;; directly so that each list of candidates is local to source. - (helm-set-attr 'candidates (funcall (helm-get-attr 'buffer-list))) - (let ((result (cl-loop with allbufs = (memq 'helm-shadow-boring-buffers - (helm-get-attr - 'filtered-candidate-transformer - helm-source-buffers-list)) - for b in (if allbufs - (helm-get-attr 'candidates) - (helm-skip-boring-buffers - (helm-get-attr 'candidates) - helm-source-buffers-list)) - maximize (length b) into len-buf - maximize (length (helm-buffer--format-mode-name b)) - into len-mode - finally return (cons len-buf len-mode)))) - (unless (default-value 'helm-buffer-max-length) - (helm-set-local-variable 'helm-buffer-max-length (car result))) - (unless (default-value 'helm-buffer-max-len-mode) - (helm-set-local-variable 'helm-buffer-max-len-mode (cdr result))))) - -(defclass helm-source-buffers (helm-source-sync helm-type-buffer) - ((buffer-list - :initarg :buffer-list - :initform #'helm-buffer-list - :custom function - :documentation - " A function with no arguments to create buffer list.") - (init :initform 'helm-buffers-list--init) - (multimatch :initform nil) - (match :initform 'helm-buffers-match-function) - (persistent-action :initform 'helm-buffers-list-persistent-action) - (keymap :initform 'helm-buffer-map) - (find-file-target :initform #'helm-buffers-quit-and-find-file-fn) - (migemo :initform 'nomultimatch) - (volatile :initform t) - (nohighlight :initform t) - (resume :initform (lambda () (setq helm-buffers-in-project-p nil))) - (help-message :initform 'helm-buffer-help-message))) - -(cl-defun helm-buffers-create-new-buffer-1 (candidate &optional (display-func 'switch-to-buffer)) - (let ((mjm (or (and helm-current-prefix-arg - (intern-soft (helm-comp-read - "Major-mode: " - helm-buffers-favorite-modes))) - (cl-loop for (r . m) in auto-mode-alist - when (string-match r candidate) - return m))) - (buffer (get-buffer-create candidate))) - (helm-aif (and (boundp 'major-mode-remap-alist) - (cdr (assq mjm major-mode-remap-alist))) - (setq mjm it)) - (if mjm - (with-current-buffer buffer (funcall mjm)) - (set-buffer-major-mode buffer)) - (funcall display-func buffer))) - -(defun helm-buffers-create-new-buffer (candidate) - (helm-buffers-create-new-buffer-1 candidate)) - -(defun helm-buffers-create-new-buffer-ow (candidate) - (helm-buffers-create-new-buffer-1 candidate 'switch-to-buffer-other-window)) - -(helm-make-command-from-action helm-buffers-not-found-run-switch-ow - "Run create new buffer other window action from keymap." - 'helm-buffers-create-new-buffer-ow) - -(defun helm-buffers-create-new-buffer-of (candidate) - (helm-buffers-create-new-buffer-1 candidate 'switch-to-buffer-other-frame)) - -(helm-make-command-from-action helm-buffers-not-found-run-switch-of - "Run create new buffer other frame action from keymap." - 'helm-buffers-create-new-buffer-of) - -(defvar helm-buffer-not-found-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-map) - (define-key map (kbd "C-c o") #'helm-buffers-not-found-run-switch-ow) - (define-key map (kbd "C-c C-o") #'helm-buffers-not-found-run-switch-of) - map) - "Keymap for `helm-source-buffer-not-found' source.") - -(defvar helm-source-buffer-not-found - (helm-build-dummy-source - "Create buffer" - :action (helm-make-actions - "Create buffer (C-u choose mode)" - #'helm-buffers-create-new-buffer - "Create buffer other window (C-u choose mode)" - #'helm-buffers-create-new-buffer-ow - "Create buffer other frame (C-u choose mode)" - #'helm-buffers-create-new-buffer-of) - :keymap helm-buffer-not-found-map)) - - -(defun helm-buffers-get-visible-buffers () - "Returns buffers visible on visible frames." - (let (result) - (walk-windows - (lambda (x) - (push (buffer-name (window-buffer x)) result)) - nil 'visible) - result)) - -(defun helm-buffer-list-1 (&optional visibles) - "Return list of all buffers except VISIBLES buffers." - (cl-loop for b in (buffer-list) - for bn = (buffer-name b) - unless (member bn visibles) - collect bn)) - -(defun helm-buffers-reorder-buffer-list (visibles others) - "Default function to reorder buffer-list. -Arg VISIBLES handles the buffers visibles in this frame. -Arg OTHERS handles all the other buffers. -This function returns OTHERS buffers on top and VISIBLES buffer -at the end." - (nconc others visibles)) - -(defun helm-buffer-list () - "Return the current list of buffers. -The list is reordered with `helm-buffer-list-reorder-fn'." - (let* ((visibles (helm-buffers-get-visible-buffers)) - (others (helm-buffer-list-1 visibles))) - (funcall helm-buffer-list-reorder-fn visibles others))) - -(defun helm-buffer-size (buffer) - "Return size of BUFFER." - (with-current-buffer buffer - (save-restriction - (widen) - (helm-file-human-size - (- (position-bytes (point-max)) - (position-bytes (point-min))))))) - -(defun helm-buffer--show-details (buf-name prefix help-echo - size mode dir face1 face2 - proc details type) - (append - (list - (let* ((buf-fname (buffer-file-name (get-buffer buf-name))) - (ext (if buf-fname (helm-file-name-extension buf-fname) "")) - (bmode (with-current-buffer buf-name major-mode)) - (icon-alist (helm-x-icons-resolve-alist 'mode)) - (icon (when helm-buffers-show-icons - (helm-aif (and (not (eq type 'indirect)) - (assq bmode icon-alist)) - (and helm-x-icons-provider - (apply (cadr it) (cddr it))) - (cond ((eq type 'dired) - (helm-x-icons-generic "file-directory")) - ((eq type 'indirect) - (helm-x-icons-generic "clone")) - (buf-fname - (helm-x-icons-icon-for-file buf-name)) - (t (helm-x-icons-generic "star" :v-adjust 0.0)))))) - (buf-name (propertize buf-name 'face face1 - 'help-echo help-echo - 'type type))) - (when (condition-case _err - (string-match (format "\\.\\(%s\\)" ext) buf-name) - (invalid-regexp nil)) - (add-face-text-property - (match-beginning 1) (match-end 1) - 'helm-ff-file-extension nil buf-name)) - (if icon - (concat icon " " prefix buf-name) - (concat prefix buf-name)))) - (and details - (list size mode - (propertize - (if proc - (format "(%s %s in `%s')" - (process-name proc) - (process-status proc) dir) - (format "`%s'" dir)) - 'face face2))))) - -(defun helm-buffer--format-mode-name (buf) - "Prevent using `format-mode-line' as much as possible." - (with-current-buffer buf - (helm-acond ((assq major-mode helm-buffer--pretty-names) - (cdr it)) - ((stringp mode-name) mode-name) - (t (format-mode-line mode-name nil nil (get-buffer buf)))))) - -(defun helm-buffer--details (buffer &optional details) - (require 'dired) - (let* ((mode (helm-buffer--format-mode-name buffer)) - (buf (get-buffer buffer)) - (size (propertize (helm-buffer-size buf) - 'face 'helm-buffer-size)) - (proc (get-buffer-process buf)) - (dir (with-current-buffer buffer - (helm-aif default-directory (abbreviate-file-name it)))) - (file-name (helm-aif (buffer-file-name buf) (abbreviate-file-name it))) - (name (buffer-name buf)) - (name-prefix (when (and dir (file-remote-p dir)) - (propertize "@ " 'face 'helm-ff-prefix))) - (archive-p (and (fboundp 'tramp-archive-file-name-p) - (tramp-archive-file-name-p dir)))) - (when name-prefix - ;; Remote tramp buffer names may be hexified, make them more readable. - (setq dir (helm-url-unhex-string dir) - name (helm-url-unhex-string name))) - ;; Handle tramp archive buffers specially. - (if archive-p - (helm-buffer--show-details - name name-prefix file-name size mode dir - 'helm-buffer-archive 'helm-buffer-process nil details 'filebuf) - ;; No fancy things on remote buffers. - (if (and name-prefix helm-buffer-skip-remote-checking) - (helm-buffer--show-details - name name-prefix file-name size mode dir - 'helm-buffer-file 'helm-buffer-process nil details 'filebuf) - (helm-acond - (;; A dired buffer. - (rassoc buf dired-buffers) - (helm-buffer--show-details - name name-prefix dir size mode dir - 'helm-buffer-directory 'helm-buffer-process nil details 'dired)) - ;; A buffer file modified somewhere outside of emacs.=>red - ((and file-name - (file-exists-p file-name) - (not (verify-visited-file-modtime buf))) - (helm-buffer--show-details - name name-prefix file-name size mode dir - 'helm-buffer-saved-out 'helm-buffer-process nil details 'modout)) - ;; A new buffer file not already saved on disk (or a deleted file) .=>indianred2 - ((and file-name (not (file-exists-p file-name))) - (helm-buffer--show-details - name name-prefix file-name size mode dir - 'helm-buffer-not-saved 'helm-buffer-process nil details 'notsaved)) - ;; A buffer file modified and not saved on disk.=>orange - ((and file-name (buffer-modified-p buf)) - (helm-buffer--show-details - name name-prefix file-name size mode dir - 'helm-buffer-modified 'helm-buffer-process nil details 'mod)) - ;; A buffer file not modified and saved on disk.=>green - (file-name - (helm-buffer--show-details - name name-prefix file-name size mode dir - 'helm-buffer-file 'helm-buffer-process nil details 'filebuf)) - ;; Indirect buffer.=>DimGray - ((buffer-base-buffer buf) - (let ((face (if (or (buffer-modified-p it) - (with-current-buffer it - (and helm-buffers-tick-counter - (/= helm-buffers-tick-counter - (buffer-modified-tick))))) - 'helm-buffer-modified - 'helm-indirect-buffer))) - (helm-buffer--show-details - name name-prefix dir size mode dir - face 'helm-buffer-process nil details 'indirect))) - ;; A non-file, modified buffer See bug#1917 - ((with-current-buffer name - (and helm-buffers-tick-counter - (/= helm-buffers-tick-counter (buffer-modified-tick)))) - (helm-buffer--show-details - name (and proc name-prefix) dir size mode dir - 'helm-no-file-buffer-modified 'helm-buffer-process proc details 'nofile-mod)) - ;; Any non--file buffer.=>italic - (t - (helm-buffer--show-details - name (and proc name-prefix) dir size mode dir - 'helm-non-file-buffer 'helm-buffer-process proc details 'nofile))))))) - -(defun helm-highlight-buffers (buffers _source) - "Transformer function to highlight BUFFERS list. -Should be called after others transformers i.e. (boring -buffers)." - (cl-assert helm-fuzzy-matching-highlight-fn nil "Wrong type argument functionp: nil") - (cl-loop for i in buffers - for (name size mode meta) = (if helm-buffer-details-flag - (helm-buffer--details i 'details) - (helm-buffer--details i)) - for truncbuf = (if (> (string-width name) helm-buffer-max-length) - (helm-substring-by-width - name helm-buffer-max-length - helm-buffers-end-truncated-string) - (concat name - (make-string - (- (+ helm-buffer-max-length - (length - helm-buffers-end-truncated-string)) - (string-width name)) - ? ))) - for len = (length mode) - when (> len helm-buffer-max-len-mode) - do (setq helm-buffer-max-len-mode len) - for fmode = (concat (make-string - (- (max helm-buffer-max-len-mode len) len) ? ) - mode) - ;; The max length of a number should be 1023.9X where X is the - ;; units, this is 7 characters. - for formatted-size = (and size (format "%7s" size)) - collect (let ((helm-pattern (helm-buffers--pattern-sans-filters - (and helm-buffers-fuzzy-matching "")))) - (cons (if helm-buffer-details-flag - (concat - (funcall helm-fuzzy-matching-highlight-fn - truncbuf) - helm-buffers-column-separator - formatted-size - helm-buffers-column-separator - fmode - helm-buffers-column-separator - meta) - (funcall helm-fuzzy-matching-highlight-fn name)) - (get-buffer i))))) - -(defun helm-buffer--get-preselection (buffer) - (let* ((bufname (buffer-name buffer)) - (dispbuf (car (helm-buffer--details buffer))) - (len-dispbuf (string-width dispbuf)) - (len-prefix (- len-dispbuf (string-width bufname)))) - (when (and bufname - (file-remote-p (with-current-buffer bufname - default-directory))) - (setq bufname (concat "@ " (helm-url-unhex-string bufname)))) - (concat "^[[:multibyte:] ]*" - (if (and (null helm-buffer-details-flag) - (numberp helm-buffer-max-length) - (> len-dispbuf helm-buffer-max-length)) - (regexp-quote - (helm-substring-by-width - bufname - (- helm-buffer-max-length len-prefix) - helm-buffers-end-truncated-string)) - (concat (regexp-quote bufname) - (if helm-buffer-details-flag - "$" "[[:blank:]]+")))))) - -(defun helm-toggle-buffers-details () - (interactive) - (with-helm-alive-p - (let* ((buf (helm-get-selection)) - (preselect (helm-buffer--get-preselection buf))) - (setq helm-buffer-details-flag (not helm-buffer-details-flag)) - (helm-force-update (lambda () - (helm-awhile (re-search-forward preselect nil t) - (helm-mark-current-line) - (when (equal buf (helm-get-selection)) - (cl-return t)))))))) -(put 'helm-toggle-buffers-details 'helm-only t) - -(defun helm-buffers--pattern-sans-filters (&optional separator) - (cl-loop for p in (helm-mm-split-pattern helm-pattern) - unless (member (substring p 0 1) '("*" "/" "@" "!")) - collect p into lst - finally return (mapconcat #'identity lst (or separator " ")))) - -(defun helm-buffers-sort-transformer (candidates source) - (cl-assert helm-buffers-sort-fn nil "Wrong type argument functionp: nil") - (if (string= helm-pattern "") - candidates - (let ((helm-pattern (helm-buffers--pattern-sans-filters))) - (funcall helm-buffers-sort-fn candidates source)))) - -(defun helm-buffers-mark-similar-buffers-1 (&optional type) - (with-helm-window - (let* ((src (helm-get-current-source)) - (sel (helm-get-selection nil 'withprop src)) - (type (or type (get-text-property - (min 2 (length sel)) 'type sel)))) - (helm-map-candidates-in-source src - (lambda (_cand) (helm-make-visible-mark)) - (lambda (cand) - (and (not (helm-this-visible-mark)) - (eq (get-text-property 2 'type cand) type)))) - (helm-mark-current-line) - (helm-display-mode-line src t) - (when helm-marked-candidates - (message "%s candidates marked" (length helm-marked-candidates)) - (set-window-margins (selected-window) 1))))) - -(defun helm-buffers-mark-similar-buffers () - "Mark All buffers that have same property `type' than current. -I.e. same color." - (interactive) - (with-helm-alive-p - (let ((marked (helm-marked-candidates))) - (if (and (>= (length marked) 1) - (with-helm-window helm-visible-mark-overlays)) - (helm-unmark-all) - (helm-buffers-mark-similar-buffers-1))))) -(put 'helm-buffers-mark-similar-buffers 'helm-only t) - - -;;; match functions -;; -(defun helm-buffer--match-mjm (pattern mjm) - (when (string-match "\\`\\*" pattern) - (cl-loop with patterns = (split-string (substring pattern 1) ",") - for pat in patterns - if (string-match "\\`!" pat) - collect (string-match (substring pat 1) mjm) into neg - else collect (string-match pat mjm) into pos - finally return - (let ((neg-test (cl-loop for i in neg thereis (numberp i))) - (pos-test (cl-loop for i in pos thereis (numberp i)))) - (or - (and neg (not pos) (not neg-test)) - (and pos pos-test) - (and neg neg-test (not neg-test))))))) - -(defvar helm-buffer--memo-hash (make-hash-table :test 'equal)) -(defun helm-buffer--memo-pattern (pattern) - (or (gethash pattern helm-buffer--memo-hash) - (puthash pattern (helm--mapconcat-pattern pattern) - helm-buffer--memo-hash))) - -(defun helm-buffer--match-pattern (pattern candidate &optional nofuzzy) - (let ((bfn (if (and helm-buffers-fuzzy-matching - (not nofuzzy) - (not helm-migemo-mode) - (not (string-match "\\`\\^" pattern))) - #'helm-buffer--memo-pattern - #'identity)) - (mfn (if helm-migemo-mode - #'helm-mm-migemo-string-match #'string-match))) - (if (string-match "\\`!" pattern) - (not (funcall mfn (funcall bfn (substring pattern 1)) - candidate)) - (funcall mfn (funcall bfn pattern) candidate)))) - -(defun helm-buffers--match-from-mjm (candidate) - (let* ((cand (replace-regexp-in-string "^\\s-\\{1\\}" "" candidate)) - (buf (get-buffer cand)) - (regexp (cl-loop with pattern = helm-pattern - for p in (helm-mm-split-pattern pattern) - when (string-match "\\`\\*" p) - return p))) - (if regexp - (when buf - (with-current-buffer buf - (let ((mjm (symbol-name major-mode))) - (helm-buffer--match-mjm regexp mjm)))) - t))) - -(defun helm-buffers--match-from-pat (candidate) - (let* ((regexp-list (cl-loop with pattern = helm-pattern - for p in (helm-mm-split-pattern pattern) - unless (string-match - "\\`\\(\\*\\|/\\|@\\)" p) - collect p)) - (nofuzzy (cdr regexp-list))) - (if regexp-list - (cl-loop for re in regexp-list - always (helm-buffer--match-pattern re candidate nofuzzy)) - t))) - -(defun helm-buffers--match-from-inside (candidate) - (let* ((cand (replace-regexp-in-string "^\\s-\\{1\\}" "" candidate)) - (buf (get-buffer cand)) - (pattern (cl-loop with pat = helm-pattern - for p in (helm-mm-split-pattern pat) - when (string-match "\\`@\\(.*\\)" p) - collect (match-string 1 p) into lst - finally return (mapconcat #'identity lst " "))) - (patterns (helm-mm-3-get-patterns pattern))) - (if (and buf patterns) - (with-current-buffer buf - (save-excursion - (goto-char (point-min)) - (cl-loop for (pred . regexp) in patterns - always - (save-excursion - (funcall - pred - (if helm-migemo-mode - (helm-mm-migemo-forward regexp nil t) - (re-search-forward regexp nil t))))))) - t))) - -(defun helm-buffers--match-from-directory (candidate) - (let* ((cand (replace-regexp-in-string "^\\s-\\{1\\}" "" candidate)) - (buf (get-buffer cand)) - (buf-fname (or (buffer-file-name buf) - (car-safe (rassoc buf dired-buffers)))) - (regexps (cl-loop with pattern = helm-pattern - for p in (helm-mm-split-pattern pattern) - when (string-match "\\`/" p) - collect p))) - (if regexps - (cl-loop for re in regexps - thereis - (and buf-fname - (string-match - (substring re 1) (helm-basedir buf-fname)))) - t))) - -(defun helm-buffers-match-function (candidate) - "Default function to match buffers." - (and (helm-buffers--match-from-pat candidate) - (helm-buffers--match-from-mjm candidate) - (helm-buffers--match-from-inside candidate) - (helm-buffers--match-from-directory candidate))) - - -(defun helm-buffer-query-replace-1 (&optional regexp-flag buffers) - "Query replace in marked buffers. -If REGEXP-FLAG is given use `query-replace-regexp'." - (let ((prompt (if regexp-flag "Query replace regexp" "Query replace")) - (bufs (or buffers (helm-marked-candidates))) - (helm--reading-passwd-or-string t)) - (cl-loop with args = (query-replace-read-args prompt regexp-flag t) - for buf in bufs - do - (save-window-excursion - (switch-to-buffer buf) - (save-excursion - (let ((case-fold-search t)) - (goto-char (point-min)) - (apply #'perform-replace - (list (nth 0 args) (nth 1 args) - t regexp-flag (nth 2 args) nil - multi-query-replace-map)))))))) - -(defun helm-buffer-query-replace-regexp (_candidate) - (helm-buffer-query-replace-1 'regexp)) - -(defun helm-buffer-query-replace (_candidate) - (helm-buffer-query-replace-1)) - -(defun helm-buffer-toggle-diff (candidate) - "Toggle diff buffer CANDIDATE with it's file." - (helm-aif (get-buffer-window "*Diff*" 'visible) - (progn (kill-buffer "*Diff*") - (set-window-buffer it helm-current-buffer)) - ;; Expect the prop at pos 2 because of icon at 1. - (let* ((type (get-text-property 2 'type (helm-get-selection nil 'withprop))) - (buf (helm-aif (get-buffer candidate) - (or (buffer-base-buffer it) it))) - (file (buffer-file-name buf))) - (cl-assert file nil (format "Buffer `%s' is not associated to a file" - (buffer-name buf))) - (if (eq type 'modout) - (diff buf file) ; Buffer modified externally. - (diff file buf))))) ; Buffer modified inside emacs and not saved. - -(helm-make-persistent-command-from-action helm-buffer-diff-persistent - "Toggle diff buffer without quitting helm." - 'diff-action 'helm-buffer-toggle-diff) - -(defun helm-revert-buffer (candidate) - (with-current-buffer candidate - (helm-aif (or (buffer-file-name) - (buffer-file-name (buffer-base-buffer))) - (and (file-exists-p it) (revert-buffer t t))))) - -(defun helm-revert-marked-buffers (_ignore) - (mapc #'helm-revert-buffer (helm-marked-candidates))) - -(defun helm-buffer-revert-and-update (_candidate) - (with-helm-buffer - (let ((marked (helm-marked-candidates)) - (preselect (helm-buffers--quote-truncated-buffer - (helm-get-selection)))) - (cl-loop for buf in marked do (helm-revert-buffer buf)) - (when helm-marked-candidates (helm-unmark-all)) - (helm-force-update preselect)))) - -(helm-make-persistent-command-from-action helm-buffer-revert-persistent - "Revert buffer without quitting helm." - 'revert-action 'helm-buffer-revert-and-update) - -(defun helm-buffer-save-and-update (_candidate) - (with-helm-buffer - (let ((marked (helm-marked-candidates)) - (preselect (helm-get-selection nil t)) - (enable-recursive-minibuffers t)) - (cl-assert marked nil "No buffers need to be saved") - (cl-loop for buf in marked do - (with-current-buffer (get-buffer buf) - (when (or (buffer-file-name) - (buffer-file-name (buffer-base-buffer))) - (save-buffer)))) - (when helm-marked-candidates (helm-unmark-all)) - (helm-force-update (regexp-quote preselect))))) - -(defun helm-buffer-save-some-buffers (_candidate) - (helm-buffers-mark-similar-buffers-1 'mod) - (helm-buffer-save-and-update nil)) - -(helm-make-persistent-command-from-action helm-buffer-run-save-some-buffers - "Save unsaved file buffers without quitting Helm." - 'save-some-action 'helm-buffer-save-some-buffers) - -(helm-make-persistent-command-from-action helm-buffer-save-persistent - "Save buffer without quitting Helm." -'save-action 'helm-buffer-save-and-update) - -(defun helm-buffers-rename-buffer (candidate) - (with-current-buffer candidate - (rename-buffer (helm-read-string "New name: " (buffer-name)) t))) - -(helm-make-command-from-action helm-buffer-run-rename-buffer - "Run rename buffer action from `helm-source-buffers-list'." - 'helm-buffers-rename-buffer) - -(defun helm-switch-to-buffer-at-linum (candidate) - (let ((linum (read-number - "Line number: " - (with-current-buffer candidate - (line-number-at-pos))))) - (switch-to-buffer candidate) - (goto-char (point-min)) - (forward-line (1- linum)))) - -(helm-make-command-from-action helm-buffer-run-goto-line - "Switch to buffer at line number." - 'helm-switch-to-buffer-at-linum) - -(helm-make-persistent-command-from-action helm-buffer-run-kill-persistent - "Kill buffer without quitting Helm." - 'kill-action 'helm-buffers-persistent-kill) - -(defun helm-kill-marked-buffers (_ignore) - (let* ((bufs (helm-marked-candidates)) - (killed-bufs (cl-count-if 'kill-buffer bufs))) - (when (buffer-live-p helm-buffer) - (with-helm-buffer - (setq helm-marked-candidates nil - helm-visible-mark-overlays nil))) - (message "Killed %s buffer(s)" killed-bufs))) - -(helm-make-command-from-action helm-buffer-run-kill-buffers - "Run kill buffer action from `helm-source-buffers-list'." - 'helm-kill-marked-buffers) - -(defun helm-buffer-switch-to-shell (candidate) - (require 'helm-files) - (let ((helm-ff-default-directory - (with-current-buffer candidate - default-directory))) - (helm-ff-switch-to-shell nil))) - -(helm-make-command-from-action helm-buffer-run-switch-to-shell - "Run switch to shell action from helm-buffers-list." - 'helm-buffer-switch-to-shell) - -(helm-make-command-from-action helm-buffer-run-grep - "Run Grep action from `helm-source-buffers-list'." - 'helm-grep-buffers) - -(helm-make-command-from-action helm-buffer-run-zgrep - "Run Zgrep action from `helm-source-buffers-list'." - 'helm-zgrep-buffers) - -(helm-make-command-from-action helm-buffer-run-query-replace-regexp - "Run Query replace regexp action from `helm-source-buffers-list'." -'helm-buffer-query-replace-regexp) - -(helm-make-command-from-action helm-buffer-run-query-replace - "Run Query replace action from `helm-source-buffers-list'." -'helm-buffer-query-replace) - -(helm-make-command-from-action helm-buffer-switch-other-window - "Run switch to other window action from `helm-source-buffers-list'." - 'helm-buffer-switch-buffers-other-window) - -(defun helm-buffer-switch-to-buffer-other-frame (_candidate) - "Display marked buffers in other frame." - (let ((bufs (helm-marked-candidates))) - (select-frame (make-frame)) - (helm-window-show-buffers bufs))) - -(defun helm-buffers-maybe-raise-buffer-frame (candidate) - "Raise buffer frame handling buffer CANDIDATE and switch to it." - (let ((oframe (window-frame (get-buffer-window candidate 0)))) - (unless (eql oframe (selected-frame)) - (raise-frame oframe)) - (with-selected-frame oframe - (switch-to-buffer candidate)))) - -(helm-make-command-from-action helm-buffer-switch-other-frame - "Run switch to other frame action from `helm-source-buffers-list'." - 'helm-buffer-switch-to-buffer-other-frame) - -(defun helm-buffers-switch-buffers-in-tab (_candidate) - "Display marked buffers in a new tab. -See `helm-buffers-switch-buffers-in-tab-1' for more infos." - (helm-buffers-switch-buffers-in-tab-1 (helm-marked-candidates))) - -(helm-make-command-from-action helm-buffers-switch-to-buffer-new-tab - "Run switch to buffer in other tab action from `helm-source-buffers-list'." - 'helm-buffers-switch-buffers-in-tab - (cl-assert (fboundp 'tab-bar-mode) nil "Tab-bar-mode not available")) - -(defun helm-buffer-switch-buffers (_candidate) - "Switch to buffer candidates and replace current buffer. - -If more than one buffer marked switch to these buffers in -separate windows. If a prefix arg is given split windows -vertically." - (let ((buffers (helm-marked-candidates))) - (helm-window-show-buffers buffers))) - -(defun helm-buffer-switch-buffers-other-window (_candidate) - "Switch to marked buffers in other windows." - (let ((buffers (helm-marked-candidates))) - (helm-window-show-buffers buffers t))) - -(helm-make-command-from-action helm-buffer-run-ediff - "Run ediff action from `helm-source-buffers-list'." - 'helm-ediff-marked-buffers) - -(helm-make-command-from-action helm-buffer-run-ediff-merge - "Run ediff action from `helm-source-buffers-list'." - 'helm-ediff-marked-buffers-merge) - -(defun helm-buffers-persistent-kill-1 (buffer-or-name) - "Persistent action to kill buffer." - (let ((buf (get-buffer buffer-or-name)) helm-buf-or-cur) - (if (or (and (eql buf (get-buffer helm-current-buffer)) - (setq helm-buf-or-cur "helm-current-buffer")) - (and (eql buf (get-buffer helm-buffer)) - (setq helm-buf-or-cur "helm-buffer"))) - (progn - (message "Can't kill `%s' without quitting session" helm-buf-or-cur) - (sit-for 1)) - (kill-buffer buf) - (helm-delete-current-selection)))) - -(defun helm-buffers--quote-truncated-buffer (buffer) - "Quote the truncated buffer-name of BUFFER. -buffer-name is truncated according to `helm-buffer-max-length' minus the length -of icon if one." - (let ((bufname (and (bufferp buffer) - (buffer-name buffer))) - (maxlen (if helm-buffers-show-icons - (- helm-buffer-max-length 2) - helm-buffer-max-length))) - (when (and bufname - (file-remote-p (with-current-buffer bufname - default-directory))) - (setq bufname (concat "@ " (helm-url-unhex-string bufname)))) - (when bufname - (regexp-quote - (if (and helm-buffer-max-length - helm-buffer-details-flag) - (helm-substring-by-width bufname maxlen "") - bufname))))) - -(defun helm-buffers-persistent-kill (_buffer) - (let* ((marked (helm-marked-candidates)) - (msg "Buffer `%s' modified, please save it before kill") - ;; After marking, selection should be after the last marked unless user - ;; has not moved, if deleting current, use current selection after - ;; having deleted. - (sel (and (cdr marked) (helm-get-selection)))) - (with-helm-buffer - (unwind-protect - (dolist (b marked) - (if (and (buffer-file-name b) (buffer-modified-p b)) - (progn (message msg (buffer-name b)) (sit-for 1)) - ;; We need to preselect each marked because - ;; helm-buffers-persistent-kill-1 is deleting - ;; current selection. - (helm-preselect - (format "^[[:multibyte:] ]*%s" - (helm-buffers--quote-truncated-buffer b))) - (helm-buffers-persistent-kill-1 b) - (helm--remove-marked-and-update-mode-line b))) - (setq helm-marked-candidates nil - helm-visible-mark-overlays nil)) - (helm-force-update (format "^[[:multibyte:] ]*%s" - (helm-buffers--quote-truncated-buffer - ;; Ensure user has not moved selection on one - ;; of marked. - (or (and (buffer-live-p sel) sel) - (helm-get-selection)))))))) - -(defun helm-buffers-list-persistent-action (candidate) - (let ((current (window-buffer helm-persistent-action-display-window))) - (if (or (helm-follow-mode-p) - (eql current (get-buffer helm-current-buffer)) - (not (eql current (get-buffer candidate)))) - (display-buffer candidate) - (if (and helm-persistent-action-display-window - (window-dedicated-p - (next-window helm-persistent-action-display-window 1))) - (delete-window helm-persistent-action-display-window) - (switch-to-buffer helm-current-buffer))))) - -(defun helm-ediff-marked-buffers (_candidate &optional merge) - "Ediff 2 marked buffers or CANDIDATE and `helm-current-buffer'. -With optional arg MERGE call `ediff-merge-buffers'." - (let* ((mkd (helm-marked-candidates)) - (lg-lst (length mkd)) - buf1 buf2) - (cl-case lg-lst - (0 - (error "Error:You have to mark at least 1 buffer")) - (1 - (setq buf1 helm-current-buffer - buf2 (cl-first mkd))) - (2 - (setq buf1 (cl-first mkd) - buf2 (cl-second mkd))) - (t - (error "Error:Too many buffers marked!"))) - (if merge - (ediff-merge-buffers buf1 buf2) - (ediff-buffers buf1 buf2)))) - -(defun helm-ediff-marked-buffers-merge (candidate) - "Ediff merge `helm-current-buffer' with CANDIDATE. -See `helm-ediff-marked-buffers'." - (helm-ediff-marked-buffers candidate t)) - -(defun helm-multi-occur-as-action (_candidate) - "Multi occur action for `helm-source-buffers-list'. -Can be used by any source that list buffers." - (let ((helm-occur-always-search-in-current - (if helm-current-prefix-arg - (not helm-occur-always-search-in-current) - helm-occur-always-search-in-current)) - (buffers (helm-marked-candidates)) - (input (cl-loop for i in (split-string (or (buffer-local-value - 'helm-input-local - (get-buffer helm-buffer)) - helm-pattern) - " " t) - thereis (and (string-match "\\`@\\([^!]*\\)" i) - (match-string 1 i))))) - (helm-multi-occur-1 buffers input))) - -(helm-make-command-from-action helm-buffers-run-occur - "Run `helm-multi-occur-as-action' by key." - 'helm-multi-occur-as-action) - -(defun helm-buffers-toggle-show-hidden-buffers () - (interactive) - (with-helm-alive-p - (let ((filter-attrs (helm-get-attr 'filtered-candidate-transformer - helm-source-buffers-list)) - (sel (helm-get-selection))) - (if (memq 'helm-shadow-boring-buffers filter-attrs) - (helm-set-attr 'filtered-candidate-transformer - (cons 'helm-skip-boring-buffers - (remove 'helm-shadow-boring-buffers - filter-attrs)) - helm-source-buffers-list) - (helm-set-attr 'filtered-candidate-transformer - (cons 'helm-shadow-boring-buffers - (remove 'helm-skip-boring-buffers - filter-attrs)) - helm-source-buffers-list)) - (helm-force-update (helm-buffers--quote-truncated-buffer sel))))) -(put 'helm-buffers-toggle-show-hidden-buffers 'helm-only t) - -(defun helm-buffers-browse-project (buf) - "Browse project from buffer BUF." - (with-current-buffer buf - (helm-browse-project helm-current-prefix-arg))) - -(helm-make-command-from-action helm-buffers-run-browse-project - "Run `helm-buffers-browse-project' from key." - 'helm-buffers-browse-project - (cl-assert (not helm-buffers-in-project-p) - nil "You are already browsing this project")) - -;;;###autoload -(defun helm-buffers-quit-and-find-file-fn (source) - (let* ((sel (get-buffer (helm-get-selection nil nil source))) - (bname (and (bufferp sel) (buffer-name sel)))) - (when bname - (or (buffer-file-name sel) - (car (rassoc bname dired-buffers)) - (and (with-current-buffer bname - (eq major-mode 'org-agenda-mode)) - org-directory - (expand-file-name org-directory)) - (with-current-buffer bname - (expand-file-name default-directory)))))) - -;;; Candidate Transformers -;; -;; -(defun helm-skip-boring-buffers (buffers _source) - "Remove buffers matching `helm-boring-buffer-regexp-list' in BUFFERS. -Where BUFFERS is a list of buffer names." - (helm-skip-entries buffers - helm-boring-buffer-regexp-list - helm-white-buffer-regexp-list)) - -(defun helm-shadow-boring-buffers (buffers _source) - "Buffers matching `helm-boring-buffer-regexp' will be -displayed with the `file-name-shadow' face if available." - (helm-shadow-entries buffers helm-boring-buffer-regexp-list)) - - -;;;###autoload -(defun helm-buffers-list () - "Preconfigured `helm' to list buffers." - (interactive) - (unless helm-source-buffers-list - (setq helm-source-buffers-list - (helm-make-source "Buffers" 'helm-source-buffers))) - (helm :sources '(helm-source-buffers-list - helm-source-buffer-not-found) - :buffer "*helm buffers*" - :truncate-lines helm-buffers-truncate-lines - :left-margin-width helm-buffers-left-margin-width)) - -;;;###autoload -(defun helm-mini () - "Preconfigured `helm' displaying `helm-mini-default-sources'." - (interactive) - (require 'helm-x-files) - (unless helm-source-buffers-list - (setq helm-source-buffers-list - (helm-make-source "Buffers" 'helm-source-buffers))) - (helm :sources helm-mini-default-sources - :buffer "*helm mini*" - :ff-transformer-show-only-basename nil - :truncate-lines helm-buffers-truncate-lines - :left-margin-width helm-buffers-left-margin-width)) - -(defun helm-quit-and-helm-mini () - "Drop into `helm-mini' from `helm'." - (interactive) - (with-helm-alive-p - (helm-run-after-exit 'helm-mini))) - -(provide 'helm-buffers) - -;;; helm-buffers.el ends here diff --git a/elpa/helm-20251212.555/helm-color.el b/elpa/helm-20251212.555/helm-color.el deleted file mode 100644 index de505472..00000000 --- a/elpa/helm-20251212.555/helm-color.el +++ /dev/null @@ -1,158 +0,0 @@ -;;; helm-color.el --- colors and faces -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2025 Thierry Volpiatto - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Code: -(require 'cl-lib) -(require 'helm) -(require 'helm-help) -(require 'helm-elisp) - -(declare-function list-colors-display "facemenu") - -;;; Customize Face -;; -;; -(defun helm-custom-faces-init () - "Initialize buffer for `helm-source-customize-face'." - (save-selected-window - (list-faces-display) - (message nil)) - (helm-init-candidates-in-buffer - 'global - (with-current-buffer (get-buffer "*Faces*") - (buffer-substring - (next-single-char-property-change (point-min) 'category) - (point-max)))) - (kill-buffer "*Faces*")) - -(defvar helm-source-customize-face - (helm-build-in-buffer-source "Customize Face" - :init 'helm-custom-faces-init - :get-line 'buffer-substring - :persistent-action (lambda (candidate) - (helm-elisp--persistent-help - (intern (car (split-string candidate))) - 'helm-describe-face)) - :persistent-help "Describe face" - :action `(("Customize" - . ,(lambda (line) - (customize-face (intern (car (split-string line)))))) - ("Copy name" - . ,(lambda (line) - (kill-new (car (split-string line " " t))))))) - "See (info \"(emacs)Faces\")") - -;;; Colors browser -;; -;; -(defun helm-colors-init () - (require 'facemenu) - (unless (helm-candidate-buffer) - (save-selected-window - (list-colors-display) - (message nil)) - (helm-init-candidates-in-buffer - 'global - (with-current-buffer (get-buffer "*Colors*") - (buffer-string))) - (kill-buffer "*Colors*"))) - -(defun helm-color-insert-name (candidate) - (with-helm-current-buffer - (insert (helm-colors-get-name candidate)))) - -(defun helm-color-kill-name (candidate) - (kill-new (helm-colors-get-name candidate))) - -(defun helm-color-insert-rgb (candidate) - (with-helm-current-buffer - (insert (helm-colors-get-rgb candidate)))) - -(defun helm-color-kill-rgb (candidate) - (kill-new (helm-colors-get-rgb candidate))) - -(helm-make-command-from-action helm-color-run-insert-name - "Insert name of color from `helm-source-colors'." - 'helm-color-insert-name) - -(helm-make-command-from-action helm-color-run-kill-name - "Kill name of color from `helm-source-colors'." - 'helm-color-kill-name) - -(helm-make-command-from-action helm-color-run-insert-rgb - "Insert RGB of color from `helm-source-colors'." - 'helm-color-insert-rgb) - -(helm-make-command-from-action helm-color-run-kill-rgb - "Kill RGB of color from `helm-source-colors'." - 'helm-color-kill-rgb) - -(defvar helm-color-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-map) - (define-key map (kbd "C-c n") #'helm-color-run-insert-name) - (define-key map (kbd "C-c N") #'helm-color-run-kill-name) - (define-key map (kbd "C-c r") #'helm-color-run-insert-rgb) - (define-key map (kbd "C-c R") #'helm-color-run-kill-rgb) - map)) - -(defvar helm-source-colors - (helm-build-in-buffer-source "Colors" - :init 'helm-colors-init - :get-line 'buffer-substring - :keymap helm-color-map - :persistent-help "Kill entry in RGB format." - :persistent-action 'helm-color-kill-rgb - :help-message 'helm-colors-help-message - :action - '(("Copy Name (C-c N)" . helm-color-kill-name) - ("Copy RGB (C-c R)" . helm-color-kill-rgb) - ("Insert Name (C-c n)" . helm-color-insert-name) - ("Insert RGB (C-c r)" . helm-color-insert-rgb)))) - -(defun helm-colors-get-name (candidate) - "Get color name." - (replace-regexp-in-string - " " "" - (with-temp-buffer - (insert (capitalize candidate)) - (goto-char (point-min)) - (search-forward-regexp "\\s-\\{2,\\}") - (delete-region (point) (point-max)) - (buffer-string)))) - -(defun helm-colors-get-rgb (candidate) - "Get color RGB." - (replace-regexp-in-string - " " "" - (with-temp-buffer - (insert (capitalize candidate)) - (goto-char (point-max)) - (search-backward-regexp "\\s-\\{2,\\}") - (delete-region (point) (point-min)) - (buffer-string)))) - -;;;###autoload -(defun helm-colors () - "Preconfigured `helm' for color." - (interactive) - (helm :sources '(helm-source-colors helm-source-customize-face) - :buffer "*helm colors*")) - -(provide 'helm-color) - -;;; helm-color.el ends here diff --git a/elpa/helm-20251212.555/helm-command.el b/elpa/helm-20251212.555/helm-command.el deleted file mode 100644 index cb6b6425..00000000 --- a/elpa/helm-20251212.555/helm-command.el +++ /dev/null @@ -1,477 +0,0 @@ -;;; helm-command.el --- Helm execute-exended-command. -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2025 Thierry Volpiatto - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Code: - -(require 'cl-lib) -(require 'helm) -(require 'helm-help) -(require 'helm-mode) -(require 'helm-elisp) - - -(defvar helm-M-x-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-comp-read-map) - (define-key map (kbd "C-u") nil) - (define-key map (kbd "C-u") #'helm-M-x-universal-argument) - (define-key map (kbd "C-]") #'helm-M-x-toggle-short-doc) - map)) - - -(defgroup helm-command nil - "Emacs command related Applications and libraries for Helm." - :group 'helm) - -(defcustom helm-M-x-always-save-history nil - "`helm-M-x' save command in `extended-command-history' even when it fails." - :type 'boolean) - -(defcustom helm-M-x-reverse-history nil - "The history source of `helm-M-x' appear in second position when non-nil." - :type 'boolean) - -(defcustom helm-M-x-fuzzy-match t - "Helm-M-x fuzzy matching when non nil." - :type 'boolean) - -(defcustom helm-M-x-show-short-doc nil - "Show short docstring of command when non nil. -This value can be toggled with -\\\\[helm-M-x-toggle-short-doc] while in helm-M-x session." - :type 'boolean) - -(defcustom helm-M-x-history-transformer-sort t - "When nil, do not sort helm-M-x's commands history." - :type 'boolean) - -(defcustom helm-M-x-exclude-unusable-commands-in-mode t - "When non nil exclude commands not usable in current buffer. -This will exclude only commands defined with `interactive' MODES argument, for -other commands, they will be displayed even if unusable as long as they satisfies -`commandp'. -NOTE: As `interactive' MODES argument is relatively recent, not all commands are -using it when they should, so do not expect ALL unuseful commands to be excluded -in `helm-M-x'. Also in Emacsen with a version of `interactive' not handling -MODES, this will have no effect. Regardless of this Helm commands unrelated to -Helm will never appear in `helm-M-x' whatever the value of this var is." - :type 'boolean) - -;;; Faces -;; -;; -(defgroup helm-command-faces nil - "Customize the appearance of helm-command." - :prefix "helm-" - :group 'helm-command - :group 'helm-faces) - -(defface helm-M-x-key - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :foreground "orange" :box (:line-width -1))) - "Face used in helm-M-x to show keybinding." - :group 'helm-command-faces) - -(defface helm-command-major-active-mode - '((t :inherit font-lock-builtin-face)) - "Face used by `helm-M-x' for activated major modes." - :group 'helm-command-faces) - -(defface helm-command-minor-active-mode - '((t :inherit font-lock-type-face)) - "Face used by `helm-M-x' for activated minor modes." - :group 'helm-command-faces) - -(defface helm-command-debug-active - '((t :inherit font-lock-warning-face)) - "Face used by `helm-M-x' for activated toggle-debug-on-* commands." - :group 'helm-command-faces) - -(defface helm-M-x-short-doc - '((t :box (:line-width -1) :foreground "DimGray")) - "Face used by `helm-M-x' for short docstring." - :group 'helm-command-faces) - -(defvar helm-M-x-input-history nil) -(defvar helm-M-x-prefix-argument nil - "Prefix argument before calling `helm-M-x'.") -(defvar helm-M-x--timer nil) -(defvar helm-M-x--unwind-forms-done nil) - -(defun helm-M-x-get-major-mode-command-alist (mode-map) - "Return alist of MODE-MAP." - (when mode-map - (cl-loop for key being the key-seqs of mode-map using (key-bindings com) - for str-key = (key-description key) - for ismenu = (string-match "" str-key) - unless ismenu collect (cons str-key com)))) - -(defun helm-get-mode-map-from-mode (mode) - "Guess the mode-map name according to MODE. -Some modes don't use conventional mode-map name so we need to -guess mode-map name. E.g. `python-mode' ==> py-mode-map. -Return nil if no mode-map found." - (cl-loop ;; Start with a conventional mode-map name. - with mode-map = (intern-soft (format "%s-map" mode)) - with mode-string = (symbol-name mode) - with mode-name = (replace-regexp-in-string "-mode" "" mode-string) - while (not mode-map) - for count downfrom (length mode-name) - ;; Return when no result after parsing entire string. - when (eq count 0) return nil - for sub-name = (substring mode-name 0 count) - do (setq mode-map (intern-soft (format "%s-map" (concat sub-name "-mode")))) - finally return mode-map)) - -(defun helm-M-x-current-mode-map-alist () - "Return mode-map alist of current `major-mode'." - (let ((map-sym (helm-get-mode-map-from-mode major-mode))) - (when (and map-sym (boundp map-sym)) - (helm-M-x-get-major-mode-command-alist (symbol-value map-sym))))) - -(defun helm-M-x-toggle-short-doc () - "Toggle short doc display in helm-M-x." - (interactive) - (setq helm-M-x-show-short-doc (not helm-M-x-show-short-doc)) - (helm-force-update (concat "^" (helm-get-selection)) (helm-get-current-source))) -(put 'helm-M-x-toggle-short-doc 'no-helm-mx t) - -(defun helm-M-x-transformer-1 (candidates &optional sort ignore-props) - "Transformer function to show bindings in emacs commands. -Show global bindings and local bindings according to current -`major-mode'. -If SORT is non nil sort list with `helm-generic-sort-fn'. -Note that SORT should not be used when fuzzy matching because -fuzzy matching is running its own sort function with a different -algorithm." - (with-helm-current-buffer - (cl-loop with local-map = (helm-M-x-current-mode-map-alist) - for cand in candidates - for local-key = (car (rassq cand local-map)) - for key = (substitute-command-keys (format "\\[%s]" cand)) - for sym = (intern (if (consp cand) (car cand) cand)) - for doc = (when helm-M-x-show-short-doc - (helm-get-first-line-documentation (intern-soft cand))) - for disp = (cond ((eq sym major-mode) - (propertize cand 'face 'helm-command-major-active-mode)) - ((and (memq sym minor-mode-list) - (boundp sym) - (buffer-local-value - sym helm-current-buffer)) - (propertize cand 'face 'helm-command-minor-active-mode)) - ((or (and (eq sym 'toggle-debug-on-error) - debug-on-error) - (and (eq sym 'toggle-debug-on-quit) - debug-on-quit)) - (propertize cand 'face 'helm-command-debug-active)) - (t cand)) - unless (and (null ignore-props) - (or (get sym 'helm-only) (get sym 'no-helm-mx) - (eq sym 'helm-M-x))) - collect - (cons (cond ((and (string-match "^M-x" key) local-key) - (propertize - (format "%s%s%s %s" - disp - (if doc (helm-make-separator cand) "") - (if doc - (propertize - doc 'face 'helm-M-x-short-doc) - "") - (propertize - " " 'display - (propertize local-key 'face 'helm-M-x-key))) - 'match-part disp)) - ((and (string-match "^M-x" key) - (not (string= key "M-x"))) - (propertize - (format "%s%s%s" - disp - (if doc (helm-make-separator cand) "") - (if doc - (propertize - doc 'face 'helm-M-x-short-doc) - "")) - 'match-part disp)) - (t (propertize - (format "%s%s%s %s" - disp - (if doc (helm-make-separator cand) "") - (if doc - (propertize - doc 'face 'helm-M-x-short-doc) - "") - (propertize - " " 'display - (propertize key 'face 'helm-M-x-key))) - 'match-part disp))) - cand) - into ls - finally return - (if sort (sort ls #'helm-generic-sort-fn) ls)))) - -(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-no-sort (candidates _source) - "Transformer function for `helm-M-x' candidates." - (helm-M-x-transformer-1 candidates)) - -(defun helm-M-x-transformer-no-sort-no-props (candidates _source) - "Transformer function for `helm-M-x' candidates." - (helm-M-x-transformer-1 candidates nil t)) - -(defun helm-M-x--notify-prefix-arg () - ;; Notify a prefix-arg set AFTER calling M-x. - (when prefix-arg - (with-helm-window - (helm-display-mode-line (helm-get-current-source) 'force)))) - -(defun helm-cmd--get-current-function-name () - (save-excursion - (beginning-of-defun) - (cadr (split-string (buffer-substring-no-properties - (pos-bol) (pos-eol)))))) - -(defun helm-cmd--get-preconfigured-commands (&optional dir) - (let* ((helm-dir (or dir (helm-basedir (locate-library "helm")))) - (helm-autoload-file (expand-file-name "helm-autoloads.el" helm-dir)) - results) - (when (file-exists-p helm-autoload-file) - (with-temp-buffer - (insert-file-contents helm-autoload-file) - (while (re-search-forward "Preconfigured" nil t) - (push (substring (helm-cmd--get-current-function-name) 1) results)))) - results)) - -(defun helm-M-x-universal-argument () - "Same as `universal-argument' but for `helm-M-x'." - (interactive) - (if helm-M-x-prefix-argument - (progn (setq helm-M-x-prefix-argument nil) - (let ((inhibit-read-only t)) - (with-selected-window (minibuffer-window) - (save-excursion - (goto-char (point-min)) - (delete-char (- (minibuffer-prompt-width) (length "M-x ")))))) - (message "Initial prefix arg disabled")) - (setq prefix-arg (list 4)) - (universal-argument--mode))) -(put 'helm-M-x-universal-argument 'helm-only t) - -(defun helm-M-x-persistent-action (candidate) - (helm-elisp--persistent-help - candidate 'helm-describe-function)) - -(defun helm-M-x--move-selection-after-hook () - (setq current-prefix-arg nil)) - -(defun helm-M-x--before-action-hook () - (remove-hook 'helm-move-selection-after-hook - #'helm-M-x--move-selection-after-hook)) - -(defclass helm-M-x-class (helm-source-in-buffer helm-type-command) - ((requires-pattern :initform 0) - (must-match :initform t) - (filtered-candidate-transformer :initform #'helm-M-x-transformer) - (persistent-help :initform "Describe this command") - (help-message :initform 'helm-M-x-help-message) - (nomark :initform t) - (cleanup :initform #'helm-M-x--unwind-forms) - (keymap :initform 'helm-M-x-map) - (resume :initform 'helm-M-x-resume-fn))) - -(defun helm-M-x-resume-fn () - (when (and helm-M-x--timer (timerp helm-M-x--timer)) - (cancel-timer helm-M-x--timer) - (setq helm-M-x--timer nil)) - (setq helm-M-x--timer (run-at-time 1 0.1 #'helm-M-x--notify-prefix-arg)) - (setq helm--mode-line-display-prefarg t) - ;; Prevent displaying a wrong prefix arg when helm-resume is called - ;; from prefix arg. - (setq current-prefix-arg nil)) - -(defun helm-M-x-read-extended-command (collection &optional predicate history) - "Read or execute action on command name in COLLECTION or HISTORY. - -Helm completion is not provided when executing or defining kbd macros. - -Arg COLLECTION should be an `obarray'. -Arg PREDICATE is a function that default to `commandp'. -Arg HISTORY default to `extended-command-history'." - (setq helm--mode-line-display-prefarg t) - (let* ((pred (or predicate #'commandp)) - (helm-fuzzy-sort-fn (lambda (candidates _source) - (if helm-M-x-history-transformer-sort - ;; Sort on real candidate otherwise - ;; "symbol ()" is used when sorting. - (helm-fuzzy-matching-default-sort-fn-1 candidates t) - candidates))) - (sources `(,(helm-make-source "Emacs Commands history" 'helm-M-x-class - :data (lambda () - (helm-comp-read-get-candidates - ;; History should be quoted to - ;; force `helm-comp-read-get-candidates' - ;; to use predicate against - ;; symbol and not string. - (or history 'extended-command-history) - ;; Ensure using empty string to - ;; not defeat helm matching fns [1] - pred nil nil "")) - :filtered-candidate-transformer - (if helm-M-x-history-transformer-sort - #'helm-M-x-transformer - #'helm-M-x-transformer-no-sort) - :fuzzy-match helm-M-x-fuzzy-match) - ,(helm-make-source "Emacs Commands" 'helm-M-x-class - :data (lambda () - (helm-comp-read-get-candidates - ;; [1] Same comment as above. - collection pred nil nil "")) - :fuzzy-match helm-M-x-fuzzy-match))) - (prompt (concat (helm-acase helm-M-x-prefix-argument - (- "-") - ;; Why &rest? isn't this always a list of one arg? - ((dst* (l &rest args)) - (if (eq l 4) "C-u " (format "%d " l))) - ((guard* (integerp it)) (format "%d " it))) - "M-x "))) - (setq helm-M-x--timer (run-at-time 1 0.1 #'helm-M-x--notify-prefix-arg)) - ;; Fix Bug#2250, add `helm-move-selection-after-hook' which - ;; reset prefix arg to nil only for this helm session. - (add-hook 'helm-move-selection-after-hook - #'helm-M-x--move-selection-after-hook) - (add-hook 'helm-before-action-hook - #'helm-M-x--before-action-hook) - (when (and sources helm-M-x-reverse-history) - (setq sources (nreverse sources))) - (unwind-protect - (progn - (setq current-prefix-arg nil) - (helm :sources sources - :prompt prompt - :buffer "*helm M-x*" - :history 'helm-M-x-input-history - :truncate-lines t)) - (helm-M-x--unwind-forms)))) - -;; When running a command involving again helm from helm-M-x, the -;; unwind-protect UNWINDS forms are executed only once this helm -;; command exit leaving the helm-M-x timer running and other variables -;; and hooks not unset, so the timer is now in a global var and all -;; the forms that should normally run in unwind-protect are running as -;; well as soon as helm-M-x-execute-command is called. -(defun helm-M-x--unwind-forms (&optional done) - ;; helm-M-x--unwind-forms-done is non nil when it have been called - ;; once from helm-M-x-execute-command. - (unless helm-M-x--unwind-forms-done - (when (timerp helm-M-x--timer) - (cancel-timer helm-M-x--timer) - (setq helm-M-x--timer nil)) - (setq helm--mode-line-display-prefarg nil - helm-fuzzy-sort-fn (default-toplevel-value 'helm-fuzzy-sort-fn)) - ;; Be sure to remove it here as well in case of quit. - (remove-hook 'helm-move-selection-after-hook - #'helm-M-x--move-selection-after-hook) - (remove-hook 'helm-before-action-hook - #'helm-M-x--before-action-hook)) - ;; Reset helm-M-x--unwind-forms-done to nil when DONE is - ;; unspecified. - (setq helm-M-x--unwind-forms-done done)) - -(defun helm-M-x-execute-command (command) - "Execute COMMAND as an editor command. -COMMAND must be a symbol that satisfies the `commandp' predicate. -Save COMMAND to `extended-command-history'." - (helm-M-x--unwind-forms t) - (when command - ;; Avoid having `this-command' set to *exit-minibuffer. - (setq this-command command - ;; Handle C-x z (repeat) Bug#322 - real-this-command command) - ;; If helm-M-x is called with regular emacs completion (kmacro) - ;; use the value of arg otherwise use helm-current-prefix-arg. - (let ((prefix-arg (or helm-current-prefix-arg helm-M-x-prefix-argument)) - (command-name (symbol-name command))) - (condition-case-unless-debug err - (progn - (command-execute command 'record) - (add-to-history 'extended-command-history command-name)) - (error - (when helm-M-x-always-save-history - (add-to-history 'extended-command-history command-name)) - (signal (car err) (cdr err))))))) - -(defun helm-M-x--vanilla-M-x () - (helm-M-x-execute-command - (intern-soft - (if helm-mode - (unwind-protect - (progn - (helm-mode -1) - (read-extended-command)) - (helm-mode 1)) - (read-extended-command))))) - -(defun helm-M-x--mode-predicate (symbol mj-mode lmm-modes) - "Check if SYMBOL is suitable for current buffer. -MJ-MODE is used to pass major-mode and LMM-MODES to pass local-minor-modes. -This predicate honors commands defined with the `interactive' MODES argument." - (let* ((sym (helm-symbolify symbol)) - (modes (command-modes sym))) - (and (commandp sym) - (if modes - (or (memq mj-mode modes) - (cl-loop for m in modes thereis - (or (memq m lmm-modes) - (memq m global-minor-modes)))) - t)))) - -;;;###autoload -(defun helm-M-x (_arg) - "Preconfigured `helm' for Emacs commands. -It is `helm' replacement of regular `M-x' -`execute-extended-command'. - -Unlike regular `M-x' Emacs vanilla `execute-extended-command' -command, the prefix args if needed, can be passed AFTER starting -`helm-M-x'. When a prefix arg is passed BEFORE starting -`helm-M-x', the first `C-u' while in `helm-M-x' session will -disable it. - -You can get help on each command by persistent action." - (interactive - (progn - (setq helm-M-x-prefix-argument current-prefix-arg) - (list current-prefix-arg))) - (if (or defining-kbd-macro executing-kbd-macro) - (helm-M-x--vanilla-M-x) - (let ((lmm-modes (and (boundp 'local-minor-modes) ; Only 28+ (issue#2719) - (buffer-local-value 'local-minor-modes (current-buffer)))) - (mj-mode major-mode)) - (helm-M-x-read-extended-command - obarray (if (and (fboundp 'command-modes) - helm-M-x-exclude-unusable-commands-in-mode) - (lambda (sym) (helm-M-x--mode-predicate sym mj-mode lmm-modes)) - #'commandp))))) -(put 'helm-M-x 'interactive-only 'command-execute) - -(provide 'helm-command) - -;;; helm-command.el ends here diff --git a/elpa/helm-20251212.555/helm-dabbrev.el b/elpa/helm-20251212.555/helm-dabbrev.el deleted file mode 100644 index ef522feb..00000000 --- a/elpa/helm-20251212.555/helm-dabbrev.el +++ /dev/null @@ -1,388 +0,0 @@ -;;; helm-dabbrev.el --- Helm implementation of dabbrev. -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2025 Thierry Volpiatto - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Code: - -(require 'helm) -(require 'helm-lib) -(require 'helm-help) -(require 'helm-elisp) ; For show-completion. - -(defgroup helm-dabbrev nil - "Dabbrev related Applications and libraries for Helm." - :group 'helm) - -(defcustom helm-dabbrev-always-search-all t - "Always search in all buffers when non--nil. -Note that even if nil, a search in all buffers will occur if the -length of candidates is <= than -`helm-dabbrev-max-length-result'." - :type 'boolean) - -(defcustom helm-dabbrev-candidates-number-limit 1000 - "Maximum number of candidates to collect. - -The higher this number is, the slower the computation of -candidates will be. You can use safely a higher value with -emacs-26+. -Note that this have nothing to do with -`helm-candidate-number-limit', this means that computation of -candidates stop when this value is reached but only -`helm-candidate-number-limit' candidates are displayed in the -Helm buffer." - :type 'integer) - -(defcustom helm-dabbrev-ignored-buffers-regexps - '("\\*helm" "\\*Messages" "\\*Echo Area" "\\*Buffer List") - "List of regexps matching names of buffers that `helm-dabbrev' should not check." - :type '(repeat regexp)) - -(defcustom helm-dabbrev-related-buffer-fn #'helm-dabbrev--same-major-mode-p - "A function that decide if a buffer to search in its related to `current-buffer'. - -This is currently determined by comparing `major-mode' of the -buffer to search and the `current-buffer'. - -The function take one arg, the buffer which is current, look at -`helm-dabbrev--same-major-mode-p' for an example. - -When nil all buffers are considered related to `current-buffer'." - :type 'function) - -(defcustom helm-dabbrev-major-mode-assoc nil - "Major mode association alist. - -This allow helm-dabbrev searching in buffers with the associated -`major-mode'. -E.g. (emacs-lisp-mode . lisp-interaction-mode) - -will allow searching in the lisp-interaction-mode buffer when -`current-buffer' is an `emacs-lisp-mode' buffer and vice versa -i.e. no need to provide (lisp-interaction-mode . -emacs-lisp-mode) association. - -When nil check is the searched buffer has same `major-mode' than -the `current-buffer'. - -This has no effect when `helm-dabbrev-related-buffer-fn' is nil -or of course bound to a function that doesn't handle this var." - :type '(alist :key-type symbol :value-type symbol)) - -(defcustom helm-dabbrev-lineno-around 30 - "Search first in this number of lines before and after point." - :type 'integer) - -(defcustom helm-dabbrev-cycle-threshold 5 - "Number of time helm-dabbrev cycle before displaying helm completion. -When nil or 0 disable cycling." - :type '(choice (const :tag "Cycling disabled" nil) integer)) - -(defcustom helm-dabbrev-case-fold-search 'smart - "Set `case-fold-search' in `helm-dabbrev'. -Same as `helm-case-fold-search' but for `helm-dabbrev'. -Note that this is not affecting searching in Helm buffer, but the -initial search for all candidates in buffer(s)." - :type '(choice (const :tag "Ignore case" t) - (const :tag "Respect case" nil) - (other :tag "Smart" smart))) - -(defvaralias 'helm-dabbrev--regexp 'helm-dabbrev-separator-regexp) -(make-obsolete-variable 'helm-dabbrev--regexp - 'helm-dabbrev-separator-regexp "2.8.3") -;; Check for beginning of line should happen last (^\n\\|^). -(defvar helm-dabbrev-separator-regexp - "\\s-\\|\t\\|[(\\[\\{\"'`=<>$;,@.#+]\\|\\s\\\\|^\n\\|^" - "Regexp matching the start of a dabbrev candidate.") - - -(defvar helm-dabbrev-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-map) - (define-key map (kbd "M-/") #'helm-next-line) - (define-key map (kbd "M-:") #'helm-previous-line) - map)) - -;; Internal -(defvar helm-dabbrev--cache nil) -(defvar helm-dabbrev--data nil) -(cl-defstruct helm-dabbrev-info dabbrev limits iterator) -(defvar helm-dabbrev--already-tried nil) -(defvar helm-dabbrev--computing-cache nil - "[INTERNAL] Flag to notify helm-dabbrev is blocked. -Do nothing when non nil.") - -(defun helm-dabbrev--buffer-list () - (cl-loop for buf in (buffer-list) - unless (cl-loop for r in helm-dabbrev-ignored-buffers-regexps - thereis (string-match r (buffer-name buf))) - collect buf)) - -(defun helm-dabbrev--same-major-mode-p (start-buffer) - "Decide if current-buffer is related to START-BUFFER." - (helm-same-major-mode-p start-buffer helm-dabbrev-major-mode-assoc)) - -(defun helm-dabbrev--collect (str limit ignore-case all) - (let* ((case-fold-search ignore-case) - (buffer1 (current-buffer)) ; start buffer. - (minibuf (minibufferp buffer1)) - results pos-before pos-after) - (catch 'break - (dolist (buf (if all (helm-dabbrev--buffer-list) - (list (current-buffer)))) - (with-current-buffer buf - (when (or minibuf ; check against all buffers when in minibuffer. - (if helm-dabbrev-related-buffer-fn - (funcall helm-dabbrev-related-buffer-fn buffer1) - t)) - (save-excursion - ;; Start searching before thing before point. - (goto-char (- (point) (length str))) - ;; Search the last 30 lines BEFORE point and set POS-BEFORE. - (cl-multiple-value-bind (res _pa pb) - (helm-dabbrev--search-and-store str -2 limit results) - (setq results res - ;; No need to set POS-AFTER here. - pos-before pb))) - (save-excursion - ;; Search the next 30 lines AFTER point and set POS-AFTER. - (cl-multiple-value-bind (res pa _pb) - (helm-dabbrev--search-and-store str 2 limit results) - (setq results res - ;; No need to set POS-BEFORE, we keep the last - ;; value found. - pos-after pa))) - (save-excursion - ;; Search all BEFORE point maybe starting from - ;; POS-BEFORE to not search again what previously found. - ;; If limit is reached in previous call of - ;; `helm-dabbrev--search-and-store' POS-BEFORE is nil and - ;; goto-char will fail, so check it. - (when pos-before (goto-char pos-before)) - (cl-multiple-value-bind (res _pa _pb) - (helm-dabbrev--search-and-store str -1 limit results) - ;; No need to set POS-BEFORE and POS-AFTER here. - (setq results res))) - (save-excursion - ;; Search all AFTER point maybe starting from POS-AFTER. - ;; Same comment as above for POS-AFTER. - (when pos-after (goto-char pos-after)) - (cl-multiple-value-bind (res _pa _pb) - (helm-dabbrev--search-and-store str 1 limit results) - ;; No need to set POS-BEFORE and POS-AFTER here. - (setq results res))))) - (when (>= (length results) limit) (throw 'break nil)))) - (nreverse results))) - -(defun helm-dabbrev--search-and-store (pattern direction limit results) - "Search words or symbols matching PATTERN in DIRECTION up to LIMIT. -Finally returns all matched candidates appended to RESULTS. -Argument DIRECTION can be: - - (1): Search forward from point. - - (-1): Search backward from point. - - (2): Search forward from the - `helm-dabbrev-lineno-around' - lines after point. - - (-2): Search backward from the - `helm-dabbrev-lineno-around' - lines before point." - (let ((res results) - after before) - (while (and (<= (length res) limit) - (cl-case direction - (1 (search-forward pattern nil t)) - (-1 (search-backward pattern nil t)) - (2 (let ((pos - (save-excursion - (forward-line - helm-dabbrev-lineno-around) - (point)))) - (setq after pos) - (search-forward pattern pos t))) - (-2 (let ((pos - (save-excursion - (forward-line - (- helm-dabbrev-lineno-around)) - (point)))) - (setq before pos) - (search-backward pattern pos t))))) - (let* ((mb (match-beginning 0)) - (replace-regexp (concat "\\(" helm-dabbrev-separator-regexp - "\\)\\'")) - (match-word (helm-dabbrev--search - pattern mb replace-regexp))) - (when (and match-word (not (member match-word res))) - (push match-word res)))) - (list res after before))) - -(defun helm-dabbrev--search (pattern beg sep-regexp) - "Search word or symbol at point matching PATTERN. -Argument BEG is corresponding to the previous `match-beginning' -search. -The search starts at (1- BEG) with a regexp starting with -`helm-dabbrev-separator-regexp' followed by PATTERN followed by a -regexp matching syntactically any word or symbol. -The possible false positives matching SEP-REGEXP at end are -finally removed." - (let ((eol (pos-eol))) - (save-excursion - (goto-char (1- beg)) - (when (re-search-forward - (concat "\\(" - helm-dabbrev-separator-regexp - "\\)" - "\\(?99:\\(" - (regexp-quote pattern) - "\\(\\sw\\|\\s_\\)+\\)\\)") - eol t) - (replace-regexp-in-string - sep-regexp "" - (match-string-no-properties 99)))))) - -(defun helm-dabbrev--get-candidates (dabbrev &optional limit) - (cl-assert dabbrev nil "[No Match]") - (helm-dabbrev--collect - dabbrev (or limit helm-dabbrev-candidates-number-limit) - (cl-case helm-dabbrev-case-fold-search - (smart (helm-set-case-fold-search-1 dabbrev)) - (t helm-dabbrev-case-fold-search)) - helm-dabbrev-always-search-all)) - -(defun helm-dabbrev-default-action (candidate) - (with-helm-current-buffer - (let* ((limits (helm-bounds-of-thing-before-point - helm-dabbrev-separator-regexp)) - (beg (car limits)) - (end (point))) - (run-with-timer - 0.01 nil - #'helm-insert-completion-at-point - beg end candidate)))) - -;;;###autoload -(cl-defun helm-dabbrev () - "Preconfigured helm for dynamic abbreviations." - (interactive) - (unless helm-dabbrev--computing-cache - (let ((dabbrev (helm-thing-before-point - nil helm-dabbrev-separator-regexp)) - (limits (helm-bounds-of-thing-before-point - helm-dabbrev-separator-regexp)) - (enable-recursive-minibuffers t) - (cycling-disabled-p (or (null helm-dabbrev-cycle-threshold) - (zerop helm-dabbrev-cycle-threshold))) - (helm-execute-action-at-once-if-one t) - (helm-quit-if-no-candidate - (lambda () - (message "[Helm-dabbrev: No expansion found]")))) - (cl-assert (and (stringp dabbrev) (not (string= dabbrev ""))) - nil "[Helm-dabbrev: Nothing found before point]") - (when (and - ;; have been called at least once. - (helm-dabbrev-info-p helm-dabbrev--data) - ;; But user have moved with some other command - ;; in the meaning time. - (not (eq last-command 'helm-dabbrev))) - (setq helm-dabbrev--data nil)) - ;; When candidates are requested in helm directly without cycling, - ;; we need them right now before running helm. - (when cycling-disabled-p - (message "Waiting for helm-dabbrev candidates...") - (setq helm-dabbrev--cache (helm-dabbrev--get-candidates dabbrev))) - (unless (or cycling-disabled-p - (helm-dabbrev-info-p helm-dabbrev--data)) - (setq helm-dabbrev--data - (make-helm-dabbrev-info - :dabbrev dabbrev - :limits limits - :iterator - (helm-iter-list - (cl-loop for i in (helm-dabbrev--get-candidates - dabbrev helm-dabbrev-cycle-threshold) - when (string-match-p - (concat "^" (regexp-quote dabbrev)) i) - collect i))))) - (let ((iter (and (helm-dabbrev-info-p helm-dabbrev--data) - (helm-dabbrev-info-iterator helm-dabbrev--data))) - deactivate-mark) - ;; Cycle until iterator is consumed. - (helm-aif (and iter (helm-iter-next iter)) - (progn - (helm-insert-completion-at-point - (car (helm-dabbrev-info-limits helm-dabbrev--data)) - ;; END is the end of the previous inserted string, not - ;; the end (apart for first insertion) of the initial string. - (cdr limits) it) - ;; Move already tried candidates to end of list. - (push it helm-dabbrev--already-tried)) - ;; Iterator is now empty, or cycling was disabled, maybe - ;; reset dabbrev to initial value and start helm completion. - (let* ((old-dabbrev (if (helm-dabbrev-info-p helm-dabbrev--data) - (helm-dabbrev-info-dabbrev helm-dabbrev--data) - dabbrev)) - (only-one (eq (length helm-dabbrev--already-tried) 1))) - (unless helm-dabbrev--cache ; Already computed when - ; cycling is disabled. - (message "Waiting for helm-dabbrev candidates...") - (setq helm-dabbrev--computing-cache t) - (setq helm-dabbrev--cache - (helm-dabbrev--get-candidates old-dabbrev)) - ;; If user continues typing M-/ while display is blocked by - ;; helm-dabbrev--get-candidates delete these events. - (setq unread-command-events nil)) - ;; If the length of candidates is only one when computed - ;; that's mean the unique matched item have already been - ;; inserted by the iterator, so no need to reinsert the old dabbrev, - ;; just let helm exiting with "No expansion found". - (unless (or only-one cycling-disabled-p) - (setq dabbrev old-dabbrev - limits (helm-dabbrev-info-limits helm-dabbrev--data)) - (setq helm-dabbrev--data nil) - (delete-region (car limits) (point)) - (insert dabbrev)) - (when (and (null cycling-disabled-p) only-one) - (setq helm-dabbrev--cache nil - helm-dabbrev--already-tried nil - helm-dabbrev--computing-cache nil) - (cl-return-from helm-dabbrev - (message "[Helm-dabbrev: No expansion found]"))) - (with-helm-show-completion (car limits) (cdr limits) - (unwind-protect - (helm :sources - (helm-build-in-buffer-source "Dabbrev Expand" - :data - (append - (cl-loop with lst = helm-dabbrev--cache - for cand in helm-dabbrev--already-tried - do (setq lst (delete cand lst)) - finally return lst) - helm-dabbrev--already-tried) - :persistent-action 'ignore - :persistent-help "DoNothing" - :keymap helm-dabbrev-map - :action 'helm-dabbrev-default-action - :group 'helm-dabbrev) - :buffer "*helm dabbrev*" - :input (concat "^" dabbrev " ") - :resume 'noresume - :allow-nest t) - (setq helm-dabbrev--computing-cache nil - helm-dabbrev--already-tried nil - helm-dabbrev--cache nil))))))))) - -(provide 'helm-dabbrev) - -;;; helm-dabbrev.el ends here diff --git a/elpa/helm-20251212.555/helm-easymenu.el b/elpa/helm-20251212.555/helm-easymenu.el deleted file mode 100644 index 03b7d166..00000000 --- a/elpa/helm-20251212.555/helm-easymenu.el +++ /dev/null @@ -1,85 +0,0 @@ -;;; helm-easymenu.el --- Helm easymenu definitions. -*- lexical-binding: t -*- - -;; Copyright (C) 2015 ~ 2025 Thierry Volpiatto - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Code: - -(require 'easymenu) - -(easy-menu-add-item - nil '("Tools") - '("Helm" - ["Find any Files/Buffers" helm-multi-files t] - ["Helm Everywhere (Toggle)" helm-mode t] - ["Helm resume" helm-resume t] - "----" - ("Files" - ["Find files" helm-find-files t] - ["Recent Files" helm-recentf t] - ["Locate" helm-locate t] - ["Search Files with find" helm-find t] - ["Bookmarks" helm-filtered-bookmarks t] - ["Locate library" helm-locate-library t]) - ("Buffers" - ["Find buffers" helm-buffers-list t]) - ("Projects" - ["Browse project" helm-browse-project] - ["Projects history" helm-projects-history]) - ("Commands" - ["Emacs Commands" helm-M-x t] - ["Externals Commands" helm-run-external-command t]) - ("Help" - ["Helm Apropos" helm-apropos t]) - ("Info" - ["Info at point" helm-info-at-point t] - ["Emacs Manual index" helm-info-emacs t] - ["Gnus Manual index" helm-info-gnus t] - ["Helm documentation" helm-documentation t]) - ("Packages" - ["Elisp packages" helm-packages t] - ["Finder" helm-finder t]) - ("Tools" - ["Occur" helm-occur t] - ["Grep current directory with AG" helm-do-grep-ag t] - ["Gid" helm-gid t] - ["Etags" helm-etags-select t] - ["Lisp complete at point" helm-lisp-completion-at-point t] - ["Browse Kill ring" helm-show-kill-ring t] - ["Browse register" helm-register t] - ["Mark Ring" helm-all-mark-rings t] - ["Regexp handler" helm-regexp t] - ["Colors & Faces" helm-colors t] - ["Show xfonts" helm-select-xfont t] - ["Ucs Symbols" helm-ucs t] - ["Imenu" helm-imenu t] - ["Imenu all" helm-imenu-in-all-buffers t] - ["Semantic or Imenu" helm-semantic-or-imenu t] - ["Google Suggest" helm-google-suggest t] - ["Eval expression" helm-eval-expression-with-eldoc t] - ["Calcul expression" helm-calcul-expression t] - ["Man pages" helm-man-woman t] - ["Top externals process" helm-top t] - ["Emacs internals process" helm-list-emacs-process t]) - "----" - ["Preferred Options" helm-configuration t]) - "Spell Checking") - -(easy-menu-add-item nil '("Tools") '("----") "Spell Checking") - - -(provide 'helm-easymenu) - -;;; helm-easymenu.el ends here diff --git a/elpa/helm-20251212.555/helm-elisp.el b/elpa/helm-20251212.555/helm-elisp.el deleted file mode 100644 index d0ea96b4..00000000 --- a/elpa/helm-20251212.555/helm-elisp.el +++ /dev/null @@ -1,1174 +0,0 @@ -;;; helm-elisp.el --- Elisp symbols completion for helm. -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2025 Thierry Volpiatto - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Code: -(require 'cl-lib) -(require 'helm) -(require 'helm-lib) -(require 'helm-help) -(require 'helm-types) -(require 'helm-utils) -(require 'helm-info) -(require 'helm-eval) -(require 'helm-files) - -(declare-function helm-describe-function "helm-lib") -(declare-function helm-describe-variable "helm-lib") -(declare-function helm-describe-face "helm-lib") -(declare-function helm-read-file-name "helm-mode") -(declare-function helm-comp-read "helm-mode") -(declare-function helm-M-x-transformer-no-sort-no-props "helm-command") -(defvar helm-M-x-show-short-doc) -(defvar completions-detailed) -(defvar helm-completions-detailed) - - -;;; Customizable values - -(defgroup helm-elisp nil - "Elisp related Applications and libraries for Helm." - :group 'helm) - -(defcustom helm-turn-on-show-completion t - "Display candidate in `current-buffer' while moving selection when non--nil." - :group 'helm-elisp - :type 'boolean) - -(defcustom helm-show-completion-min-window-height 7 - "Minimum completion window height used in show completion. -This is used in macro `with-helm-show-completion'." - :group 'helm-elisp - :type 'integer) - -(defcustom helm-lisp-quoted-function-list - '(funcall apply mapc cl-mapc mapcar cl-mapcar - callf callf2 cl-callf cl-callf2 fset - fboundp fmakunbound symbol-function) - "List of function where quoted function completion happen. -E.g. give only function names after (funcall \\='." - :group 'helm-elisp - :type '(repeat (choice symbol))) - -(defcustom helm-lisp-unquoted-function-list - '(function defadvice) - "List of function where unquoted function completion happen. -E.g. give only function names after (function ." - :group 'helm-elisp - :type '(repeat (choice symbol))) - -(defcustom helm-apropos-fuzzy-match nil - "Enable fuzzy matching for `helm-apropos' when non-nil." - :group 'helm-elisp - :type 'boolean) - -(defcustom helm-lisp-fuzzy-completion nil - "Enable fuzzy matching in emacs-lisp completion when non-nil. -NOTE: This enables fuzzy matching in Helm native implementation of -elisp completion, but not on helmized elisp completion, i.e. fuzzy -completion is not available in `completion-at-point'." - :group 'helm-elisp - :type 'boolean) - -(defcustom helm-apropos-function-list '(helm-def-source--emacs-commands - helm-def-source--emacs-functions - helm-def-source--eieio-classes - helm-def-source--eieio-generic - helm-def-source--emacs-variables - helm-def-source--emacs-faces) - "A list of functions that build helm sources to use in `helm-apropos'." - :group 'helm-elisp - :type '(repeat (choice symbol))) - -(defcustom helm-apropos-defaut-info-lookup-sources '(helm-source-info-elisp - helm-source-info-cl - helm-source-info-eieio) - "A list of sources to look into when searching info page of a symbol." - :group 'helm-elisp - :type '(repeat (choice symbol))) - -(defcustom helm-show-completion-display-function - (if (display-graphic-p) - #'helm-display-buffer-in-own-frame - #'helm-show-completion-default-display-function) - "The function used to display helm completion buffer. - -This function is used by `with-helm-show-completion', when nil -fallback to `helm-default-display-buffer'. - -Default is to use a separate frame on graphic display and -`helm-show-completion-default-display-function' on non graphic -display." - :group 'helm-elisp - :type 'function) - -;;; Faces -;; -;; -(defgroup helm-elisp-faces nil - "Customize the appearance of helm-elisp." - :prefix "helm-" - :group 'helm-elisp - :group 'helm-faces) - -(defface helm-lisp-show-completion - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :background "DarkSlateGray")) - "Face used for showing candidates in `helm-lisp-completion'." - :group 'helm-elisp-faces) - -(defface helm-lisp-completion-info - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :foreground "red")) - "Face used for showing info in `helm-lisp-completion'." - :group 'helm-elisp-faces) - -(defcustom helm-elisp-help-function - 'helm-elisp-show-help - "Function for displaying help for Lisp symbols." - :group 'helm-elisp - :type '(choice (function :tag "Open help for the symbol." - helm-elisp-show-help) - (function :tag "Show one liner in modeline." - helm-elisp-show-doc-modeline))) - -(defcustom helm-locate-library-fuzzy-match t - "Enable fuzzy-matching in `helm-locate-library' when non--nil." - :type 'boolean - :group 'helm-elisp) - - -;;; Show completion. -;; -;; Provide show completion with macro `with-helm-show-completion'. - -(defvar helm-show-completion-overlay nil) - -;; Called each time cursor move in helm-buffer. -(defun helm-show-completion () - (with-helm-current-buffer - (helm-aif (helm-get-selection) - (overlay-put helm-show-completion-overlay - 'display (substring-no-properties it))))) - -(defun helm-show-completion-init-overlay (beg end) - (setq helm-show-completion-overlay (make-overlay beg end)) - (overlay-put helm-show-completion-overlay - 'face 'helm-lisp-show-completion)) - -(defun helm-show-completion-default-display-function (buffer &rest _args) - "A special resized Helm window is used depending on position in BUFFER." - (with-selected-window (selected-window) - (if (window-dedicated-p) - (helm-default-display-buffer buffer) - (let* ((screen-size (+ (count-screen-lines (window-start) (point) t) - 1 ; mode-line - (if header-line-format 1 0))) ; header-line - (def-size (- (window-height) - helm-show-completion-min-window-height)) - (upper-height (max window-min-height (min screen-size def-size))) - split-window-keep-point) - (recenter -1) - (set-window-buffer (if (active-minibuffer-window) - (minibuffer-selected-window) - (split-window nil upper-height - helm-split-window-default-side)) - buffer))))) - -(defmacro with-helm-show-completion (beg end &rest body) - "Show Helm candidate in an overlay at point. -BEG and END are the beginning and end position of the current -completion in `helm-current-buffer'. -BODY is an Helm call where we want to enable show completion. -If `helm-turn-on-show-completion' is nil do nothing." - (declare (indent 2) (debug t)) - `(unwind-protect - (if helm-turn-on-show-completion - (let ((helm-move-selection-after-hook - (append (list 'helm-show-completion) - helm-move-selection-after-hook)) - (helm-split-window-default-side - (if (eq helm-split-window-default-side 'same) - 'below helm-split-window-default-side)) - helm-split-window-inside-p - helm-reuse-last-window-split-state) - (helm-set-local-variable - 'helm-display-function - (or helm-show-completion-display-function - 'helm-default-display-buffer)) - (with-helm-after-update-hook - ;; Show immediately first candidate as soon as helm popup. - (helm-show-completion)) - (helm-show-completion-init-overlay ,beg ,end) - ,@body) - ,@body) - (when (and helm-show-completion-overlay - (overlayp helm-show-completion-overlay)) - (delete-overlay helm-show-completion-overlay)))) - - -;;; Lisp symbol completion. -;; -;; -(defun helm-lisp-completion--predicate-at-point (beg) - ;; Return a predicate for `all-completions'. - (let ((fn-sym-p (lambda () - (or - (and (eq (char-before) ?\ ) - (save-excursion - (skip-syntax-backward " " (pos-bol)) - (memq (symbol-at-point) - helm-lisp-unquoted-function-list))) - (and (eq (char-before) ?\') - (save-excursion - (forward-char -1) - (eq (char-before) ?\#))))))) - (save-excursion - (goto-char beg) - (cond ((or - ;; Complete on all symbols in non--lisp modes (logs mail etc..) - (not (memq major-mode '(emacs-lisp-mode - lisp-interaction-mode - inferior-emacs-lisp-mode))) - (not (or (funcall fn-sym-p) - (and (eq (char-before) ?\') - (save-excursion - (forward-char (if (funcall fn-sym-p) -2 -1)) - (skip-syntax-backward " " (pos-bol)) - (memq (symbol-at-point) - helm-lisp-quoted-function-list))) - (eq (char-before) ?\())) ; no paren before str. - ;; Looks like we are in a let statement. - (condition-case nil - (progn (up-list -2) (forward-char 1) - (eq (char-after) ?\()) - (error nil))) - (lambda (sym) - (or (boundp sym) (fboundp sym) (symbol-plist sym)))) - (t #'fboundp))))) - -(defun helm-thing-before-point (&optional limits regexp) - "Return symbol name before point. -If REGEXP is specified return what REGEXP find before point. -By default match the beginning of symbol before point. -With LIMITS arg specified return the beginning and end position -of symbol before point." - (save-excursion - (let (beg - (end (point)) - (boundary (field-beginning nil nil (pos-bol)))) - (if (re-search-backward (or regexp "\\_<") boundary t) - (setq beg (match-end 0)) - (setq beg boundary)) - (unless (= beg end) - (if limits - (cons beg end) - (buffer-substring-no-properties beg end)))))) - -(defun helm-bounds-of-thing-before-point (&optional regexp) - "Get the beginning and end position of `helm-thing-before-point'. -Return a cons (beg . end)." - (helm-thing-before-point 'limits regexp)) - -(defun helm-insert-completion-at-point (beg end str) - ;; When there is no space after point - ;; we are completing inside a symbol or - ;; after a partial symbol with the next arg aside - ;; without space, in this case mark the region. - ;; deleting it would remove the - ;; next arg which is unwanted. - (delete-region beg end) - (insert str) - (let ((pos (cdr (or (bounds-of-thing-at-point 'symbol) - ;; needed for helm-dabbrev. - (bounds-of-thing-at-point 'filename))))) - (when (and pos (< (point) pos)) - (push-mark pos t t)))) - -(defconst helm-lisp-completion-re-chars-classes - '(":xdigit:" ":word:" ":upper:" - ":unibyte:" ":space:" ":punct:" - ":print:" ":nonascii:" ":ascii:" - ":multibyte:" ":lower:" - ":graph:" ":digit:" ":cntrl:" - ":blank:" ":alpha:" ":alnum:") - "Table of Char Classes for regexps.") - -;;;###autoload -(defun helm-lisp-completion-at-point () - "Preconfigured Helm for Lisp symbol completion at point." - (interactive) - (let* ((target (helm-thing-before-point)) - (beg (car (helm-bounds-of-thing-before-point))) - (end (point)) - (pred (and beg (helm-lisp-completion--predicate-at-point beg))) - (re-class-p (and (eq 'string (syntax-ppss-context (syntax-ppss (point)))) - (save-excursion - (re-search-backward "\\[:[[:alpha:]]*" (pos-bol) t)))) - (loc-vars (and (fboundp 'elisp--local-variables) - (ignore-errors - (mapcar #'symbol-name (elisp--local-variables))))) - (glob-syms (and target pred (not re-class-p) (all-completions target obarray pred))) - (candidates (if re-class-p - helm-lisp-completion-re-chars-classes - (append loc-vars glob-syms))) - (helm-quit-if-no-candidate t) - (helm-execute-action-at-once-if-one t) - (enable-recursive-minibuffers t)) - (if candidates - (with-helm-show-completion beg end - ;; Overlay is initialized now in helm-current-buffer. - (helm - :sources (helm-build-in-buffer-source "Lisp completion" - :data candidates - :persistent-action `(helm-lisp-completion-persistent-action . - ,(and (eq helm-elisp-help-function - 'helm-elisp-show-doc-modeline) - 'never-split)) - :nomark t - :match-part (lambda (c) (car (split-string c))) - :fuzzy-match helm-lisp-fuzzy-completion - :popup-info (lambda (c) (helm-get-first-line-documentation - (if (string-match "\\`:[[:alpha:]]+:\\'" c) - c (intern-soft c)))) - :persistent-help (helm-lisp-completion-persistent-help) - :filtered-candidate-transformer - #'helm-lisp-completion-transformer - :action (lambda (candidate) - (with-helm-current-buffer - (run-with-timer - 0.01 nil - #'helm-insert-completion-at-point - beg end candidate)))) - :input target - :resume 'noresume - :truncate-lines t - :buffer "*helm lisp completion*" - :allow-nest t)) - (message "[No Match]")))) - -(defun helm-lisp-completion-persistent-action (candidate &optional name) - "Show documentation for the function. -Documentation is shown briefly in mode-line or completely in -other window according to the value of -`helm-elisp-help-function'." - (funcall helm-elisp-help-function candidate name)) - -(defun helm-lisp-completion-persistent-help () - "Return persistent-help according to the value of `helm-elisp-help-function'" - (cl-ecase helm-elisp-help-function - (helm-elisp-show-doc-modeline "Show brief doc in mode-line") - (helm-elisp-show-help "Toggle show help for the symbol"))) - -(defun helm-elisp--show-help-1 (candidate &optional name) - (helm-acase (if (member candidate helm-lisp-completion-re-chars-classes) - candidate - (intern-soft candidate)) - ((guard* (stringp it)) - (helm-describe-re-char-classes it)) - ((guard* (and (fboundp it) (boundp it))) - (if (member name `(,helm-describe-function-function - ,helm-describe-variable-function)) - (funcall (intern (format "helm-%s" name)) it) - ;; When there is no way to know what to describe - ;; prefer describe-function. - (helm-describe-function it))) - ((guard* (fboundp it)) (helm-describe-function it)) - ((guard* (boundp it)) (helm-describe-variable it)) - ((guard* (facep it)) (helm-describe-face it)))) - -(defun helm-elisp-show-help (candidate &optional name) - "Show full help for the function CANDIDATE. -Arg NAME specifies the name of the top level function calling -Helm generic completion (e.g., \"describe-function\") which -allows calling the right function when CANDIDATE symbol refers at -the same time to variable and a function." - (helm-elisp--persistent-help - candidate 'helm-elisp--show-help-1 name)) - -(defun helm-elisp-show-doc-modeline (candidate &optional name) - "Show brief documentation for the function in the mode-line." - (let ((cursor-in-echo-area t) - mode-line-in-non-selected-windows) - (helm-show-info-in-mode-line - (propertize - (helm-get-first-line-documentation - (intern candidate) name) - 'face 'helm-lisp-completion-info)))) - -(defun helm-lisp-completion-transformer (candidates _source) - "Helm candidates transformer for Lisp completion." - (cl-loop for c in candidates - for sym = (if (string-match "\\`:[[:alpha:]]+:\\'" c) - c (intern-soft c)) - for annot = (helm-acase sym - ((guard* (stringp it)) - (propertize " " 'face 'font-lock-regexp-face)) - ((guard* (commandp it)) - (propertize " " 'face 'font-lock-function-name-face)) - ((guard* (class-p it)) - (propertize " " 'face 'font-lock-type-face)) - ((guard* (cl-generic-p it)) - (propertize " " 'face 'font-lock-function-name-face)) - ((guard* (fboundp it)) - (propertize " " 'face 'font-lock-function-name-face)) - ((guard* (keywordp it)) - (propertize " " 'face 'font-lock-keyword-face)) - ((guard* (boundp it)) - (propertize " " 'face 'font-lock-variable-name-face)) - ((guard* (facep it)) - (propertize " " 'face 'font-lock-variable-name-face)) - ((guard* (helm-group-p it)) - (propertize " " 'face 'font-lock-type-face)) - (t " ")) - collect (cons (concat (propertize " " 'display annot) c) c) - into lst - finally return (sort lst #'helm-generic-sort-fn))) - -;;;###autoload -(defun helm-get-first-line-documentation (sym &optional name end-column) - "Return first line documentation of symbol SYM truncated at END-COLUMN. -If SYM is not documented, return \"Not documented\". -Argument NAME allows specifiying what function to use to display -documentation when SYM name is the same for function and variable." - (unless name (setq name "describe-function")) - (unless end-column (setq end-column 72)) - (let ((doc (condition-case _err - (helm-acase sym - ((guard* (stringp it)) - (cadr (split-string (helm-describe-re-char-classes-1 it) "\n"))) - ((guard* (class-p it)) - (cl--class-docstring (cl--find-class it))) - ((guard* (and (fboundp it) (boundp it))) - (if (string= name "describe-variable") - (documentation-property it 'variable-documentation t) - (documentation it t))) - ((guard* (custom-theme-p it)) - (documentation-property it 'theme-documentation t)) - ((guard* (and (helm-group-p it) (not (fboundp it)))) - (documentation-property it 'group-documentation t)) - ((guard* (fboundp it)) - (documentation it t)) - ((guard* (boundp it)) - (documentation-property it 'variable-documentation t)) - ((guard* (facep it)) (face-documentation it))) - (void-function "Void function -- Not documented")))) - (if (and doc (not (string= doc "")) - ;; `documentation' return "\n\n(args...)" - ;; for CL-style functions. - (not (string-match-p "\\`\n\n" doc))) - ;; Some commands specify key bindings or keymap in their first line, - ;; e.g.: "\A mode for editing binary [...]. As a result - ;; (substitute-command-keys doc) returns a string like "\nUses - ;; keymap...\nFirst line docstring. See - ;; . - (truncate-string-to-width - (helm-acase (split-string (substitute-command-keys doc) "\n") - ((dst* (l &rest args)) - (if (string= l "") (cadr args) l))) - end-column nil nil t) - (if (or (symbol-function sym) (boundp sym) (facep sym) (helm-group-p sym)) - "Not documented" - ;; Symbol exist but has no definition yet e.g. - ;; (advice-add 'foo-test :override (lambda () (message "invalid - ;; function"))) and foo-test is not already defined. - "Not already defined or loaded")))) - -;;; File completion. -;; -;; Complete file name at point. - -;;;###autoload -(defun helm-complete-file-name-at-point (&optional force) - "Preconfigured Helm to complete file name at point." - (interactive) - (require 'helm-mode) - (let* ((tap (or (thing-at-point 'filename t) "")) - beg - (init (and tap - (or force - (save-excursion - (end-of-line) - (search-backward tap (pos-bol) t) - (setq beg (point)) - (looking-back "[^'`( ]" (1- (point))))) - (expand-file-name tap))) - (end (point)) - (helm-quit-if-no-candidate t) - (helm-execute-action-at-once-if-one t) - completion) - (with-helm-show-completion beg end - (setq completion (helm-read-file-name "FileName: " - :initial-input init))) - (when (and completion (not (string= completion ""))) - (delete-region beg end) (insert (if (string-match "^~" tap) - (abbreviate-file-name completion) - completion))))) -(make-obsolete 'helm-complete-file-name-at-point 'helm-find-files "3.9.6") - -;;;###autoload -(defun helm-lisp-indent () - ;; It is meant to use with `helm-define-multi-key' which - ;; does not support args for functions yet, so use `current-prefix-arg' - ;; for now instead of (interactive "P"). - (interactive) - (let ((tab-always-indent (or (eq tab-always-indent 'complete) - tab-always-indent))) - (indent-for-tab-command current-prefix-arg))) - - -;;; Apropos -;; -;; -(defvar helm-apropos-history nil) - -(defcustom helm-apropos-show-short-doc nil - "Show short docstring of symbols when non nil. - -NOTE: When displaying helm-apropos in a frame, i.e. when -`helm-apropos' is member of `helm-commands-using-frame' setting this -to non nil have no effect, you have first to remove `helm-apropos' -from `helm-commands-using-frame'." - :group 'helm-elisp - :type 'boolean) - -(defvar helm-apropos-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-map) - (define-key map (kbd "C-]") #'helm-apropos-toggle-details) - map)) - -(defun helm-apropos-init (test default &optional fn) - "Setup `helm-candidate-buffer' for `helm-apropos' sources. -A list of symbols fetched with FN is inserted in -`helm-candidate-buffer', if FN is not provided symbols are fetched -against obarray with predicate TEST. When FN is provided predicate TEST -is only used to test DEFAULT." - (require 'helm-help) - (helm-init-candidates-in-buffer 'global - (let ((default-symbol (and (stringp default) - (intern-soft default))) - (symbols (if fn (funcall fn) (all-completions "" obarray test)))) - (if (and default-symbol (funcall test default-symbol)) - (cons default-symbol symbols) - symbols)))) - -(defun helm-apropos-short-doc-transformer (candidates _source) - (if helm-apropos-show-short-doc - (cl-loop for cand in candidates - for doc = (helm-get-first-line-documentation (intern-soft cand)) - collect (cons (format "%s%s%s" - cand - (if doc - (helm-make-separator cand) - "") - (if doc - (propertize - doc 'face 'helm-M-x-short-doc) - "")) - cand)) - candidates)) - -(defun helm-apropos-default-sort-fn (candidates _source) - (if (string= helm-pattern "") - candidates - (sort candidates #'helm-generic-sort-fn))) - -(defun helm-apropos-clean-history-variable (candidate) - (with-helm-current-buffer ; var is maybe local - (let* ((sym (intern-soft candidate)) - (cands (symbol-value sym)) - (mkds (and (listp cands) - (helm-comp-read "Delete entry: " - cands :marked-candidates t)))) - (cl-assert (listp mkds) nil "Variable value is not a list") - (cl-loop for elm in mkds do - (if (local-variable-p sym) - (set (make-local-variable sym) - (setq cands (delete elm cands))) - (set sym (setq cands (delete elm cands)))))))) - -(defun helm-apropos-clean-ring (candidate) - (with-helm-current-buffer ; var is maybe local - (let* ((sym (intern-soft candidate)) - (val (symbol-value sym)) - (cands (and (ring-p val) (ring-elements val))) - (mkds (and cands (helm-comp-read - "Delete entry: " - cands :marked-candidates t)))) - (when mkds - (cl-loop for elm in mkds do - (ring-remove - val (helm-position - elm - (ring-elements val) - :test 'equal)) - and do (if (local-variable-p sym) - (set (make-local-variable sym) val) - (set sym val))))))) - -(defun helm-apropos-action-transformer (actions candidate) - (let* ((sym (helm-symbolify candidate)) - (val (with-helm-current-buffer (symbol-value sym)))) - (cond ((custom-variable-p sym) - (append - actions - (let ((standard-value (eval (car (get sym 'standard-value)) t))) - (unless (equal standard-value (symbol-value sym)) - `(("Reset Variable to default value" - . ,(lambda (candidate) - (let ((sym (helm-symbolify candidate))) - (set sym standard-value))))))) - `(("Customize variable" - . ,(lambda (candidate) - (customize-option (helm-symbolify candidate))))))) - ((and val (with-helm-current-buffer (ring-p (symbol-value sym)))) - (append actions - '(("Clean ring" . helm-apropos-clean-ring)))) - ((and (string-match-p "history" candidate) (listp val)) - (append actions - '(("Clean variable" . - helm-apropos-clean-history-variable)))) - (t actions)))) - -(defun helm-def-source--emacs-variables (&optional default) - (helm-build-in-buffer-source "Variables" - :init (lambda () - (helm-apropos-init - (lambda (x) - (and (boundp x) (not (keywordp x)) (not (class-p x)))) - default)) - :fuzzy-match helm-apropos-fuzzy-match - :filtered-candidate-transformer - (delq nil (list (and (null helm-apropos-fuzzy-match) - 'helm-apropos-default-sort-fn) - (and (null (memq 'helm-apropos helm-commands-using-frame)) - #'helm-apropos-short-doc-transformer))) - :nomark t - :persistent-action (lambda (candidate) - (helm-elisp--persistent-help - candidate 'helm-describe-variable)) - :persistent-help "Toggle describe variable" - :keymap helm-apropos-map - :action '(("Describe variable" . helm-describe-variable) - ("Find variable" . helm-find-variable) - ("Info lookup" . helm-info-lookup-symbol) - ("Set variable" . helm-set-variable)) - :action-transformer 'helm-apropos-action-transformer)) - -(defun helm-def-source--emacs-faces (&optional default) - "Create `helm' source for faces to be displayed with -`helm-apropos'." - (helm-build-in-buffer-source "Faces" - :init (lambda () (helm-apropos-init 'facep default #'face-list)) - :fuzzy-match helm-apropos-fuzzy-match - :filtered-candidate-transformer - (delq nil (list - (and (null helm-apropos-fuzzy-match) - #'helm-apropos-default-sort-fn) - (lambda (candidates _source) - (cl-loop for c in candidates - collect (propertize c 'face (intern c)))) - (and (null (memq 'helm-apropos helm-commands-using-frame)) - #'helm-apropos-short-doc-transformer))) - :persistent-action (lambda (candidate) - (helm-elisp--persistent-help - candidate 'helm-describe-face)) - :persistent-help "Toggle describe face" - :keymap helm-apropos-map - :action '(("Describe face" . helm-describe-face) - ("Find face" . helm-find-face-definition) - ("Customize face" . (lambda (candidate) - (customize-face (helm-symbolify candidate))))))) - -(defun helm-def-source--emacs-commands (&optional default) - (require 'helm-command) - (helm-build-in-buffer-source "Commands" - :init (lambda () - (helm-apropos-init 'commandp default)) - :fuzzy-match helm-apropos-fuzzy-match - :filtered-candidate-transformer - (append (list #'helm-M-x-transformer-no-sort-no-props) - (and (null helm-apropos-fuzzy-match) - '(helm-apropos-default-sort-fn))) - :display-to-real 'helm-symbolify - :nomark t - :persistent-action (lambda (candidate) - (helm-elisp--persistent-help - candidate 'helm-describe-function)) - :persistent-help "Toggle describe command" - :keymap helm-apropos-map - :action 'helm-type-function-actions)) - -(defun helm-def-source--emacs-functions (&optional default) - (helm-build-in-buffer-source "Functions" - :init (lambda () - (helm-apropos-init (lambda (x) - (and (fboundp x) - (not (commandp x)) - (not (cl-generic-p x)) - (not (class-p x)))) - default)) - :fuzzy-match helm-apropos-fuzzy-match - :filtered-candidate-transformer - (delq nil (list (and (null helm-apropos-fuzzy-match) - 'helm-apropos-default-sort-fn) - (and (null (memq 'helm-apropos helm-commands-using-frame)) - #'helm-apropos-short-doc-transformer))) - :display-to-real 'helm-symbolify - :persistent-action (lambda (candidate) - (helm-elisp--persistent-help - candidate 'helm-describe-function)) - :persistent-help "Toggle describe function" - :keymap helm-apropos-map - :nomark t - :action 'helm-type-function-actions)) - -(defun helm-def-source--eieio-classes (&optional default) - (helm-build-in-buffer-source "Classes" - :init (lambda () - (helm-apropos-init (lambda (x) - (class-p x)) - default)) - :fuzzy-match helm-apropos-fuzzy-match - :filtered-candidate-transformer - (delq nil (list (and (null helm-apropos-fuzzy-match) - 'helm-apropos-default-sort-fn) - (and (null (memq 'helm-apropos helm-commands-using-frame)) - #'helm-apropos-short-doc-transformer))) - :nomark t - :persistent-action (lambda (candidate) - (helm-elisp--persistent-help - candidate 'helm-describe-class)) - :persistent-help "Toggle describe class" - :keymap helm-apropos-map - :action '(("Describe Class" . helm-describe-class) - ("Find Class (C-u for source)" . helm-find-function) - ("Info lookup" . helm-info-lookup-symbol) - ("Describe slots" . helm-elisp-describe-slots)))) - -(defun helm-def-source--eieio-generic (&optional default) - (helm-build-in-buffer-source "Generic functions" - :init (lambda () - (helm-apropos-init (lambda (x) - (cl-generic-p x)) - default)) - :fuzzy-match helm-apropos-fuzzy-match - :filtered-candidate-transformer - (delq nil (list (and (null helm-apropos-fuzzy-match) - 'helm-apropos-default-sort-fn) - (and (null (memq 'helm-apropos helm-commands-using-frame)) - #'helm-apropos-short-doc-transformer))) - :nomark t - :persistent-action (lambda (candidate) - (helm-elisp--persistent-help - candidate 'helm-describe-function)) - :persistent-help "Toggle describe generic function" - :keymap helm-apropos-map - :action '(("Describe function" . helm-describe-function) - ("Find function (C-u for source)" . helm-find-function) - ("Info lookup" . helm-info-lookup-symbol)))) - -(defun helm-info-lookup-fallback-source (candidate) - (cl-multiple-value-bind (fn src-name) - (helm-acase (helm-symbolify candidate) - ((guard* (class-p it)) - (list #'helm-describe-function - "Describe class")) - ((guard* (cl-generic-p it)) - (list #'helm-describe-function - "Describe generic function")) - ((guard* (fboundp it)) - (list #'helm-describe-function - "Describe function")) - ((guard* (facep it)) - (list #'helm-describe-face - "Describe face")) - (t - (list #'helm-describe-variable - "Describe variable"))) - (helm-build-sync-source src-name - :candidates (list candidate) - :persistent-action (lambda (candidate) - (helm-elisp--persistent-help - candidate fn)) - :persistent-help src-name - :nomark t - :action fn))) - -(defun helm-info-lookup-symbol-1 (c) - (let ((helm-execute-action-at-once-if-one 'current-source)) - (helm :sources (append helm-apropos-defaut-info-lookup-sources - (list (helm-info-lookup-fallback-source c))) - :resume 'noresume - :buffer "*helm lookup*" - :input (helm-stringify c)))) - -(defun helm-info-lookup-symbol (candidate) - ;; ???:Running an idle-timer allows not catching RET when exiting - ;; with the fallback source. - ;; (run-with-idle-timer 0.01 nil #'helm-info-lookup-symbol-1 candidate) - (helm-info-lookup-symbol-1 candidate)) - -(defun helm-elisp-describe-slots (class) - (helm :sources (helm-build-sync-source "Class slots" - :header-name (lambda (name) (format "%s in `%s'" name class)) - :candidates (helm-elisp-collect-slots-in-class - (intern-soft class)) - :candidate-transformer - (lambda (candidates) - (cl-loop for (disp . real) in candidates - collect (cons (propertize - disp 'face 'font-lock-keyword-face - 'display (concat ":" disp)) - real))) - :persistent-action (lambda (candidate) - (helm-elisp--persistent-help - candidate - #'helm-elisp--describe-slot)) - :persistent-help "Describe slot" - :popup-info (lambda (c) (caddr (split-string c "\n" t))) - :action (helm-make-actions - "Describe slot" 'helm-elisp--describe-slot)) - :buffer "*helm class slots*")) - -(defun helm-elisp--describe-slot (slot) - (with-output-to-temp-buffer (help-buffer) - (princ slot))) - -(defun helm-apropos-toggle-details () - "Toggle details in `helm-apropos'." - (interactive) - (with-helm-buffer - (unless (memq 'helm-apropos helm-commands-using-frame) - (setq helm-M-x-show-short-doc (not helm-M-x-show-short-doc) - helm-apropos-show-short-doc (not helm-apropos-show-short-doc)) - (helm-force-update (concat "^" (helm-stringify (helm-get-selection))) - (helm-get-current-source))))) - -(defun helm-apropos-get-default () - (with-syntax-table emacs-lisp-mode-syntax-table - (symbol-name (intern-soft - (helm-aand (thing-at-point 'symbol t) - (replace-regexp-in-string "\\`[~=]" "" it) - (replace-regexp-in-string "[~=]\\'" "" it)))))) - -;;;###autoload -(defun helm-apropos (default) - "Preconfigured Helm to describe commands, functions, variables and faces. -In non interactives calls DEFAULT argument should be provided as -a string, i.e. the `symbol-name' of any existing symbol." - (interactive (list (helm-apropos-get-default))) - (let ((helm-M-x-show-short-doc - (and helm-apropos-show-short-doc - (null (memq 'helm-apropos helm-commands-using-frame))))) - (helm :sources - (mapcar (lambda (func) - (funcall func default)) - helm-apropos-function-list) - :history 'helm-apropos-history - :buffer "*helm apropos*" - :preselect (and default (concat "^\\_<" (regexp-quote default) "\\_>")) - :truncate-lines t))) - - -;;; Locate elisp library -;; -;; -(defvar helm--locate-library-cache nil) -(defvar helm--locate-library-doc-cache (make-hash-table :test 'equal)) -(defun helm-locate-library-scan-list () - (cl-loop for dir in load-path - when (file-directory-p dir) - nconc (directory-files - dir nil (concat (regexp-opt (find-library-suffixes)) "\\'")))) - -;;;###autoload -(defun helm-locate-library (&optional arg) - "Preconfigured helm to locate elisp libraries. - -When `completions-detailed' or `helm-completions-detailed' is non -nil, a description of libraries is provided. The libraries are -partially cached in the variables -`helm--locate-library-doc-cache' and -`helm--locate-library-cache'. TIP: You can make these vars -persistent for faster start with the psession package, using M-x -psession-make-persistent-variable. NOTE: The caches affect as -well `find-libray' and `locate-library' when `helm-mode' is -enabled and `completions-detailed' is non nil. There is no need -to refresh the caches, they will be updated automatically if some -new libraries are found, however when a library update its -headers and the description change you can reset the caches with -a prefix arg." - (interactive "P") - (require 'helm-mode) - (let (done) - (when arg - (setq helm--locate-library-cache nil) - (clrhash helm--locate-library-doc-cache)) - (helm :sources - (helm-build-in-buffer-source "Elisp libraries (Scan)" - :data #'helm-locate-library-scan-list - :fuzzy-match helm-locate-library-fuzzy-match - :keymap helm-generic-files-map - :candidate-transformer - (lambda (candidates) - (cl-loop with reporter = (unless done - (make-progress-reporter - "Scanning libraries..." 0 (length candidates))) - with lgst = (helm-in-buffer-get-longest-candidate) - for c in candidates - for count from 0 - for bn = (helm-basename c 2) - for sep = (helm-make-separator bn lgst) - for path = (or (assoc-default bn helm--locate-library-cache) - ;; A lock file in LOAD-PATH (bug#2626). - (unless (string-match "\\`\\.#" bn) - (let ((p (find-library-name bn))) - (push (cons bn p) helm--locate-library-cache) - p))) - for doc = (and path - (or completions-detailed helm-completions-detailed) - (or (gethash bn helm--locate-library-doc-cache) - (puthash bn (helm-locate-lib-get-summary path) - helm--locate-library-doc-cache))) - for disp = (and path - (if (and doc - (or completions-detailed helm-completions-detailed)) - (helm-aand (propertize doc 'face 'helm-completions-detailed) - (propertize " " 'display (concat sep it)) - (concat bn it)) - bn)) - when (and disp path) - collect (cons disp path) - when reporter do (progress-reporter-update reporter count) - finally do (setq done t))) - :action (helm-actions-from-type-file)) - :buffer "*helm locate library*"))) - - -;;; Modify variables from Helm -;; -;; -(defun helm-set-variable (var) - "Set VAR value interactively." - (let* ((sym (helm-symbolify var)) - (val (default-value sym)) - (strv (prin1-to-string val))) - (if (> (length strv) 25) - (helm-edit-variable var) - (set-default sym (eval-minibuffer - (format "Set `%s': " var) - (if (or (arrayp val) - (memq val '(nil t)) - (numberp val)) - strv - (format "'%s" strv))))))) - -(defvar helm-edit-variable-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "C-c C-c") 'helm-set-variable-from-pp-buffer) - (define-key map (kbd "C-c C-k") 'helm-edit-variable-quit) - (define-key map (kbd "C-c =") 'helm-edit-variable-toggle-diff) - map)) - -(define-derived-mode helm-edit-variable-mode - emacs-lisp-mode "helm-edit-variable" - "A mode to edit variables values. - -Special commands: -\\{helm-edit-variable-mode-map}") - -(defvar helm-pretty-print-temp-file-name - (expand-file-name "helm-edit-variable.el" temporary-file-directory)) -(defvar helm-pretty-print-buffer-name "*pretty print output*") -(defvar helm-pretty-print-current-symbol nil) -(defun helm-edit-variable (var) - (let* ((sym (intern-soft var)) - (val (symbol-value sym)) - (pp (pp-to-string val)) - start) - (with-current-buffer (get-buffer-create helm-pretty-print-buffer-name) - (erase-buffer) - (helm-edit-variable-mode) - (setq start (point)) - ;; Any number of lines starting with ";;;" + one empty line. - (insert (format ";;; Edit variable `%s' and hit C-c C-c when done\n" sym) - ";;; Abort with C-c C-k\n\n") - (add-text-properties start (1- (point)) '(read-only t)) - (add-text-properties (1- (point)) (point) '(read-only t rear-nonsticky t)) - (set (make-local-variable 'helm-pretty-print-current-symbol) sym) - (add-hook 'kill-buffer-hook - (lambda () - (when (file-exists-p helm-pretty-print-temp-file-name) - (delete-file helm-pretty-print-temp-file-name))) - nil t) - (save-excursion (insert pp)) - (write-region - (point-min) (point-max) helm-pretty-print-temp-file-name nil 1) - (setq buffer-file-name helm-pretty-print-temp-file-name)) - (display-buffer helm-pretty-print-buffer-name))) - -(defun helm-edit-variable-toggle-diff () - "Show diff in edit variable buffer." - (interactive) - (if (get-buffer-window "*Diff*" 'visible) - (kill-buffer "*Diff*") - (diff-buffer-with-file))) - -(defun helm-set-variable-from-pp-buffer () - "Set variable associated with buffer to buffer contents. - -The associated variable is the local variable -`helm-pretty-print-current-symbol'." - (interactive) - (with-current-buffer helm-pretty-print-buffer-name - (goto-char (point-min)) - (when (re-search-forward "^$" nil t) - (forward-line 1)) - (let ((val (symbol-value helm-pretty-print-current-symbol))) - (save-excursion - (if (or (arrayp val) - (memq val '(nil t)) - (numberp val) - (looking-at "[`']")) - (set-default helm-pretty-print-current-symbol - (read (current-buffer))) - (set-default helm-pretty-print-current-symbol - `(,@(read (current-buffer)))))) - (if (equal val (symbol-value helm-pretty-print-current-symbol)) - (message "No changes done") - (message "`%s' value modified" helm-pretty-print-current-symbol)) - (helm-edit-variable-quit)))) - -(defun helm-edit-variable-quit () - "Quit edit variable buffer." - (interactive) - (set-buffer-modified-p nil) - (quit-window t) - (helm-aif (get-buffer-window "*Diff*" 'visible) - (quit-window t it))) - - -;;; Elisp Timers. -;; -;; -(defclass helm-absolute-time-timers-class (helm-source-sync helm-type-timers) - ((candidates :initform 'timer-list) - (allow-dups :initform t) - (candidate-transformer - :initform - (lambda (candidates) - (cl-loop for timer in candidates - collect (cons (helm-elisp--format-timer timer) timer)))))) - -(defvar helm-source-absolute-time-timers - (helm-make-source "Absolute Time Timers" 'helm-absolute-time-timers-class)) - -(defclass helm-idle-time-timers-class (helm-source-sync helm-type-timers) - ((candidates :initform 'timer-idle-list) - (allow-dups :initform t) - (candidate-transformer - :initform - (lambda (candidates) - (cl-loop for timer in candidates - collect (cons (helm-elisp--format-timer timer) timer)))))) - -(defvar helm-source-idle-time-timers - (helm-make-source "Idle Time Timers" 'helm-idle-time-timers-class)) - -(defun helm-elisp--format-timer (timer) - (format "%s repeat=%s %s(%s)" - (let ((time (timer--time timer))) - (if (timer--idle-delay timer) - (format "idle-for=[%s]" - (format-seconds "%dd %hh %mmin %z%,3ss" - (time-to-seconds time))) - (format-time-string "%m/%d %T" time))) - (or (timer--repeat-delay timer) "nil") - (mapconcat #'identity (split-string - (prin1-to-string (timer--function timer)) - "\n") - " ") - (mapconcat #'prin1-to-string (timer--args timer) " "))) - -;;;###autoload -(defun helm-timers () - "Preconfigured `helm' for timers." - (interactive) - (helm :sources '(helm-source-absolute-time-timers - helm-source-idle-time-timers) - :buffer "*helm timers*")) - - -;;; Complex command history -;; -;; - -(defvar helm-sexp--last-sexp nil) -;; This wont work compiled. -(defun helm-sexp-eval-1 () - (interactive) - (unwind-protect - (progn - ;; Trick called-interactively-p into thinking that `cand' is - ;; an interactive call, See `repeat-complex-command'. - (add-hook 'called-interactively-p-functions - #'helm-complex-command-history--called-interactively-skip) - (eval (read helm-sexp--last-sexp) t)) - (remove-hook 'called-interactively-p-functions - #'helm-complex-command-history--called-interactively-skip))) - -(defun helm-complex-command-history--called-interactively-skip (i _frame1 frame2) - (and (eq 'eval (cadr frame2)) - (eq 'helm-sexp-eval-1 - (cadr (backtrace-frame (+ i 2) #'called-interactively-p))) - 1)) - -(defun helm-sexp-eval (_candidate) - (call-interactively #'helm-sexp-eval-1)) - -(defvar helm-source-complex-command-history - (helm-build-sync-source "Complex Command History" - :candidates (lambda () - ;; Use cdr to avoid adding - ;; `helm-complex-command-history' here. - (cl-loop for i in command-history - unless (equal i '(helm-complex-command-history)) - collect (prin1-to-string i))) - :action (helm-make-actions - "Eval" (lambda (candidate) - (and (boundp 'helm-sexp--last-sexp) - (setq helm-sexp--last-sexp candidate)) - (let ((command (read candidate))) - (unless (equal command (car command-history)) - (setq command-history (cons command command-history)))) - (run-with-timer 0.1 nil #'helm-sexp-eval candidate)) - "Edit and eval" (lambda (candidate) - (edit-and-eval-command "Eval: " (read candidate)))) - :persistent-action #'helm-sexp-eval - :multiline t)) - -;;;###autoload -(defun helm-complex-command-history () - "Preconfigured `helm' for complex command history." - (interactive) - (helm :sources 'helm-source-complex-command-history - :buffer "*helm complex commands*")) - -(provide 'helm-elisp) - -;;; helm-elisp.el ends here diff --git a/elpa/helm-20251212.555/helm-epa.el b/elpa/helm-20251212.555/helm-epa.el deleted file mode 100644 index 3bd03dbf..00000000 --- a/elpa/helm-20251212.555/helm-epa.el +++ /dev/null @@ -1,269 +0,0 @@ -;;; helm-epa.el --- helm interface for epa/epg -*- lexical-binding: t; -*- - -;; Copyright (C) 2012 ~ 2025 Thierry Volpiatto - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - - -;;; Code: - -(require 'helm) - -(eval-when-compile (require 'epg)) -(defvar epa-protocol) -(defvar epa-last-coding-system-specified) -(defvar epg-key-validity-alist) -(defvar mail-header-separator) -(declare-function epg-list-keys "epg") -(declare-function epg-make-context "epg") -(declare-function epg-key-sub-key-list "epg") -(declare-function epg-sub-key-id "epg") -(declare-function epg-key-user-id-list "epg") -(declare-function epg-user-id-string "epg") -(declare-function epg-user-id-validity "epg") -(declare-function epa-sign-region "epa") -(declare-function epa--read-signature-type "epa") -(declare-function epa-display-error "epa") -(declare-function epg-export-keys-to-string "epg") -(declare-function epg-context-armor "epg") -(declare-function epg-context-set-armor "epg") -(declare-function epg-delete-keys "epg") -(declare-function helm-read-file-name "helm-mode") - -(defvar helm-epa--list-only-secrets nil - "[INTERNAL] Used to pass MODE argument to `epg-list-keys'.") - -(defcustom helm-epa-actions '(("Show key" . epa--show-key) - ("encrypt file with key" . helm-epa-encrypt-file) - ("Copy keys to kill ring" . helm-epa-kill-keys-armor) - ("Delete keys" . helm-epa-delete-keys)) - "Actions for `helm-epa-list-keys'." - :type '(alist :key-type string :value-type symbol) - :group 'helm-misc) - -(defclass helm-epa (helm-source-sync) - ((init :initform (lambda () - (require 'epg) - (require 'epa))) - (candidates :initform 'helm-epa-get-key-list) - (keymap :initform 'helm-comp-read-map) - (mode-line :initform 'helm-comp-read-mode-line)) - "Allow building helm sources for GPG keys.") - -(defun helm-epa-get-key-list (&optional keys) - "Build candidate list for `helm-epa-list-keys'." - (cl-loop with all-keys = (or keys (epg-list-keys (epg-make-context epa-protocol) - nil helm-epa--list-only-secrets)) - for key in all-keys - for sublist = (car (epg-key-sub-key-list key)) - for subkey-id = (epg-sub-key-id sublist) - for uid-list = (epg-key-user-id-list key) - for uid = (epg-user-id-string (car uid-list)) - for validity = (epg-user-id-validity (car uid-list)) - collect (cons (format " %s %s %s" - (helm-aif (rassq validity epg-key-validity-alist) - (string (car it)) - "?") - (propertize - subkey-id - 'face (cl-case validity - (none 'epa-validity-medium) - ((revoked expired) - 'epa-validity-disabled) - (t 'epa-validity-high))) - (propertize - uid 'face 'font-lock-warning-face)) - key))) - -(defun helm-epa--select-keys (prompt keys) - "A helm replacement for `epa--select-keys'." - (catch 'nokey - (let ((result (helm :sources (helm-make-source "Epa select keys" 'helm-epa - :candidates (lambda () - (helm-epa-get-key-list keys)) - :action (lambda (_candidate) - (helm-marked-candidates))) - :prompt (and prompt (helm-epa--format-prompt prompt)) - :buffer "*helm epa*"))) - (if (or (equal result "") (null result)) - (throw 'nokey - (error "No keys selected, aborting")) - result)))) - -(defun helm-epa--format-prompt (prompt) - (let ((split (split-string prompt "\n"))) - (if (cdr split) - (format "%s\n(%s): " - (replace-regexp-in-string "\\.[\t ]*\\'" "" (car split)) - (replace-regexp-in-string "\\.[\t ]*\\'" "" (cadr split))) - (format "%s: " (replace-regexp-in-string "\\.[\t ]*\\'" "" (car split)))))) - -(defun helm-epa--read-signature-type-help () - (with-temp-buffer - (save-excursion - (insert - "n: Create a normal signature)\n" - "c: Create a cleartext signature)\n" - "d: Create a detached signature)")) - (while (re-search-forward "^\\(.\\):" nil t) - (helm-add-face-text-properties (match-beginning 1) (match-end 1) - 'font-lock-variable-name-face)) - (buffer-string))) - -(defun helm-epa--read-signature-type () - "A helm replacement for `epa--read-signature-type'." - (let ((answer (helm-read-answer "Signature type? [n,c,d,h]" - '("n" "c" "d") - #'helm-epa--read-signature-type-help))) - (helm-acase answer - ("n" 'normal) - ("c" 'clear) - ("d" 'detached)))) - -(defun helm-epa-collect-keys-from-candidates (candidates) - (cl-loop for c in candidates - collect (epg-sub-key-id - (car (epg-key-sub-key-list c))))) - -(defun helm-epa-collect-id-from-candidates (candidates) - (cl-loop for c in candidates - collect (epg-user-id-string - (car (epg-key-user-id-list c))))) - -(defun helm-epa-success-message (str keys ids) - (message str - (mapconcat (lambda (pair) - (concat (car pair) " " (cdr pair))) - (cl-loop for k in keys - for i in ids - collect (cons k i)) - "\n"))) - -;;;###autoload -(define-minor-mode helm-epa-mode - "Enable helm completion on gpg keys in epa functions." - :group 'helm-misc - :global t - (require 'epa) - (if helm-epa-mode - (progn - (advice-add 'epa--select-keys :override #'helm-epa--select-keys) - (advice-add 'epa--read-signature-type :override #'helm-epa--read-signature-type)) - (advice-remove 'epa--select-keys #'helm-epa--select-keys) - (advice-remove 'epa--read-signature-type #'helm-epa--read-signature-type))) - -(defun helm-epa-action-transformer (actions _candidate) - "Helm epa action transformer function." - (cond ((with-helm-current-buffer - (derived-mode-p 'message-mode 'mail-mode)) - (helm-append-at-nth - actions '(("Sign mail with key" . helm-epa-mail-sign) - ("Encrypt mail with key" . helm-epa-mail-encrypt)) - 3)) - (t actions))) - -(defun helm-epa-delete-keys (_candidate) - "Delete gpg marked keys from helm-epa." - (let ((context (epg-make-context epa-protocol)) - (keys (helm-marked-candidates))) - (message "Deleting gpg keys..") - (condition-case error - (epg-delete-keys context keys) - (error - (epa-display-error context) - (signal (car error) (cdr error)))) - (message "Deleting gpg keys done"))) - -(defun helm-epa-encrypt-file (_candidate) - "Select a file to encrypt with key CANDIDATE." - (let* ((file (helm-read-file-name "Encrypt file: ")) - (cands (helm-marked-candidates)) - (keys (helm-epa-collect-keys-from-candidates cands)) - (ids (helm-epa-collect-id-from-candidates cands))) - (epa-encrypt-file file cands) - (helm-epa-success-message "File encrypted with key(s):\n %s" - keys ids))) - -(defun helm-epa-kill-keys-armor (_candidate) - "Copy marked keys to kill ring." - (let ((keys (helm-marked-candidates)) - (context (epg-make-context epa-protocol))) - (with-no-warnings - (setf (epg-context-armor context) t)) - (condition-case error - (kill-new (epg-export-keys-to-string context keys)) - (error - (epa-display-error context) - (signal (car error) (cdr error)))))) - -(defun helm-epa-mail-sign (candidate) - "Sign email with key CANDIDATE." - (let ((key (epg-sub-key-id (car (epg-key-sub-key-list candidate)))) - (id (epg-user-id-string (car (epg-key-user-id-list candidate)))) - start end mode) - (save-excursion - (goto-char (point-min)) - (if (search-forward mail-header-separator nil t) - (forward-line)) - (setq epa-last-coding-system-specified - (or coding-system-for-write - (select-safe-coding-system (point) (point-max)))) - (let ((verbose current-prefix-arg)) - (setq start (point) - end (point-max) - mode (if verbose - (epa--read-signature-type) - 'clear)))) - ;; TODO Make non-interactive functions to replace epa-sign-region - ;; and epa-encrypt-region and inline them. - (with-no-warnings - (epa-sign-region start end candidate mode)) - (message "Mail signed with key `%s %s'" key id))) - -(defun helm-epa-mail-encrypt (_candidate) - "Encrypt email with key CANDIDATE." - (let ((cands (helm-marked-candidates)) - start end) - (save-excursion - (goto-char (point-min)) - (when (search-forward mail-header-separator nil t) - (forward-line)) - (setq start (point) - end (point-max)) - (setq epa-last-coding-system-specified - (or coding-system-for-write - (select-safe-coding-system start end)))) - ;; Don't let some read-only text stop us from encrypting. - (let ((inhibit-read-only t) - (keys (helm-epa-collect-keys-from-candidates cands)) - (ids (helm-epa-collect-id-from-candidates cands))) - (with-no-warnings - (epa-encrypt-region start end cands nil nil)) - (helm-epa-success-message "Mail encrypted with key(s):\n %s" - keys ids)))) - -;;;###autoload -(defun helm-epa-list-keys () - "List all gpg keys. -This is the helm interface for `epa-list-keys'." - (interactive) - (helm :sources - (helm-make-source "Epg list keys" 'helm-epa - :action-transformer 'helm-epa-action-transformer - :action 'helm-epa-actions) - :buffer "*helm epg list keys*")) - -(provide 'helm-epa) - -;;; helm-epa.el ends here diff --git a/elpa/helm-20251212.555/helm-eshell.el b/elpa/helm-20251212.555/helm-eshell.el deleted file mode 100644 index 8916cadf..00000000 --- a/elpa/helm-20251212.555/helm-eshell.el +++ /dev/null @@ -1,495 +0,0 @@ -;;; helm-eshell.el --- pcomplete and eshell completion for helm. -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2025 Thierry Volpiatto - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Commentary: -;; -;; Enable like this in .emacs: -;; (add-hook 'eshell-mode-hook -;; (lambda () -;; (eshell-cmpl-initialize) -;; (define-key eshell-mode-map [remap eshell-pcomplete] 'helm-esh-pcomplete) -;; (define-key eshell-mode-map (kbd "M-s f") 'helm-eshell-prompts-all))) -;; (define-key eshell-mode-map (kbd "M-r") 'helm-eshell-history))) - - -;;; Code: -(require 'cl-lib) -(require 'helm) -(require 'helm-lib) -(require 'helm-help) -(require 'helm-elisp) - -(declare-function eshell-read-aliases-list "em-alias") -(declare-function eshell-send-input "esh-mode" (&optional use-region queue-p no-newline)) -(declare-function eshell-bol "esh-mode") -(declare-function eshell-parse-arguments "esh-arg" (beg end)) -(declare-function eshell-backward-argument "esh-mode" (&optional arg)) -(declare-function helm-quote-whitespace "helm-lib") -(declare-function eshell-skip-prompt "em-prompt") -(defvar eshell-special-chars-outside-quoting) - - -(defgroup helm-eshell nil - "Helm completion and history for Eshell." - :group 'helm) - - -(defcustom helm-eshell-fuzzy-match nil - "Enable fuzzy matching in `helm-esh-pcomplete' when non-nil." - :type 'boolean) - - -(defvar helm-eshell-history-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-map) - (define-key map (kbd "M-p") #'helm-next-line) - map) - "Keymap for `helm-eshell-history'.") - -(defvar helm-esh-completion-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-map) - (define-key map (kbd "TAB") #'helm-next-line) - map) - "Keymap for `helm-esh-pcomplete'.") - -(defvar helm-eshell--quit-flag nil) - - -;; Internal. -(defvar helm-ec-target "") -(defun helm-ec-insert (_candidate) - "Replace text at point with CANDIDATE. -The function that call this should set `helm-ec-target' to thing -at point." - (set (make-local-variable 'comint-file-name-quote-list) - eshell-special-chars-outside-quoting) - (let ((pt (point))) - (when (and helm-ec-target - (search-backward helm-ec-target nil t) - (string= (buffer-substring (point) pt) helm-ec-target)) - (delete-region (point) pt))) - (when (string-match "\\`\\*" helm-ec-target) (insert "*")) - (let ((marked (helm-marked-candidates))) - (prog1 t ;; Makes helm returns t on action. - (insert - (mapconcat - (lambda (x) - (cond ((string-match "\\`~/" helm-ec-target) - ;; Strip out the first escape char added by - ;; `comint-quote-filename' before "~" (Bug#1803). - (substring (comint-quote-filename (abbreviate-file-name x)) 1)) - ((string-match "\\`/" helm-ec-target) - (comint-quote-filename x)) - (t - (concat (and (string-match "\\`[.]/" helm-ec-target) "./") - (comint-quote-filename - (file-relative-name x)))))) - marked " ") - (or (helm-aand (car (last marked)) - (string-match-p "/\\'" it) - "") - " "))))) - -(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 - (with-helm-current-buffer - (let* ((pcomplete-stub) - pcomplete-seen pcomplete-norm-func - pcomplete-args pcomplete-last pcomplete-index - (pcomplete-autolist pcomplete-autolist) - (pcomplete-suffix-list pcomplete-suffix-list) - (table (pcomplete-completions)) - (entry (or (try-completion helm-pattern - (pcomplete-entries)) - helm-pattern))) - (cl-loop ;; expand entry too to be able to compare it with file-cand. - with exp-entry = (and (stringp entry) - (not (string= entry "")) - (file-name-as-directory - (expand-file-name entry default-directory))) - with comps = (all-completions pcomplete-stub table) - unless comps return (prog1 nil - ;; Don't add final space when - ;; there is no completion (Bug#1990). - (setq helm-eshell--quit-flag t) - (message "No completions of %s" pcomplete-stub)) - for i in comps - ;; Transform the relative names to abs names. - for file-cand = (and exp-entry - (if (file-remote-p i) i - (expand-file-name - i (file-name-directory - (if (directory-name-p pcomplete-stub) - entry - (directory-file-name entry)))))) - ;; Compare them to avoid dups. - for file-entry-p = (and (stringp exp-entry) - (stringp file-cand) - ;; Fix :/tmp/foo/ $ cd foo - (not (file-directory-p file-cand)) - (file-equal-p exp-entry file-cand)) - if (and file-cand (or (file-remote-p file-cand) - (file-exists-p file-cand)) - (not file-entry-p)) - collect file-cand into ls - else - ;; Avoid adding entry here. - unless file-entry-p collect i into ls - finally return - (if (and exp-entry - (file-directory-p exp-entry) - ;; If the car of completion list is - ;; an executable, probably we are in - ;; command completion, so don't add a - ;; possible file related entry here. - (and ls (not (executable-find (car ls)))) - ;; Don't add entry if already in prompt. - (not (file-equal-p exp-entry pcomplete-stub))) - (append (list exp-entry) - ;; Entry should not be here now but double check. - (remove entry ls)) - ls)))))) - -;;; Eshell history. -;; -;; -(defclass helm-eshell-history-source (helm-source-sync) - ((init :initform - (lambda () - ;; Same comment as in `helm-source-esh'. - (remove-hook 'minibuffer-setup-hook 'eshell-mode))) - (candidates - :initform - (lambda () - (with-helm-current-buffer - (cl-loop for c from 0 to (ring-length eshell-history-ring) - for elm = (eshell-get-history c) - unless (and (member elm lst) - eshell-hist-ignoredups) - collect elm into lst - finally return lst)))) - (nomark :initform t) - (multiline :initform t) - (keymap :initform 'helm-eshell-history-map) - (candidate-number-limit :initform 9999) - (action :initform (lambda (candidate) - (eshell-kill-input) - (insert candidate)))) - "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 Bug#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 - :keymap helm-esh-completion-map)) - -(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*" - :resume 'noresume - :input input)) - -;;;###autoload -(defun helm-esh-pcomplete () - "Preconfigured `helm' to provide Helm completion in Eshell." - (interactive) - (let* ((helm-quit-if-no-candidate t) - (helm-execute-action-at-once-if-one t) - (end (point-marker)) - (beg (save-excursion (eshell-bol) (point))) - (args (catch 'eshell-incomplete - (eshell-parse-arguments beg end))) - (target - (or (and (looking-back " " (1- (point))) " ") - (buffer-substring-no-properties - (save-excursion - (eshell-backward-argument 1) (point)) - end))) - (users-comp (string= target "~")) - (first (car args)) ; Maybe lisp delimiter "(". - last ; Will be the last but parsed by pcomplete. - del-space - del-dot) - (setq helm-ec-target (or target " ") - end (point) - ;; Reset beg for `with-helm-show-completion'. - beg (or (and target (not (string= target " ")) - (- end (length target))) - ;; Nothing at point. - (progn (insert " ") (setq del-space t) (point)))) - (when (string-match "\\`[~.]*.*/[.]\\'" target) - ;; Fix completion on - ;; "~/.", "~/[...]/.", and "../." - (delete-char -1) (setq del-dot t) - (setq helm-ec-target (substring helm-ec-target 0 (1- (length helm-ec-target))))) - (cond ((eq first ?\() - (helm-lisp-completion-at-point)) - ;; In eshell `pcomplete-parse-arguments' is called - ;; with `pcomplete-parse-arguments-function' - ;; locally bound to `eshell-complete-parse-arguments' - ;; which is calling `lisp-complete-symbol', - ;; calling it before would popup the - ;; *completions* buffer. - (t (setq last (replace-regexp-in-string - "\\`\\*" "" - (car (last (ignore-errors - (pcomplete-parse-arguments)))))) - ;; Set helm-eshell--quit-flag to non-nil only on - ;; quit, this tells to not add final suffix when quitting - ;; helm. - (add-hook 'helm-quit-hook #'helm-eshell--quit-hook-fn) - (with-helm-show-completion beg end - (unwind-protect - (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 - ;; it when nothing found. - (and del-space (looking-back "\\s-" (1- (point))) - (delete-char -1)) - (if (and (null helm-eshell--quit-flag) - (and (stringp last) (file-directory-p last)) - (looking-back "\\([.]\\{1,2\\}\\|[^/]\\)\\'" - (1- (point)))) - (prog1 t (insert "/")) - ;; We need another flag for space here, but - ;; global to pass it to `helm-quit-hook', this - ;; space is added when point is just after - ;; previous completion and there is no - ;; more completion, see Bug#1832. - (unless (or helm-eshell--quit-flag - (looking-back "/\\'" (1- (point)))) - (prog1 t (insert " "))) - (when (and helm-eshell--quit-flag - (string-match-p "[.]\\{2\\}\\'" last)) - (insert "/")))) - (remove-hook 'helm-quit-hook #'helm-eshell--quit-hook-fn) - (setq helm-eshell--quit-flag nil))))))) - -(defun helm-eshell--quit-hook-fn () - (setq helm-eshell--quit-flag t)) - -;;;###autoload -(defun helm-eshell-history () - "Preconfigured Helm for Eshell history." - (interactive) - (let* ((end (point)) - (beg (save-excursion (eshell-bol) (point))) - (input (buffer-substring beg end)) - flag-empty) - (when (eq beg end) - (insert " ") - (setq flag-empty t) - (setq end (point))) - (unwind-protect - (with-helm-show-completion beg end - (helm :sources (helm-make-source "Eshell history" - 'helm-eshell-history-source - :fuzzy-match helm-eshell-fuzzy-match) - :buffer "*helm eshell history*" - :resume 'noresume - :input input)) - (when (and flag-empty - (looking-back " " (1- (point)))) - (delete-char -1))))) - - -;;; Eshell prompts -;; -(defface helm-eshell-prompts-promptidx - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :foreground "cyan")) - "Face used to highlight Eshell prompt index.") - -(defface helm-eshell-prompts-buffer-name - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :foreground "green")) - "Face used to highlight Eshell buffer name.") - -(defcustom helm-eshell-prompts-promptidx-p t - "Show prompt number." - :type 'boolean) - -(defvar helm-eshell-prompts-keymap - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-map) - (define-key map (kbd "C-c o") #'helm-eshell-prompts-other-window) - (define-key map (kbd "C-c C-o") #'helm-eshell-prompts-other-frame) - map) - "Keymap for `helm-eshell-prompt-all'.") - -(defvar eshell-prompt-regexp) -(defvar eshell-highlight-prompt) - -(defun helm-eshell-prompts-list (&optional buffer) - "List the prompts in Eshell BUFFER. - -Return a list of (\"prompt\" (point) (buffer-name) prompt-index)) -E.g. (\"ls\" 162 \"*eshell*\" 3). -If BUFFER is nil, use current buffer." - (with-current-buffer (or buffer (current-buffer)) - (when (eq major-mode 'eshell-mode) - (save-excursion - (goto-char (point-min)) - (let (result (count 1)) - (helm-awhile (re-search-forward eshell-prompt-regexp nil t) - (when (or (and eshell-highlight-prompt - (get-text-property (match-beginning 0) 'read-only)) - (null eshell-highlight-prompt)) - (push (list (buffer-substring-no-properties - it (pos-eol)) - it (buffer-name) count) - result) - (setq count (1+ count)))) - (nreverse result)))))) - -(defun helm-eshell-prompts-list-all () - "List the prompts of all Eshell buffers. -See `helm-eshell-prompts-list'." - (cl-loop for b in (buffer-list) - append (helm-eshell-prompts-list b))) - -(defun helm-eshell-prompts-transformer (candidates &optional all) - ;; ("ls" 162 "*eshell*" 3) => ("*eshell*:3:ls" . ("ls" 162 "*eshell*" 3)) - (cl-loop for (prt pos buf id) in candidates - collect `(,(concat - (when all - (concat (propertize - buf - 'face 'helm-eshell-prompts-buffer-name) - ":")) - (when helm-eshell-prompts-promptidx-p - (concat (propertize - (number-to-string id) - 'face 'helm-eshell-prompts-promptidx) - ":")) - prt) - . ,(list prt pos buf id)))) - -(defun helm-eshell-prompts-all-transformer (candidates) - (helm-eshell-prompts-transformer candidates t)) - -(defun helm-eshell-prompts-goto (candidate &optional action) - ;; Candidate format: ("ls" 162 "*eshell*" 3) - (unless action (setq action #'switch-to-buffer)) - (let ((buf (nth 2 candidate))) - (unless (and (string= (buffer-name) buf) - (eq action 'switch-to-buffer)) - (funcall action buf)) - (goto-char (nth 1 candidate)) - (recenter))) - -(defun helm-eshell-prompts-goto-other-window (candidate) - (helm-eshell-prompts-goto candidate 'switch-to-buffer-other-window)) - -(defun helm-eshell-prompts-goto-other-frame (candidate) - (helm-eshell-prompts-goto candidate 'switch-to-buffer-other-frame)) - -(helm-make-command-from-action helm-eshell-prompts-other-window - "Switch to eshell prompt in other window." - 'helm-eshell-prompts-goto-other-window) - -(helm-make-command-from-action helm-eshell-prompts-other-frame - "Switch to eshell prompt in other frame." - 'helm-eshell-prompts-goto-other-frame) - -;;;###autoload -(defun helm-eshell-prompts () - "Pre-configured `helm' to browse the prompts of the current Eshell." - (interactive) - (if (eq major-mode 'eshell-mode) - (helm :sources - (helm-build-sync-source "Eshell prompts" - :candidates (helm-eshell-prompts-list) - :candidate-transformer 'helm-eshell-prompts-transformer - :action '(("Go to prompt" . helm-eshell-prompts-goto))) - :buffer "*helm Eshell prompts*") - (message "Current buffer is not an Eshell buffer"))) - -;;;###autoload -(defun helm-eshell-prompts-all () - "Pre-configured `helm' to browse the prompts of all Eshell sessions." - (interactive) - (helm :sources - (helm-build-sync-source "All Eshell prompts" - :candidates (helm-eshell-prompts-list-all) - :candidate-transformer 'helm-eshell-prompts-all-transformer - :action '(("Go to prompt" . helm-eshell-prompts-goto) - ("Go to prompt in other window `C-c o`" . - helm-eshell-prompts-goto-other-window) - ("Go to prompt in other frame `C-c C-o`" . - helm-eshell-prompts-goto-other-frame)) - :keymap helm-eshell-prompts-keymap) - :buffer "*helm Eshell all prompts*")) - -(provide 'helm-eshell) - -;;; helm-eshell ends here diff --git a/elpa/helm-20251212.555/helm-eval.el b/elpa/helm-20251212.555/helm-eval.el deleted file mode 100644 index c03b67ad..00000000 --- a/elpa/helm-20251212.555/helm-eval.el +++ /dev/null @@ -1,221 +0,0 @@ -;;; helm-eval.el --- eval expressions from helm. -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2025 Thierry Volpiatto - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Code: -(require 'cl-lib) -(require 'helm) -(require 'helm-help) -(require 'eldoc) -(require 'edebug) - -(declare-function helm-lisp-completion-at-point "helm-elisp.el") -(declare-function helm-elisp-show-doc-modeline "helm-elisp.el") -(defvar helm-elisp-help-function) - -(defgroup helm-eval nil - "Eval related Applications and libraries for Helm." - :group 'helm) - -(defcustom helm-eldoc-in-minibuffer-show-fn - 'helm-show-info-in-mode-line - "A function to display eldoc info. -Should take one arg: the string to display." - :group 'helm-eval - :type 'symbol) - -(defcustom helm-show-info-in-mode-line-delay 12 - "Eldoc will show info in mode-line during this delay if user is idle." - :type 'integer - :group 'helm-eval) - - -;;; Eldoc compatibility between emacs-24 and emacs-25 -;; -(if (require 'elisp-mode nil t) ; emacs-25 - ;; Maybe the eldoc functions have been - ;; already aliased by eldoc-eval. - (cl-loop for (f . a) in '((eldoc-current-symbol . - elisp--current-symbol) - (eldoc-fnsym-in-current-sexp . - elisp--fnsym-in-current-sexp) - (eldoc-get-fnsym-args-string . - elisp-get-fnsym-args-string) - (eldoc-get-var-docstring . - elisp-get-var-docstring)) - unless (fboundp f) - do (defalias f a)) - ;; Emacs-24. - (declare-function eldoc-current-symbol "eldoc") - (declare-function eldoc-get-fnsym-args-string "eldoc" (sym &optional index)) - (declare-function eldoc-get-var-docstring "eldoc" (sym)) - (declare-function eldoc-fnsym-in-current-sexp "eldoc")) - -;;; Evaluation Result -;; -;; -;; Internal -(defvar helm-eldoc-active-minibuffers-list nil) - -(defvar helm-eval-expression-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-map) - (define-key map (kbd "") #'helm-eval-new-line-and-indent) - (define-key map (kbd "") #'lisp-indent-line) - (define-key map (kbd "") #'helm-lisp-completion-at-point) - (define-key map (kbd "C-p") #'previous-line) - (define-key map (kbd "C-n") #'next-line) - (define-key map (kbd "") #'previous-line) - (define-key map (kbd "") #'next-line) - (define-key map (kbd "") #'forward-char) - (define-key map (kbd "") #'backward-char) - map)) - -(defclass helm-evaluation-result-class (helm-source-dummy) - ((echo-input-in-header-line - :initarg :echo-input-in-header-line - :initform 'never))) - -(defun helm-build-evaluation-result-source () - (helm-make-source "Evaluation Result" 'helm-evaluation-result-class - :multiline t - :mode-line "C-RET: nl-and-indent, M-tab: reindent, C-tab:complete, C-p/n: next/prec-line." - :filtered-candidate-transformer - (lambda (_candidates _source) - (list - (condition-case nil - (with-helm-current-buffer - (pp-to-string - (if edebug-active - (edebug-eval-expression - (read helm-pattern)) - (eval (read helm-pattern) t)))) - (error "Error")))) - :nohighlight t - :keymap helm-eval-expression-map - :action `(("Copy result to kill-ring" . ,(lambda (candidate) - (kill-new - (replace-regexp-in-string - "\n" "" candidate)) - (message "Result copied to kill-ring"))) - ("copy sexp to kill-ring" . ,(lambda (_candidate) - (kill-new helm-input) - (message "Sexp copied to kill-ring")))))) - -(defun helm-eval-new-line-and-indent () - (interactive) - (newline) (lisp-indent-line)) - -(defun helm-eldoc-store-minibuffer () - "Store minibuffer buffer name in `helm-eldoc-active-minibuffers-list'." - (with-selected-window (minibuffer-window) - (push (current-buffer) helm-eldoc-active-minibuffers-list))) - -;; From emacs-28.1: As the eldoc API is nowaday a pain to use, try to -;; provide some eldoc in mode-line the best as possible (may break at -;; some point). -(defun helm-eldoc-show-in-eval () - "Return eldoc in mode-line for current minibuffer input." - (let ((buf (window-buffer (active-minibuffer-window)))) - (condition-case err - (when (member buf helm-eldoc-active-minibuffers-list) - (with-current-buffer buf - (let* ((info-fn (eldoc-fnsym-in-current-sexp)) - (vsym (eldoc-current-symbol)) - (sym (car info-fn)) - (vardoc (eldoc-get-var-docstring vsym)) - (doc (or vardoc - (eldoc-get-fnsym-args-string - sym (cadr info-fn)))) - (all (format "%s: %s" - (propertize - (symbol-name (if vardoc vsym sym)) - 'face (if vardoc - 'font-lock-variable-name-face - 'font-lock-function-name-face)) - doc))) - (when doc (funcall helm-eldoc-in-minibuffer-show-fn all))))) - (error (message "Eldoc in minibuffer error: %S" err) nil)))) - -(defun helm-show-info-in-mode-line (str) - "Display string STR in mode-line." - (save-selected-window - (with-helm-window - (let ((mode-line-format (concat " " str))) - (force-mode-line-update) - (sit-for helm-show-info-in-mode-line-delay)) - (force-mode-line-update)))) - -;;; Calculation Result -;; -;; -(defvar helm-source-calculation-result - (helm-build-dummy-source "Calculation Result" - :filtered-candidate-transformer (lambda (_candidates _source) - (list - (condition-case err - (let ((result (calc-eval helm-pattern))) - (if (listp result) - (error "At pos %s: %s" - (car result) (cadr result)) - result)) - (error (cdr err))))) - :nohighlight t - :action `(("Copy result to kill-ring" . ,(lambda (candidate) - (kill-new candidate) - (message "Result \"%s\" copied to kill-ring" - candidate))) - ("Copy operation to kill-ring" . ,(lambda (_candidate) - (kill-new helm-input) - (message "Calculation copied to kill-ring")))))) - -;;;###autoload -(defun helm-eval-expression (arg) - "Preconfigured `helm' for `helm-source-evaluation-result'." - (interactive "P") - (let ((helm-elisp-help-function #'helm-elisp-show-doc-modeline)) - (helm :sources (helm-build-evaluation-result-source) - :input (when arg (thing-at-point 'sexp)) - :buffer "*helm eval*" - :echo-input-in-header-line nil - :history 'read-expression-history))) - -(defvar eldoc-idle-delay) -;;;###autoload -(defun helm-eval-expression-with-eldoc () - "Preconfigured `helm' for `helm-source-evaluation-result' with `eldoc' support." - (interactive) - (let ((timer (run-with-idle-timer - eldoc-idle-delay 'repeat - #'helm-eldoc-show-in-eval))) - (unwind-protect - (minibuffer-with-setup-hook - #'helm-eldoc-store-minibuffer - (call-interactively 'helm-eval-expression)) - (and timer (cancel-timer timer)) - (setq helm-eldoc-active-minibuffers-list - (cdr helm-eldoc-active-minibuffers-list))))) - -;;;###autoload -(defun helm-calcul-expression () - "Preconfigured `helm' for `helm-source-calculation-result'." - (interactive) - (helm :sources 'helm-source-calculation-result - :buffer "*helm calcul*")) - -(provide 'helm-eval) - -;;; helm-eval.el ends here diff --git a/elpa/helm-20251212.555/helm-external.el b/elpa/helm-20251212.555/helm-external.el deleted file mode 100644 index 81c3de27..00000000 --- a/elpa/helm-20251212.555/helm-external.el +++ /dev/null @@ -1,264 +0,0 @@ -;;; helm-external.el --- Run Externals commands within Emacs with helm completion. -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2025 Thierry Volpiatto - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Code: - -(require 'cl-lib) -(require 'helm) -(require 'helm-help) -(require 'helm-net) - -(declare-function helm-comp-read "helm-mode") - - -(defgroup helm-external nil - "External related Applications and libraries for Helm." - :group 'helm) - -(defcustom helm-raise-command nil - "A shell command to jump to a window running specific program. -Need external program wmctrl. -This will be use with `format', so use something like \"wmctrl -xa %s\"." - :type 'string - :group 'helm-external) - -(defcustom helm-external-programs-associations nil - "Alist to store externals programs associated with file extension. -This variable overhide setting in .mailcap file. -E.g.: \\='((\"jpg\" . \"gqview\") (\"pdf\" . \"xpdf\")) " - :type '(alist :key-type string :value-type string) - :group 'helm-external) - -(defcustom helm-default-external-file-browser "nautilus" - "Default external file browser for your system. -Directories will be opened externally with it when opening file -externally in `helm-find-files'. -Set to nil if you do not have an external file browser or do not -want to use it. -Windows users should set that to \"explorer.exe\"." - :group 'helm-external - :type 'string) - -(defvar helm-open-file-externally-after-hook nil - "Hook that run after opening a file with external program.") - -(defvar helm-open-file-externally-after-finish-hook nil - "Hook that run after external program finish.") - -;;; Internals -(defvar helm-external-command-history nil) -(defvar helm-external-commands-list nil - "A list of all external commands the user can execute. -If this variable is not set by the user, it will be calculated -automatically.") - -(defun helm-external-commands-list-1 (&optional sort) - "Return a list of all external commands the user can execute. -If `helm-external-commands-list' is non-nil it will return its -contents. Else it calculates all external commands and sets -`helm-external-commands-list'." - (or helm-external-commands-list - (setq helm-external-commands-list - (cl-loop for dir in (split-string (getenv "PATH") path-separator) - when (and (file-exists-p dir) - (file-accessible-directory-p dir)) - for lsdir = (cl-loop for i in (directory-files dir t) - for bn = (file-name-nondirectory i) - when (and (not (member bn completions)) - (not (file-directory-p i)) - (file-executable-p i)) - collect bn) - append lsdir into completions - finally return - (if sort (sort completions 'string-lessp) completions))))) - -(defun helm-run-or-raise (exe &optional files detached) - "Run asynchronously EXE or jump to the application window. -If EXE is already running just jump to his window if -`helm-raise-command' is non-nil. -When FILES argument is provided run EXE with FILES. -When argument DETACHED is non nil, detach process from Emacs." - (let* ((proc-name (replace-regexp-in-string - "(" "" (car (split-string exe)))) - (fmt-file (lambda (file) - (shell-quote-argument - (if (eq system-type 'windows-nt) - (helm-w32-prepare-filename file) - (expand-file-name file))))) - (file-arg (and files (mapconcat fmt-file files " "))) - process-connection-type proc) - (when (and files detached (not (string-match "%s &)\\'" exe))) - (setq exe (format "(%s &)" exe))) - (when (member proc-name helm-external-commands-list) - ;; Allow adding more files to the current process if it is - ;; already running (i.e. Don't just raise it without sending - ;; files) we assume program doesn't start a new - ;; process (like firefox, transmission etc...). - (if files - (cond ((string-match "%s &)\\'" exe) - (message "Starting and detaching `%s' from Emacs" proc-name) - (call-process-shell-command (format exe file-arg))) - (t - (message "Starting %s..." proc-name) - (setq proc - (start-process-shell-command - proc-name nil (if (string-match "%s" exe) - (format exe file-arg) - (format "%s %s" exe file-arg)))))) - ;; Just jump to the already running program instance or start - ;; a new process. - (if (get-process proc-name) - (if helm-raise-command - (run-at-time 0.1 nil #'shell-command - (format helm-raise-command proc-name)) - (error "Error: %s is already running" proc-name)) - (if (and detached (not (memq system-type '(windows-nt ms-dos)))) - (progn - (message "Starting and detaching `%s' from Emacs" proc-name) - (call-process-shell-command (format "(%s &)" exe))) - (when detached - (user-error "Detaching programs not supported on `%s'" system-type)) - (setq proc (start-process-shell-command proc-name nil exe))))) - (when proc - (set-process-sentinel - proc - (lambda (process event) - (when (and (string= event "finished\n") - helm-raise-command - (not (helm-get-pid-from-process-name proc-name))) - (run-hooks 'helm-open-file-externally-after-finish-hook) - (shell-command (format helm-raise-command "emacs"))) - (message "%s process...Finished." process)))) - ;; Move command on top list. - (setq helm-external-commands-list - (cons proc-name - (delete proc-name helm-external-commands-list)))))) - -(defun helm-get-mailcap-for-file (filename) - "Get the command to use for FILENAME from mailcap files." - (mailcap-parse-mailcaps) - (let* ((ext (file-name-extension filename)) - (mime (when ext (mailcap-extension-to-mime ext))) - (result (when mime (mailcap-mime-info mime)))) - ;; If elisp file have no associations in .mailcap - ;; `mailcap-maybe-eval' is returned, in this case just return nil. - (when (stringp result) (helm-basename result)))) - -(defun helm-get-default-program-for-file (filename) - "Try to find a default program to open FILENAME. -Try first in `helm-external-programs-associations' and then in -mailcap file. If nothing found return nil." - (let* ((ext (file-name-extension filename)) - (def-prog (assoc-default ext helm-external-programs-associations))) - (cond ((and def-prog (not (string= def-prog ""))) def-prog) - ((and helm-default-external-file-browser (file-directory-p filename)) - helm-default-external-file-browser) - (t (helm-get-mailcap-for-file filename))))) - -(defun helm-open-file-externally (_file) - "Open FILE with an external program. -Try to guess which program to use with -`helm-get-default-program-for-file'. -If not found or a prefix arg is given query the user which tool -to use." - (let* ((files (helm-marked-candidates :with-wildcard t)) - (fname (expand-file-name (car files))) - (collection (helm-external-commands-list-1 'sort)) - (def-prog (helm-get-default-program-for-file fname)) - (program (if (or helm-current-prefix-arg (not def-prog)) - ;; Prefix arg or no default program. - (prog1 - (helm-comp-read - "Program: " collection - :must-match t - :name "Open file Externally" - :history 'helm-external-command-history) - ;; Always prompt to set this program as default. - (setq def-prog nil)) - ;; No prefix arg or default program exists. - def-prog))) - (unless (or def-prog ; Association exists, no need to record it. - ;; Don't try to record non--filenames associations (e.g urls). - (not (file-exists-p fname))) - (when - (y-or-n-p - (format - "Do you want to make `%s' the default program for this kind of files? " - program)) - (helm-aif (assoc (file-name-extension fname) - helm-external-programs-associations) - (setq helm-external-programs-associations - (delete it helm-external-programs-associations))) - (push (cons (file-name-extension fname) - (helm-read-string - "Program (Add args maybe and confirm): " program)) - helm-external-programs-associations) - (customize-save-variable 'helm-external-programs-associations - helm-external-programs-associations))) - (helm-run-or-raise program files) - (run-hooks 'helm-open-file-externally-after-hook) - (setq helm-external-command-history - (cl-loop for i in helm-external-command-history - when (executable-find i) collect i)))) - -(defun helm-run-external-command-action (candidate &optional detached) - (helm-run-or-raise candidate nil detached) - (setq helm-external-command-history - (cons candidate - (delete candidate - helm-external-command-history)))) - -(defclass helm-external-commands (helm-source-in-buffer) - ((filtered-candidate-transformer - :initform (lambda (candidates _source) - (cl-loop for c in candidates - if (get-process c) - collect (propertize c 'face 'font-lock-type-face) - else collect c))) - (must-match :initform t) - (nomark :initform t) - (action :initform - (helm-make-actions - "Run program" 'helm-run-external-command-action - (lambda () - (unless (memq system-type '(windows-nt ms-dos)) - "Run program detached")) - (lambda (candidate) - (helm-run-external-command-action candidate 'detached)))))) - -;;;###autoload -(defun helm-run-external-command () - "Preconfigured `helm' to run External PROGRAM asyncronously from Emacs. -If program is already running try to run `helm-raise-command' if -defined otherwise exit with error. You can set your own list of -commands with `helm-external-commands-list'." - (interactive) - (helm :sources `(,(helm-make-source "External Commands history" 'helm-external-commands - :data helm-external-command-history) - ,(helm-make-source "External Commands" 'helm-external-commands - :data (helm-external-commands-list-1 'sort))) - :buffer "*helm externals commands*" - :prompt "RunProgram: ") - ;; Remove from history no more valid executables. - (setq helm-external-command-history - (cl-loop for i in helm-external-command-history - when (executable-find i) collect i))) - - -(provide 'helm-external) - -;;; helm-external.el ends here diff --git a/elpa/helm-20251212.555/helm-fd.el b/elpa/helm-20251212.555/helm-fd.el deleted file mode 100644 index 895e2f30..00000000 --- a/elpa/helm-20251212.555/helm-fd.el +++ /dev/null @@ -1,153 +0,0 @@ -;;; helm-fd.el --- helm interface for fd command line tool. -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2025 Thierry Volpiatto - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Code: - -(require 'helm) -(require 'helm-types) - -(declare-function ansi-color-apply "ansi-color.el") -(declare-function split-string-shell-command "shell.el") - -(defvar helm-fd-executable "fd" - "The fd shell command executable.") - -(defcustom helm-fd-switches '("--no-ignore" "--hidden" "--type" "f" "--type" "d" "--color" "always") - "A list of options to pass to fd shell command." - :type '(repeat string) - :group 'helm-files) - -(defcustom helm-fd-mode-line-function 'helm-fd-default-mode-line - "Function called when `fd' process is finished to format mode-line." - :type 'function - :group 'helm-files) - -(defface helm-fd-finish - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :foreground "green")) - "Face used in mode line when fd process ends." - :group 'helm-grep-faces) - -(defvar helm-fd-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-generic-files-map) - (define-key map (kbd "C-]") 'undefined) - (define-key map (kbd "DEL") 'helm-delete-backward-no-update) - (define-key map (kbd "M-") 'helm-fd-next-directory) - (define-key map (kbd "M-") 'helm-fd-previous-directory) - map)) - -(defun helm-fd-next-directory-1 (arg) - (with-helm-window - (let ((cur-dir (helm-basedir (helm-get-selection)))) - (while (equal cur-dir (helm-basedir (helm-get-selection))) - (if (> arg 0) - (helm-next-line) - (helm-previous-line)))))) - -(defun helm-fd-next-directory () - "Move to next directory in a helm-fd source." - (interactive) - (with-helm-alive-p - (helm-fd-next-directory-1 1))) - -(defun helm-fd-previous-directory () - "Move to previous directory in a helm-fd source." - (interactive) - (with-helm-alive-p - (helm-fd-next-directory-1 -1))) - -(defclass helm-fd-class (helm-source-async) - ((candidates-process :initform 'helm-fd-process) - (requires-pattern :initform 2) - (candidate-number-limit :initform 20000) - (nohighlight :initform t) - (help-message :initform 'helm-fd-help-message) - (filtered-candidate-transformer :initform 'helm-fd-fct) - (action :initform 'helm-type-file-actions) - (keymap :initform 'helm-fd-map))) - -(defun helm-fd-process () - "Initialize fd process in an helm async source." - (let* (process-connection-type - (cmd (append helm-fd-switches - (or (and (fboundp #'split-string-shell-command) - (split-string-shell-command helm-pattern)) - (split-string helm-pattern)))) - (proc (apply #'start-process "fd" nil helm-fd-executable cmd)) - (start-time (float-time)) - (fd-version (replace-regexp-in-string - "\n" "" - (shell-command-to-string - (concat helm-fd-executable " --version"))))) - (helm-log "helm-fd-process" "Fd command:\nfd %s" - (mapconcat 'identity cmd " ")) - (helm-log "helm-fd-process" "VERSION: %s" fd-version) - (prog1 - proc - (set-process-sentinel - proc (lambda (process event) - (if (or (string= event "finished\n") - (process-get process 'reach-limit)) - (with-helm-window - (when helm-fd-mode-line-function - (funcall helm-fd-mode-line-function start-time fd-version) - (force-mode-line-update))) - (helm-log "helm-fd-process sentinel" "Error: Fd %s" - (replace-regexp-in-string "\n" "" event)))))))) - -(defun helm-fd-default-mode-line (start-time fd-version) - "Format mode-line with START-TIME and FD-VERSION, as well as `fd' results." - (setq mode-line-format - `(" " mode-line-buffer-identification " " - (:eval (format "L%s" (helm-candidate-number-at-point))) " " - (:eval (propertize - (format - "[%s process finished in %.2fs - (%s results)] " - ,fd-version - ,(- (float-time) start-time) - (helm-get-candidate-number)) - 'face 'helm-fd-finish))))) - -(defun helm-fd-fct (candidates _source) - "The filtered-candidate-transformer function for helm-fd." - (cl-loop for i in candidates - for fname = (ansi-color-apply i) - if helm-ff-icon-mode collect - (let* ((abs (expand-file-name fname default-directory)) - (icon (if (file-directory-p abs) - (helm-x-icons-generic "file-directory") - (helm-x-icons-icon-for-file (helm-basename fname))))) - (cons (concat icon fname) fname)) - else collect fname)) - -(defun helm-fd-1 (directory) - "Run fd shell command on DIRECTORY with helm interface." - (cl-assert (executable-find helm-fd-executable) nil "Could not find fd executable") - (cl-assert (not (file-remote-p directory)) nil "Fd not supported on remote directories") - (let ((default-directory directory)) - (helm :sources (helm-make-source "Fd" 'helm-fd-class - :header-name - (lambda (name) - (format "%s (%s)" - name (abbreviate-file-name default-directory)))) - :buffer "*helm fd*"))) - - -(provide 'helm-fd) - -;;; helm-fd.el ends here diff --git a/elpa/helm-20251212.555/helm-files.el b/elpa/helm-20251212.555/helm-files.el deleted file mode 100644 index 81a0573e..00000000 --- a/elpa/helm-20251212.555/helm-files.el +++ /dev/null @@ -1,7246 +0,0 @@ -;;; helm-files.el --- helm file browser and related. -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2025 Thierry Volpiatto - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Code: - -(require 'cl-lib) -(require 'helm) -(require 'helm-types) -(require 'helm-utils) -(require 'helm-grep) -(require 'helm-help) -(require 'helm-locate) -(require 'helm-tags) -(require 'helm-buffers) -(require 'tramp) -(eval-when-compile - (require 'thingatpt) - (require 'ffap) - (require 'dired-aux) - (require 'dired-x)) -(require 'filenotify) -(require 'image-mode) -(require 'image-dired) -(require 'helm-x-icons) - -(declare-function find-library-name "find-func.el" (library)) -(declare-function w32-shell-execute "ext:w32fns.c" (operation document &optional parameters show-flag)) -(declare-function gnus-dired-attach "ext:gnus-dired.el" (files-to-attach)) -(declare-function eshell-read-aliases-list "em-alias") -(declare-function eshell-send-input "esh-mode" (&optional use-region queue-p no-newline)) -(declare-function eshell-kill-input "esh-mode") -(declare-function eshell-bol "esh-mode") -(declare-function eshell-reset "esh-mode.el") -(declare-function eshell/cd "em-dirs.el") -(declare-function eshell-next-prompt "em-prompt.el") -(declare-function eshell-resume-eval "esh-cmd") -(declare-function helm-ls-git "ext:helm-ls-git") -(declare-function helm-hg-find-files-in-project "ext:helm-ls-hg") -(declare-function helm-ls-svn-ls "ext:helm-ls-svn") -(declare-function helm-gid "helm-id-utils.el") -(declare-function helm-find-1 "helm-find") -(declare-function helm-fd-1 "helm-fd") -(declare-function helm-get-default-program-for-file "helm-external") -(declare-function helm-open-file-externally "helm-external") -(declare-function helm-comp-read "helm-mode") -(declare-function helm-read-file-name "helm-mode") -(declare-function term-line-mode "term") -(declare-function term-char-mode "term") -(declare-function term-send-input "term") -(declare-function term-next-prompt "term") -(declare-function term-process-mark "term") -(declare-function bookmark-prop-get "bookmark") -(declare-function helm-bookmark-build-source "helm-bookmark") -(declare-function comint-next-prompt "comint") -(declare-function comint-delete-input "comint") -(declare-function comint-send-input "comint") -(declare-function comint-goto-process-mark "comint") -(declare-function tramp-dissect-file-name "tramp") -(declare-function tramp-get-completion-function "tramp") -(declare-function seconds-to-time "time-date") -(declare-function ffap-fixup-url "ffap") -(declare-function ffap-url-at-point "ffap") -(declare-function ffap-file-at-point "ffap") -(declare-function dired-create-files "dired-aux") -(declare-function dired-goto-file "dired") -(declare-function dired-move-to-filename "dired") -(declare-function dired-move-to-end-of-filename "dired") -(declare-function dired-get-filename "dired") -(declare-function dired-get-marked-files "dired") -(declare-function tramp-list-connections "tramp-cache") -(declare-function tramp-get-connection-process "tramp") -(declare-function tramp-buffer-name "tramp") -(declare-function tramp-make-tramp-file-name "tramp") -(declare-function tramp-cleanup-connection "tramp-cmds") -(declare-function dired-async-processes "ext:dired-async.el") -(declare-function dired-async-mode-line-message "ext:dired-async.el") -(declare-function dired-async--modeline-mode "ext:dired-async.el") -(declare-function helm-adaptive-sort "ext:helm-adaptive.el") -(declare-function wfnames-setup-buffer "ext:wfnames.el") -(declare-function svg-lib-progress-bar "ext:svg-lib") -(declare-function svg-lib-tag "ext:svg-lib") -(declare-function helm-epa-success-message "helm-epa") -(declare-function helm-epa-collect-id-from-candidates "helm-epa") -(declare-function helm-epa-collect-keys-from-candidates "helm-epa") -(declare-function async-byte-compile-file "async-bytecomp.el") -(declare-function async-byte-recompile-directory "async-bytecomp.el") -(declare-function dnd-begin-drag-files "dnd.el") -(declare-function vc-deduce-backend "vc") - -(defvar term-char-mode-point-at-process-mark) -(defvar term-char-mode-buffer-read-only) -(defvar recentf-list) -(defvar helm-mm-matching-method) -(defvar dired-async-mode) -(defvar org-directory) -(defvar eshell-current-command) -(defvar eshell-debug-command) -(defvar eshell-current-command) -(defvar tramp-archive-enabled) -(defvar tramp-tolerate-tilde) -(defvar password-cache) -(defvar helm-fd-executable) -(defvar wfnames-buffer) -(defvar Info-current-file) -(defvar generated-autoload-file) -(defvar recentf-max-saved-items) - -;;; Internal vars -;; -(defvar helm-ff-last-expanded-candidate-regexp "^[[:multibyte:] \t]*%s" - "Regexp that retrieve previous candidate when going up one level. -The default value matching a multibyte char at bol allows -prefixing candidate with an icon. The format part will be -replaced by the display part of the candidate regexp quoted. -This should be used for all preselection code for helm-find-files -to handle icons.") - -(defvar helm-find-files-doc-header " (\\\\[helm-find-files-up-one-level]: Go up one level)" - "*The doc that is inserted in the Name header of a find-files or dired source.") -(defvar helm-ff-auto-update-flag nil - "Internal, flag to turn on/off auto-update in `helm-find-files'. -Don't set it directly, use instead `helm-ff-auto-update-initial-value'.") -(defvar helm-ff-last-expanded nil - "Store last expanded directory or file.") -(defvar helm-ff-default-directory nil) -(defvar helm-ff-history nil) -(defvar helm-ff-url-regexp - "\\`\\(news\\(post\\)?:\\|nntp:\\|mailto:\\|file:\\|\\(ftp\\|https?\\|telnet\\|gopher\\|www\\|wais\\):/?/?\\).*" - "Same as `ffap-url-regexp' but match earlier possible url.") -;; helm-tramp-file-name-regexp is based on old version of -;; tramp-file-name-regexp i.e. "\\`/\\([^[/:]+\\|[^/]+]\\):" but it -;; seems it is wrong and a simpler regexp is enough, let's try it and -;; watch out! -(defvar helm-tramp-file-name-regexp "\\`/\\([^/:|]+\\):") -(defvar helm-ff-tramp-method-regexp "[/|]:\\([^:]*\\)") -(defvar helm-ff--auto-update-state nil) -(defvar helm-ff--deleting-char-backward nil) -(defvar helm-multi-files--toggle-locate nil) -(defvar helm-ff--move-to-first-real-candidate t) -(defvar helm-find-files--toggle-bookmark nil) -(defvar helm-ff--tramp-methods nil) -(defvar helm-ff--directory-files-length (make-hash-table :test 'equal) - "Used to count number of candidates in directory. -candidate-number-limit is set to this value if this value is bigger -than `helm-candidate-number-limit'.") -(defvar helm-ff--list-directory-cache (make-hash-table :test 'equal) - "Cache for `helm-find-files' candidates.") -(defvar helm-ff--file-notify-watchers (make-hash-table :test 'equal) - "File-notify watchers for `helm-find-files' are stored here.") -(defvar helm-ff-history-buffer-name "*helm-find-files history*") -(defvar helm-rsync-command-history nil) -(defvar helm-rsync--last-progress-bar-alist nil - "Used to store last valid rsync progress bar.") -(defvar helm-rsync-process-buffer "*helm-rsync*") -(defvar helm-rsync-progress-str-alist nil) -(defvar helm-ff--trash-directory-regexp "\\.?Trash[/0-9]+files/?\\'") -(defvar helm-ff--show-directories-only nil) -(defvar helm-ff--show-files-only nil) -(defvar helm-ff--trashed-files nil - "[INTERNAL] Files already trashed are stored here during file deletion. -This is used only as a let binding.") -(defvar helm-ff--show-thumbnails nil) -(defvar helm-ff--thumbnailed-directories nil) -(defvar helm-source-find-files nil - "The main source to browse files. -Should not be used among other sources.") -(defvar helm-ff-icon-mode nil) - -;;; Helm-find-files - The helm file browser. -;; -;; Keymaps - -(defvar helm-find-files-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-map) - (define-key map (kbd "RET") 'helm-ff-RET) - (define-key map (kbd "C-]") 'helm-ff-run-toggle-basename) - (define-key map (kbd "C-x C-f") 'helm-ff-run-locate) - (define-key map (kbd "C-x C-d") 'helm-ff-run-browse-project) - (define-key map (kbd "C-x r m") 'helm-ff-bookmark-set) - (define-key map (kbd "C-x r b") 'helm-find-files-switch-to-bookmark) - (define-key map (kbd "C-x C-q") 'helm-ff-run-edit-marked-files) - (define-key map (kbd "C-s") 'helm-ff-run-grep) - (define-key map (kbd "M-g s") 'helm-ff-run-grep) - (define-key map (kbd "M-g p") 'helm-ff-run-pdfgrep) - (define-key map (kbd "M-g z") 'helm-ff-run-zgrep) - (define-key map (kbd "M-g a") 'helm-ff-run-grep-ag) - (define-key map (kbd "M-g g") 'helm-ff-run-git-grep) - (define-key map (kbd "M-g i") 'helm-ff-run-gid) - (define-key map (kbd "M-.") 'helm-ff-run-etags) - (define-key map (kbd "M-R") 'helm-ff-run-rename-file) - (define-key map (kbd "M-C") 'helm-ff-run-copy-file) - (define-key map (kbd "M-k") 'helm-ff-run-kill-default-directory) - (when (executable-find "rsync") - (define-key map (kbd "M-V") 'helm-ff-run-rsync-file)) - (define-key map (kbd "C-M-SPC") 'helm-ff-mark-similar-files) - (define-key map (kbd "C-M-@") 'helm-ff-mark-similar-files) - (define-key map (kbd "C-c C-SPC") 'helm-ff-mark-similar-files) - (define-key map (kbd "C-M-c") 'helm-ff-run-mcp) - (define-key map (kbd "M-B") 'helm-ff-run-byte-compile-file) - (define-key map (kbd "M-L") 'helm-ff-run-load-file) - (define-key map (kbd "M-S") 'helm-ff-run-symlink-file) - (define-key map (kbd "M-Y") 'helm-ff-run-relsymlink-file) - (define-key map (kbd "M-H") 'helm-ff-run-hardlink-file) - (define-key map (kbd "M-D") 'helm-ff-run-delete-file) - (define-key map (kbd "M-K") 'helm-ff-run-kill-buffer-persistent) - (define-key map (kbd "M-T") 'helm-ff-run-touch-files) - (define-key map (kbd "M-M") 'helm-ff-run-chmod) - ;; M-O in ttys is a prefix key. - (define-key map (if (display-graphic-p) - (kbd "M-O") (kbd "M-O O")) - 'helm-ff-run-chown) - (define-key map (kbd "M-G") 'helm-ff-run-chgrp) - (define-key map (kbd "C-c z") 'helm-ff-persistent-compress) - (define-key map (kbd "M-Z") 'helm-ff-run-compress-marked-files) - (define-key map (kbd "M-c") 'helm-ff-run-compress-to) - (define-key map (kbd "C-c d") 'helm-ff-persistent-delete) - (define-key map (kbd "M-e") 'helm-ff-run-switch-to-shell) - (define-key map (kbd "C-c i") 'helm-ff-run-complete-fn-at-point) - (define-key map (kbd "C-c o") 'helm-ff-run-switch-other-window) - (define-key map (kbd "C-c C-o") 'helm-ff-run-switch-other-frame) - (define-key map (kbd "C-c C-x") 'helm-ff-run-open-file-externally) - (define-key map (kbd "C-c C-v") 'helm-ff-run-preview-file-externally) - (define-key map (kbd "C-c X") 'helm-ff-run-open-file-with-default-tool) - (define-key map (kbd "C-c t") 'helm-ff-toggle-thumbnails) - (define-key map (kbd "M-!") 'helm-ff-run-eshell-command-on-file) - (define-key map (kbd "M-@") 'helm-ff-run-query-replace-fnames-on-marked) - (define-key map (kbd "M-%") 'helm-ff-run-query-replace) - (define-key map (kbd "C-M-%") 'helm-ff-run-query-replace-regexp) - (define-key map (kbd "C-c =") 'helm-ff-run-ediff-file) - (define-key map (kbd "M-=") 'helm-ff-run-ediff-merge-file) - (define-key map (kbd "M-p") 'helm-find-files-history) - (define-key map (kbd "C-c h") 'helm-ff-file-name-history) - (define-key map (kbd "M-i") 'helm-ff-properties-persistent) - (define-key map (kbd "C-}") 'helm-narrow-window) - (define-key map (kbd "C-{") 'helm-enlarge-window) - (define-key map (kbd "C-") 'helm-ff-run-toggle-auto-update) - (define-key map (kbd "C-c ") 'helm-ff-run-toggle-auto-update) - (define-key map (kbd "C-c C-a") 'helm-ff-run-mail-attach-files) - (define-key map (kbd "C-c p") 'helm-ff-run-print-file) - (define-key map (kbd "C-c /") 'helm-ff-run-find-sh-command) - (define-key map (kbd "C-/") 'helm-ff-run-fd) - ;; Next 2 have no effect if candidate is not an image file. - (define-key map (kbd "M-l") 'helm-ff-rotate-left-persistent) - (define-key map (kbd "M-r") 'helm-ff-rotate-right-persistent) - (define-key map (kbd "M-+") 'helm-ff-increase-image-size-persistent) - (define-key map (kbd "M--") 'helm-ff-decrease-image-size-persistent) - (define-key map (kbd "C-l") 'helm-find-files-up-one-level) - (define-key map (kbd "C-:") 'helm-ff-complete-tramp-methods) - (define-key map (kbd "C-_") 'helm-ff-undo) - (define-key map (kbd "C-;") 'helm-find-files-down-last-level) - (define-key map (kbd "C-c r") 'helm-ff-run-find-file-as-root) - (define-key map (kbd "C-x C-v") 'helm-ff-run-find-alternate-file) - (define-key map (kbd "C-c @") 'helm-ff-run-insert-org-link) - (define-key map (kbd "S-") 'helm-ff-sort-alpha) - (define-key map (kbd "S-") 'helm-ff-sort-by-newest) - (define-key map (kbd "S-") 'helm-ff-sort-by-size) - (define-key map (kbd "S-") 'helm-ff-toggle-dirs-only) - (define-key map (kbd "S-") 'helm-ff-toggle-files-only) - (define-key map (kbd "S-") 'helm-ff-sort-by-ext) - (helm-define-key-with-subkeys map (kbd "DEL") ?\d 'helm-ff-delete-char-backward - '((C-backspace . helm-ff-run-toggle-auto-update) - ([C-c DEL] . helm-ff-run-toggle-auto-update)) - nil 'helm-ff-delete-char-backward--exit-fn) - (when (fboundp 'tab-bar-mode) - (define-key map (kbd "C-c C-t") 'helm-ff-run-find-file-other-tab)) - map) - "Keymap for `helm-find-files'.") - -(defvar helm-read-file-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-map) - (define-key map (kbd "") 'helm-cr-empty-string) - (define-key map (kbd "M-RET") 'helm-cr-empty-string) - (define-key map (kbd "C-]") 'helm-ff-run-toggle-basename) - (define-key map (kbd "C-.") 'helm-find-files-up-one-level) - (define-key map (kbd "C-l") 'helm-find-files-up-one-level) - (define-key map (kbd "C-:") 'helm-ff-complete-tramp-methods) - (define-key map (kbd "C-_") 'helm-ff-undo) - (define-key map (kbd "C-;") 'helm-find-files-down-last-level) - (define-key map (kbd "C-c h") 'helm-ff-file-name-history) - (define-key map (kbd "C-x r b") 'helm-ff-bookmark-insert-location) - (define-key map (kbd "C-") 'helm-ff-run-toggle-auto-update) - (define-key map (kbd "C-c ") 'helm-ff-run-toggle-auto-update) - (define-key map (kbd "C-c t") 'helm-ff-toggle-thumbnails) - (define-key map (kbd "S-") 'helm-ff-sort-alpha) - (define-key map (kbd "S-") 'helm-ff-sort-by-newest) - (define-key map (kbd "S-") 'helm-ff-sort-by-size) - (define-key map (kbd "S-") 'helm-ff-sort-by-ext) - (define-key map (kbd "RET") 'helm-ff-RET) - (helm-define-key-with-subkeys map (kbd "DEL") ?\d 'helm-ff-delete-char-backward - '((C-backspace . helm-ff-run-toggle-auto-update) - ([C-c DEL] . helm-ff-run-toggle-auto-update)) - nil 'helm-ff-delete-char-backward--exit-fn) - map) - "Keymap for `helm-read-file-name'.") - - -;;; User variables -;; -(defgroup helm-files nil - "Files applications and libraries for Helm." - :group 'helm) - -(defcustom helm-tramp-verbose 0 - "Just like `tramp-verbose' but specific to Helm. -When set to 0 don't show tramp messages in Helm. -If you want to have the default tramp messages set it to 3." - :type 'integer) - -(defcustom helm-ff-auto-update-initial-value nil - "Auto update when only one candidate directory is matched. -Default value when starting `helm-find-files' is nil to not -confuse new users. -For a better experience with `helm-find-files' set this to -non-nil and use C- to toggle it." - :type 'boolean) - -(defcustom helm-ff-history-max-length 100 - "Number of elements shown in `helm-find-files' history." - :type 'integer) - -(defcustom helm-ff-fuzzy-matching t - "Enable fuzzy matching for `helm-find-files' when non--nil. -See `helm-ff--transform-pattern-for-completion' for more info." - :type 'boolean) - -(defcustom helm-ff-exif-data-program "exiftran" - "Program used to extract exif data of an image file." - :type 'string) - -(defcustom helm-ff-exif-data-program-args "-d" - "Arguments used for `helm-ff-exif-data-program'." - :type 'string) - -(defcustom helm-ff-newfile-prompt-p t - "Whether Prompt or not when creating new file. -This set `ffap-newfile-prompt'." - :type 'boolean) - -(defcustom helm-ff-avfs-directory "~/.avfs" - "The default avfs directory, usually \\='~/.avfs'. -When this is set you will be able to expand archive filenames -with `C-j' inside an avfs directory mounted with mountavfs. -See ." - :type 'string) - -(defcustom helm-ff-file-compressed-list '("gz" "bz2" "zip" "7z" "xz") - "Minimal list of compressed files extension." - :type '(repeat (choice string))) - -(defcustom helm-ff-printer-list nil - "A list of available printers on your system. -When non-nil let you choose a printer to print file. -Otherwise when nil the variable `printer-name' will be used. -On Unix based systems (lpstat command needed) you don't need to -set this, `helm-ff-find-printers' will find a list of available -printers for you." - :type '(repeat (choice string))) - -(defcustom helm-ff-transformer-show-only-basename t - "Show only basename of candidates in `helm-find-files'. -This can be toggled at anytime from `helm-find-files' with \ -\\\\[helm-ff-run-toggle-basename]. Note -that even when non nil, the dotted directories on top i.e. \".\" -and \"..\" are still displayed as full path when -`helm-ff-show-dot-file-path' is non nil." - :type 'boolean) - -(defcustom helm-ff-show-dot-file-path nil - "Show full path of dotted directories when non nil." - :type 'boolean - :set (lambda (var val) - (set-default var val) - (clrhash helm-ff--list-directory-cache))) - -(defcustom helm-ff-signal-error-on-dot-files t - "Signal error when file is `.' or `..' on file deletion when non-nil. -Default is non-nil. -WARNING: Setting this to nil is unsafe and can cause deletion of -a whole tree." - :type 'boolean) - -(defcustom helm-ff-search-library-in-sexp nil - "Search for library in `require' and `declare-function' sexp." - :type 'boolean) - -(defcustom helm-tooltip-hide-delay 25 - "Hide tooltips automatically after this many seconds." - :type 'integer) - -(defcustom helm-ff-skip-boring-files nil - "Non-nil to skip boring files. -I.e. the files matching regexps in `helm-boring-file-regexp-list'. -This takes effect in `helm-find-files' and file completion used by -`helm-mode' i.e. `helm-read-file-name'. -Note that when non-nil this will slow down slightly `helm-find-files'." - :type 'boolean) - -(defcustom helm-ff-skip-git-ignored-files nil - "Non-nil to skip git ignored files. -This take effect only in `helm-find-files'. -Check is not done on remote files. -Note that when non-nil this will slow down slightly -`helm-find-files'." - :type 'boolean) - -(defcustom helm-ff-candidate-number-limit 500 - "The `helm-candidate-number-limit' for `helm-find-files' and friends. -Note that when going one level up with -`\\\\[helm-find-files-up-one-level]' the -length of directory will be used instead if it is higher than -this value. This is to avoid failing to preselect the previous -directory/file if this one is situated lower than -`helm-ff-candidate-number-limit' num candidate." - :type 'integer) - -(defvar helm-ff-preselect-ignore-large-dirs nil - "This variable has no effect, use `helm-ff-dynamic-candidate-number-limit'.") -(make-obsolete-variable 'helm-ff-preselect-ignore-large-dirs - 'helm-ff-dynamic-candidate-number-limit - "4.0.6") - -(defvaralias 'helm-ff-up-one-level-preselect 'helm-ff-dynamic-candidate-number-limit) -(defcustom helm-ff-dynamic-candidate-number-limit t - " When non-nil `candidate-number-limit' source value is modified dynamically. -This when going one level up if the position of previous candidate in -its directory is > to `helm-ff-candidate-number-limit' This ensure -preselection on previous directory when going one level up possible. It -can be helpful to disable this and reduce -`helm-ff-candidate-number-limit' if you often navigate across very large -directories." - :type 'boolean) -(make-obsolete-variable 'helm-ff-up-one-level-preselect - 'helm-ff-dynamic-candidate-number-limit - "4.0.6") - -(defcustom helm-find-files-before-init-hook nil - "Hook that run before initialization of `helm-find-files'." - :type 'hook) - -(defcustom helm-find-files-after-init-hook nil - "Hook that run after initialization of `helm-find-files'." - :type 'hook) - -(defcustom helm-find-files-bookmark-prefix nil - "bookmark name prefix of `helm-find-files' sessions." - :type 'string) - -(defcustom helm-ff-guess-ffap-filenames nil - "Use ffap to guess local filenames at point in `helm-find-files'. -This doesn't disable url or mail at point, see -`helm-ff-guess-ffap-urls' for this." - :type 'boolean) - -(defcustom helm-ff-guess-ffap-urls t - "Use ffap to guess local urls at point in `helm-find-files'. -This doesn't disable guessing filenames at point, see -`helm-ff-guess-ffap-filenames' for this. -See also `ffap-url-unwrap-remote' that may override this -variable." - :type 'boolean) - -(defcustom helm-ff-no-preselect nil - "When non-nil `helm-find-files' starts at root of current directory." - :type 'boolean) - -(defcustom helm-ff-allow-non-existing-file-at-point nil - "Use non existing file-at-point as initial input in `helm-find-files'." - :type 'boolean) - -(defcustom helm-find-files-ignore-thing-at-point nil - "Use only `default-directory' as default input in `helm-find-files'. -I.e. text under cursor in `current-buffer' is ignored. -Note that when non-nil you will be unable to complete filename at -point in `current-buffer'." - :type 'boolean) - -(defcustom helm-substitute-in-filename-stay-on-remote nil - "Don't switch back to local filesystem when expanding pattern with / or ~/." - :type 'boolean) - -(defcustom helm-ff-goto-first-real-dired-exceptions '(dired-goto-file) - "Dired commands that are allowed moving to first real candidate." - :type '(repeat (choice symbol))) - -(defcustom helm-mounted-network-directories nil - "A list of directories used for mounting remotes filesystem. - -When nil `helm-file-on-mounted-network-p' always return nil -otherwise check if a file is in one of these directories. - -Remote filesystem are generally mounted with sshfs." - :type '(repeat string)) - -(defcustom helm-browse-project-default-find-files-fn - (cond ((or (executable-find "fd") - (executable-find "fdfind")) - #'helm-browse-project-fd-find-files) - ((executable-find "rg") - #'helm-browse-project-rg-find-files) - ((executable-find "ag") - #'helm-browse-project-ag-find-files) - (t #'helm-browse-project-walk-directory)) - "The default function to retrieve files in a non-vc directory. - -A function that takes a directory name as only arg." - :type 'function) - -(defcustom helm-ff-kill-or-find-buffer-fname-fn - #'helm-ff-kill-or-find-buffer-fname - "Default function used to expand non-directory filenames in `helm-find-files'. - -This variable will take effect only in `helm-find-files'. It -affects the behavior of persistent-action on filenames and -non-existing filenames. - -The default is to expand filename on first hit on -\\\\[helm-execute-persistent-action], pop buffer in -other window on second hit and finally kill this buffer on third -hit. This is very handy to create several new buffers, or when -navigating, show quickly the buffer of file to see its contents -briefly before killing it and continue navigating. - -However some users may not want this, so to disable this behaviour -just set this to `ignore' function. - -Of course you can also write your own function to do something -else." - :type 'function) - -(defcustom helm-modes-using-escaped-strings - '(eshell-mode shell-mode term-mode) - "Modes that requires string's insertion to be escaped." - :type '(repeat symbol)) - -(defcustom helm-ff-allow-recursive-deletes nil - "When \\='always don't prompt for recursive deletion of directories. -When nil, will ask for recursive deletion. -Note that when deleting multiple directories you can answer ! -when prompted to avoid being asked for next directories, so it -is probably better to not modify this variable." - :type '(choice - (const :tag "Delete non-empty directories" t) - (const :tag "Confirm for each directory" nil))) - -(defcustom helm-ff-delete-files-function #'helm-delete-marked-files - "The function to use by default to delete files. - -Default is to delete files synchronously, other choice is to -delete files asynchronously. - -BE AWARE that when deleting async you will not be warned about -recursive deletion of directories, IOW non-empty directories will -be deleted with no warnings in background!!! - -It is the function that will be used when using -`\\\\[helm-ff-run-delete-file]' from -`helm-find-files'." - :type '(choice (function :tag "Delete files synchronously." - helm-delete-marked-files) - (function :tag "Delete files asynchronously." - helm-delete-marked-files-async))) - -(defcustom helm-trash-remote-files nil - "Allow trashing remote files when non-nil. - -Trashing remote files with tramp doesn't work out of the box -unless the \\='trash-cli' package is installed. This is why trashing -remote files from Helm is disabled by default. - -Tramp is using external \\='trash' command in its `delete-file' and -`delete-directory' handlers when using -`delete-by-moving-to-trash', which is documented nowhere in -Emacs. - -If you want to enable this you will have to install the \\='trash' -command on remote (and/or locally if you want to trash as root). -On Ubuntu-based distributions it is \\='trash-cli'." - :type 'boolean) - -(defvaralias 'helm-list-directory-function 'helm-list-remote-directory-fn) -(make-obsolete-variable 'helm-list-directory-function 'helm-list-remote-directory-fn "4.0") - -(defcustom helm-list-remote-directory-fn - (cl-case system-type - (gnu/linux #'helm-list-dir-external) - (berkeley-unix #'helm-list-dir-lisp) - (windows-nt #'helm-list-dir-lisp) - (t #'helm-list-dir-lisp)) - "The function used in `helm-find-files' to list remote directories. - -Currently Helm provides two functions to do this: -`helm-list-dir-lisp' and `helm-list-dir-external'. - -Using `helm-list-dir-external' will provide a similar display to -what is provided with local files i.e. colorized symlinks, -executables files etc., whereas using `helm-list-dir-lisp' will -allow colorizing only directories but it is more portable. - -NOTE: `helm-list-dir-external' needs ls and awk as dependencies. -Also the ls version installed on the remote side should support -the same arguments as the GNU/ls version, which are -A -1 -F -b -and -Q. So even if you are using a GNU/ls version locally and you -want to connect e.g. on a Freebsd server, you may have failures -due to the incompatible ls version installed on remote server. In -such case use `helm-list-dir-lisp' which works everywhere but is -slower and less featured (only directories colorized)." - :type 'function) - -(defcustom helm-ff-initial-sort-method nil - "Sort method to use when initially listing a directory. - -It is better to keep this nil globally and turn it on only when needed -otherwise it may be slightly slower specially with `ext' method which -BTW is not provided on remote files (helm will fallback on nil in such -case). -Note that this have no effect as soon as you start narrowing directory -i.e. filtering filenames inside directory." - :type '(choice - (const :tag "alphabetically" nil) - (const :tag "newest" newest) - (const :tag "size" size) - (const :tag "extensions" ext))) - -(defcustom helm-ff-rotate-image-program "exiftran" - "External program used to rotate images. -When nil and `helm-ff-display-image-native' is enabled, fallback to -`image-rotate' without modification of exif data i.e. rotation is not -persistent otherwise an error is returned when not using -`helm-ff-display-image-native' i.e. using image-dired." - :type '(choice - (const :tag "Mogrify" "mogrify") - (const :tag "Exiftran" "exiftran") - (const :tag "Jpegtran" "jpegtran"))) - -(defcustom helm-ff-rotate-image-switch '("-i") - "Options used with `helm-ff-rotate-image-program'. -If you are using Mogrify or Jpegtran mandatory option is -\"-rotate\", with Exiftran mandatory option is \"-i\"." - :type '(repeat string)) - -(defcustom helm-ff-preferred-shell-mode 'eshell-mode - "Shell to use to switch to a shell buffer from `helm-find-files'. -Possible values are `shell-mode', `eshell-mode' and `term-mode'. -This affects `\\\\[helm-ff-run-switch-to-shell]' keybinding." - :type '(choice - (const :tag "Use Eshell" eshell-mode) - (const :tag "Use Shell" shell-mode) - (const :tag "Use Term" term-mode))) - -(defcustom helm-rsync-no-mode-line-update nil - "When non nil don't update mode-line when rsync is running. -This is useful if you display the progress bar somewhere else, -e.g. with minibuffer-line in minibuffer, in this case updating -mode-line may create flickering in other frame's mode-line." - :type 'boolean) - -(defcustom helm-rsync-switches '("-a" "-z" "-h" "-s" "--info=all2") - "Rsync options to use with HFF Rsync action. -Note: Using \"--info=all2\" allows having the name of the file -currently transfered in an help-echo in mode-line, if you use -\"--info=progress2\" you will not have this information." - :type '(repeat string)) - -(defcustom helm-rsync-percent-sign "％" - "Percentage unicode sign to use in Rsync reporter." - :type 'string) - -(defcustom helm-ff-rsync-progress-bar-style (if (display-graphic-p) 'bar 'text) - "Style of progress-bar for rsync action. -Value can be either bar or text. -Progress bar is inaccurate on non graphic displays, use text instead." - :type '(choice - (const :tag "Progress bar as a bar" bar) - (const :tag "Progress bar with text" text))) - -(defcustom helm-ff-rsync-progress-bar-info '(percent) - "Infos shown at end of Rsync progress bar. - -Valid value is a list containing one or more elements from -percent, size, speed and remain. When set to nil show nothing at end of -progress bar. -This Has no effect when `helm-ff-rsync-progress-bar-style' is text." - :type '(set :tag "Check zero or more items to show at end of Rsync progress bar" - (const :tag "Show the amount of data copied" size) - (const :tag "Show the percentage of data copied" percent) - (const :tag "Show the current speed of transfer" speed) - (const :tag "Show the time remaining" remain))) - -(defcustom helm-rsync-progress-bar-function #'helm-rsync-default-progress-bar - "Function used to draw a rsync progress bar in mode-line. -Function is called with three args: PROCESS, PERCENT, INFO. -PROCESS is the rsync process in use, it's name is displayed before the progress -bar, it is useful to display it to distinguish the different processes running -e.g. rsync1 rsync2 etc... -PERCENT is the current percentage of data sent to the progress bar. -INFO is what is displayed after the progress bar according to -`helm-ff-rsync-progress-bar-info'. -Currently Helm provides two functions to draw the progress bar: -- The default progress bar which use the whole height of mode-line and print -colored spaces to mimic a progress bar. -- The SVG based progress bar which use the external library svg-lib (you will -have to install it to use this function) and needs emacs to be compiled with svg -support." - :type '(choice - (function :tag "Default progress bar" - helm-rsync-default-progress-bar) - (function :tag "SVG progress bar" - helm-rsync-svg-progress-bar))) - -(defcustom helm-trash-default-directory nil - "The default trash directory. -You probably don't need to set this when using a Linux system using -standard settings. -Should be the directory file name i.e. don't add final slash. -When nil helm will compute a default value according to freedesktop -specs. -It is generally \"~/.local/share/Trash\"." - :type 'string) - -(defcustom helm-ff-lynx-style-map t - "Use arrow keys to navigate with `helm-find-files'. -Note that if you define this variable with `setq' your change -will have no effect, use customize instead." - :type 'boolean - :set (lambda (var val) - (set var val) - (if val - (progn - (define-key helm-find-files-map (kbd "") 'helm-execute-persistent-action) - (define-key helm-find-files-map (kbd "") 'helm-find-files-up-one-level) - (define-key helm-read-file-map (kbd "") 'helm-execute-persistent-action) - (define-key helm-read-file-map (kbd "") 'helm-find-files-up-one-level)) - (define-key helm-find-files-map (kbd "") nil) - (define-key helm-find-files-map (kbd "") nil) - (define-key helm-read-file-map (kbd "") nil) - (define-key helm-read-file-map (kbd "") nil)))) - -(defcustom helm-ff-DEL-up-one-level-maybe nil - "Use DEL to maybe go up one level when non nil. - -Going up one level works only when pattern is a directory endings -with \"/\", otherwise this command deletes char backward. - -When nil always delete char backward." - :type 'boolean) - -(defcustom helm-ff-display-image-native t - "Use native `image-mode' when non nil. - -You should use this only with Emacs>= 27 and `image-auto-resize' -enabled to have images resized properly. When this is enabled, -you have new commands to zoom in/out images. See -`image-transform-resize' and `image-auto-resize'. Otherwise, -when nil `image-dired' is used, using imagemagick as backend. -NOTE: On Emacs-29 `image-dired' is no more using external program -image-magick to display image, so this is used inconditionally even -when value is nil." - :type 'boolean) - -(defcustom helm-ff-reset-filters-on-update t - "Reset filter variables when changing directory. -When filtering directories/files only, switch back to a \"show all\" view -when moving out of directory when non nil." - :type 'boolean) - -(defcustom helm-ff-eshell-unwanted-aliases nil - "A list of eshell aliases to not display." - :type '(repeat string)) - -(defcustom helm-eshell-on-file-reverse-history t - "History source in *eshell-command-on-file appears on top when non nil." - :type 'boolean) - -(defcustom helm-ff-edit-marked-files-fn #'helm-ff-wfnames - "A function to edit filenames in a special buffer. - -By default `wfnames' package is used to avoid wdired which -doesn't always work with all emacs versions and also is quite -clumsy about default-directory among other things. If you still -want to use it, helm is still providing -`helm-marked-files-in-dired'." - :type '(choice (function :tag "Use Wfnames package to edit filenames." - helm-ff-wfnames) - (function :tag "Use Wdired package to edit filenames." - helm-marked-files-in-dired))) - -(defcustom helm-find-files-actions - (helm-make-actions - "Find File" 'helm-find-file-or-marked - "Find file in Dired" 'helm-point-file-in-dired - "View file" 'view-file - "Query replace fnames on marked `M-@'" 'helm-ff-query-replace-fnames-on-marked - (lambda () - (helm-acase helm-ff-edit-marked-files-fn - (helm-marked-files-in-dired "Edit filenames in Wdired `C-x C-q'") - (helm-ff-wfnames "Edit filenames in Wfnames `C-x C-q'"))) - 'helm-ff-edit-marked-files - "Query replace contents on marked `M-%'" 'helm-ff-query-replace - "Query replace regexp contents on marked `C-M-%'" 'helm-ff-query-replace-regexp - "Attach file(s) to mail buffer `C-c C-a'" 'helm-ff-mail-attach-files - "Serial rename files" 'helm-ff-serial-rename - "Serial rename by symlinking files" 'helm-ff-serial-rename-by-symlink - "Serial rename by copying files" 'helm-ff-serial-rename-by-copying - "Open file with default tool" 'helm-open-file-with-default-tool - "Find file in hex dump" 'hexl-find-file - "Browse project `C-x C-d'" 'helm-ff-browse-project - "Complete at point `C-c i'" 'helm-insert-file-name-completion-at-point - "Insert as org link `C-c @'" 'helm-files-insert-as-org-link - "Find shell command `C-c /'" 'helm-ff-find-sh-command - "Fd shell command (C-/)" 'helm-ff-fd - "Find files in file" 'helm-find-files-in-file - "Add marked files to file-cache" 'helm-ff-cache-add-file - "Open file externally `C-c C-x, C-u to choose'" 'helm-open-file-externally - "Grep File(s) `C-s, C-u Recurse'" 'helm-find-files-grep - "Grep current directory with AG `M-g a, C-u select type'" 'helm-find-files-ag - "Git grep `M-g g, C-u from root'" 'helm-ff-git-grep - "Zgrep File(s) `M-g z, C-u Recurse'" 'helm-ff-zgrep - "Pdf Grep File(s)" 'helm-ff-pdfgrep - "Gid `M-g i'" 'helm-ff-gid - "Switch to Eshell `M-e'" 'helm-ff-switch-to-shell - "Etags `M-., C-u reload tag file'" 'helm-ff-etags-select - "Eshell command on file(s) `M-!, C-u take all marked as arguments.'" - 'helm-find-files-eshell-command-on-file - "Find file as root `C-c r'" 'helm-find-file-as-root - "Find alternate file `C-x C-v'" 'find-alternate-file - "Ediff File `C-c ='" 'helm-find-files-ediff-files - "Ediff Merge File `M-='" 'helm-find-files-ediff-merge-files - (lambda () (format "Delete File(s)%s `M-D' (C-u reverse trash)" - (if (eq helm-ff-delete-files-function - 'helm-delete-marked-files-async) - " async" ""))) - 'helm-ff-delete-files - "Touch File(s) `M-T'" 'helm-ff-touch-files - "Encrypt file(s)" 'helm-ff-encrypt-files - "Copy file(s) `M-C, C-u to follow'" 'helm-find-files-copy - (lambda () - (and (executable-find "rsync") - "Rsync file(s) `M-V' (C-u edit command)")) - 'helm-find-files-rsync - "Rename file(s) `M-R, C-u to follow'" 'helm-find-files-rename - "Backup files" 'helm-find-files-backup - "Copy file to dir(s) `C-M-c'" 'helm-ff-mcp - "Symlink files(s) `M-S, C-u to follow'" 'helm-find-files-symlink - "Relsymlink file(s) `M-Y, C-u to follow'" 'helm-find-files-relsymlink - "Hardlink file(s) `M-H, C-u to follow'" 'helm-find-files-hardlink - "Compress file(s) to archive `M-c'" 'helm-find-files-compress-to - "Compress or uncompress file(s) `M-Z'" 'helm-ff-compress-marked-files - "Change mode on file(s) `M-M'" 'helm-ff-chmod - "Change owner on file(s) `M-O' or `M-O O' in ttys" 'helm-ff-chown - "Change group on file(s) `M-G'" 'helm-ff-chgrp - "Find file other window `C-c o'" 'helm-find-files-other-window - "Find file other frame `C-c C-o'" 'find-file-other-frame - (lambda () (and (fboundp 'tab-bar-mode) - "Find file other tab `C-c C-t'")) - 'helm-ff-find-file-other-tab - "Print File `C-c p, C-u to refresh'" 'helm-ff-print - "Locate `C-x C-f, C-u to specify locate db'" 'helm-ff-locate) - "Actions for `helm-find-files'." - :type '(alist :key-type string :value-type function)) - -(defcustom helm-dwim-target nil - "Default target directory for file actions. - -Define the directory where you want to start navigating for the -target directory when copying, renaming, etc.. You can use the -`default-directory' of `next-window', the visited directory, the -current `default-directory' or have completion on all the -directories belonging to each visible windows." - :type '(radio :tag "Define default target directory for file actions." - (const :tag "Directory belonging to next window" - next-window) - (const :tag "Completion on directories belonging to each window" - completion) - (const :tag "Use initial directory or `default-directory'" - default-directory) - (const :tag "Use visited directory" - nil))) - -(defcustom helm-ff-use-notify t - "Watch directories visited with `helm-find-files' when non nil. -If your system have no file notification package available turn this -to nil to avoid error messages when using `helm-find-files'." - :type 'boolean - :set (lambda (var val) - (set-default var val) - (unless (symbol-value var) - (cl-loop for dir being the hash-keys of helm-ff--file-notify-watchers - do (remhash dir helm-ff--list-directory-cache))))) - -(defcustom helm-ff-inotify-unsupported-methods '("adb") - "Tramp methods unsupported by file-notify." - :type '(repeat string)) - -(defcustom helm-ff-image-cache-max-len 5 - "The last seen image number to keep in cache." - :type 'integer) - -(defcustom helm-ff-image-cache-max-len 5 - "The last seen image number to keep in cache." - :type 'integer) - -(defcustom helm-ff-slideshow-default-delay 3 - "Delay in seconds between each image in slideshow." - :type 'integer) - -(defcustom helm-file-name-history-max-length 72 - "Max length of candidates in helm file name history before truncating." - :type 'integer) - -(defcustom helm-ff-follow-blacklist-file-exts '("gpg" "doc" "docx" "mp3" "ogg") - "File extensions we don't want to follow when helm-follow-mode is enabled. -Note that image files are always followed even if their extensions is -present in this list." - :type '(repeat string)) - -(defcustom helm-ff-nohighlight-matches nil - "Highlight matches in `helm-find-files' when nil." - :type 'boolean - :initialize 'custom-initialize-changed - :set (lambda (var val) - (set var val) - ;; Force rebuilding the source to remove the highlight match FCT. - (setq helm-source-find-files nil))) - -(defcustom helm-ff-ignore-following-on-directory nil - "In follow mode ignore silently directories when non nil." - :type 'boolean) - -(defcustom helm-ff-dim-prompt-on-update t - "When non nil dim prompt while updating." - :type 'boolean) - -(defcustom helm-ff-drag-mouse-1-default-action 'copy - "Default action when dragging files. -Possible values are `copy', `move' or `link'. -Currently supported value is `copy' when dropping to a dired buffer, `move' is -working only when dropping on an external application (only thunar tested)." - :type '(choice - (const :tag "Copy" copy) - (const :tag "Move" move) - (const :tag "Link" link))) - -(defcustom helm-find-files-ignore-diacritics nil - "Ignore diacritics on basename of files when non nil. -Note that this happens only when switching to multimatch, i.e. adding spaces in -pattern, this may slowdown a little matching of candidates when non nil. -Setting this with `setq' may have no effect on this variable, use -`customize-set-variable'. This variable affects as well `read-file-name'." - :type 'boolean - :set (lambda (var val) - (set var val) - ;; Force rebuilding the source to pass diacritics fn to diacritics - ;; slot. - (setq helm-source-find-files nil))) - -(defcustom helm-turn-on-recentf t - "Automatically turn on `recentf-mode' when non-nil." - :group 'helm-files - :type 'boolean) - -;;; Faces -;; -;; -(defgroup helm-files-faces nil - "Customize the appearance of helm-files." - :prefix "helm-" - :group 'helm-files - :group 'helm-faces) - -(defface helm-ff-prefix - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :background "yellow" :foreground "black")) - "Face used to prefix new file or url paths in `helm-find-files'." - :group 'helm-files-faces) - -(defface helm-ff-executable - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :foreground "green")) - "Face used for executable files in `helm-find-files'." - :group 'helm-files-faces) - -(defface helm-ff-suid - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :background "red" :foreground "white")) - "Face used for suid files in `helm-find-files'." - :group 'helm-files-faces) - -(defface helm-ff-directory - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :foreground "DarkRed" :background "LightGray")) - "Face used for directories in `helm-find-files'." - :group 'helm-files-faces) - -(defface helm-ff-dotted-directory - `((((class color) (min-colors 88) (background dark)) - ,@(and (>= emacs-major-version 27) '(:extend t)) - :foreground "black" :background "DimGray") - (((class color) (min-colors 88) (background light)) - ,@(and (>= emacs-major-version 27) '(:extend t)) - :foreground "black" :background "LightGray") - (t :inherit default)) - "Face used for dotted directories in `helm-find-files'." - :group 'helm-files-faces) - -(defface helm-ff-dotted-symlink-directory - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :foreground "DarkOrange" :background "DimGray")) - "Face used for dotted symlinked directories in `helm-find-files'." - :group 'helm-files-faces) - -(defface helm-ff-symlink - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :inherit font-lock-comment-face)) - "Face used for symlinks in `helm-find-files'." - :group 'helm-files-faces) - -(defface helm-ff-invalid-symlink - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :foreground "black" :background "red")) - "Face used for invalid symlinks in `helm-find-files'." - :group 'helm-files-faces) - -(defface helm-ff-denied - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :foreground "red" :background "black")) - "Face used for non accessible files in `helm-find-files'." - :group 'helm-files-faces) - -(defface helm-ff-file - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :inherit font-lock-builtin-face)) - "Face used for file names in `helm-find-files'." - :group 'helm-files-faces) - -(defface helm-ff-nofile - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :inherit helm-ff-file)) - "Face used for non-files file names in `helm-find-files'. -Used when showing tramp host completions." - :group 'helm-files-faces) - -(defface helm-ff-truename - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :inherit font-lock-string-face)) - "Face used for symlink truenames in `helm-find-files'." - :group 'helm-files-faces) - -(defface helm-ff-dirs - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :inherit font-lock-function-name-face)) - "Face used for file names in recursive dirs completion in `helm-find-files'." - :group 'helm-files-faces) - -(defface helm-ff-socket - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :foreground "DeepPink")) - "Face used for socket files in `helm-find-files'." - :group 'helm-files-faces) - -(defface helm-ff-pipe - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :foreground "yellow" :background "black")) - "Face used for named pipes and character device files in `helm-find-files'." - :group 'helm-files-faces) - -(defface helm-ff-file-extension - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :foreground "magenta")) - "Face used for file extensions in `helm-find-files'." - :group 'helm-files-faces) - -(defface helm-ff-backup-file - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :foreground "DimGray")) - "Face used for backup files in `helm-find-files'." - :group 'helm-files-faces) - -(defface helm-history-deleted - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :inherit helm-ff-invalid-symlink)) - "Face used for deleted files in `file-name-history'." - :group 'helm-files-faces) - -(defface helm-history-remote - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :foreground "IndianRed1")) - "Face used for remote files in `file-name-history'." - :group 'helm-files-faces) - -(defface helm-delete-async-message - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :foreground "yellow")) - "Face used for mode-line message." - :group 'helm-files-faces) - -(defface helm-ff-rsync-progress - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :inherit font-lock-warning-face)) - "Face used for rsync mode-line indicator." - :group 'helm-files-faces) - -(defface helm-ff-rsync-progress-1 - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :background "CadetBlue" :foreground "black")) - "Face used for rsync progress bar percentage and proc name." - :group 'helm-files-faces) - -(defface helm-ff-rsync-progress-2 - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :background "orange")) - "Face used for rsync progress bar progress." - :group 'helm-files-faces) - -(defface helm-ff-rsync-progress-3 - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :background "white")) - "Face used for rsync progress bar background." - :group 'helm-files-faces) - -(defface helm-ff-rsync-progress-svg - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :background "black" :foreground "white")) - "Face used for rsync svg progress bar." - :group 'helm-files-faces) - -;;; Helm-find-files -;; -;; -(defclass helm-source-ffiles (helm-source-sync) - ((header-name - :initform (lambda (name) - (concat name (substitute-command-keys - helm-find-files-doc-header)))) - (init - :initform (lambda () - (setq helm-ff-auto-update-flag - helm-ff-auto-update-initial-value) - (setq helm-ff--auto-update-state - helm-ff-auto-update-flag) - (helm-set-local-variable 'bookmark-make-record-function - #'helm-ff-make-bookmark-record) - (require 'helm-external))) - (candidates :initform 'helm-find-files-get-candidates) - (update :initform (lambda () - (remhash helm-ff-default-directory - helm-ff--list-directory-cache))) - (match-on-real :initform t) - ;; We don't want to have here matchfns loaded uselessly. - ;; By using diacritics :match should expand to: - ;; '(helm-mm-exact-match helm-mm-3f-match-on-diacritics helm-mm-3-migemo-match) - ;; If helm-find-files-ignore-diacritics is nil we should fallback to: - ;; '(helm-mm-exact-match helm-mm-3f-match helm-mm-3-migemo-match) - ;; See `helm-source-mm-get-search-or-match-fns'. - (match :initform (unless helm-find-files-ignore-diacritics - 'helm-mm-3f-match)) - (diacritics :initform (and helm-find-files-ignore-diacritics - 'helm-mm-3f-match-on-diacritics)) - (filtered-candidate-transformer - :initform '(helm-ff-fct - helm-ff-maybe-show-thumbnails - ;; These next two have to be called after - ;; `helm-ff-fct' as they use only cons cell candidates. - helm-ff-directories-only - helm-ff-files-only - helm-ff-sort-candidates)) - (popup-info :initform (lambda (candidate) - (unless (helm-ff-dot-file-p candidate) - (helm-file-attributes - candidate - :dired t :human-size t :octal nil)))) - (persistent-action-if :initform 'helm-find-files-persistent-action-if) - (persistent-help :initform "Hit1 Expand Candidate, Hit2 or (C-u) Find file") - (help-message :initform 'helm-ff-help-message) - (mode-line :initform (list "File(s)" helm-mode-line-string)) - (volatile :initform t) - (cleanup :initform 'helm-find-files-cleanup) - (migemo :initform t) - (nohighlight :initform (progn helm-ff-nohighlight-matches)) - (keymap :initform 'helm-find-files-map) - (candidate-number-limit :initform 'helm-ff-candidate-number-limit) - (suspend-follow-in-update - :initarg :suspend-follow-in-update - :initform t - :documentation "Prevent following candidate when updating.") - (completing-file-name - :initarg :completing-file-name :initform t - :documentation "Flag to notify `helm-resume' we are completing filenames.") - (action-transformer - :initform 'helm-find-files-action-transformer) - (action :initform 'helm-find-files-actions) - (before-init-hook :initform 'helm-find-files-before-init-hook) - (after-init-hook :initform 'helm-find-files-after-init-hook) - (all-marked :initform t) - (group :initform 'helm-files))) - -;; Bookmark handlers. -;; -(defun helm-ff-make-bookmark-record () - "The `bookmark-make-record-function' for `helm-find-files'." - (with-helm-buffer - `((filename . ,helm-ff-default-directory) - (presel . ,(helm-get-selection)) - (handler . helm-ff-bookmark-jump)))) - -(defun helm-ff-bookmark-jump (bookmark) - "bookmark handler for `helm-find-files'." - (let ((fname (bookmark-prop-get bookmark 'filename)) - (presel (bookmark-prop-get bookmark 'presel))) - ;; Force tramp connection with `file-directory-p' before lauching - ;; hff otherwise the directory name is inserted on top before - ;; tramp starts and display candidates. FNAME is here always a - ;; directory. - (when (file-directory-p fname) - (helm-find-files-1 fname - (format helm-ff-last-expanded-candidate-regexp - (if helm-ff-transformer-show-only-basename - (regexp-quote (helm-basename presel)) - (regexp-quote presel))))))) - -(defun helm-ff-bookmark-set () - "Record `helm-find-files' session in bookmarks." - (interactive) - (with-helm-alive-p - (with-helm-buffer - (bookmark-set - (concat helm-find-files-bookmark-prefix - (abbreviate-file-name helm-ff-default-directory)))) - (message "Helm find files session bookmarked! "))) -(put 'helm-ff-bookmark-set 'helm-only t) - -(defun helm-dwim-target-directory () - "Try to return a suitable directory according to `helm-dwim-target'." - (with-selected-window (or - ;; Try next-window if current-buffer has been - ;; killed during this session probably by C-d. - (get-buffer-window helm-current-buffer) - (next-window (helm-window) 1)) - (let ((wins (remove (get-buffer-window helm-marked-buffer-name) - (window-list)))) - (expand-file-name - (cond (;; Provide completion on all the directory belonging to - ;; visible windows if some. - (and (cdr wins) - (eq helm-dwim-target 'completion)) - (helm-comp-read "Browse target starting from: " - (append (list (or (car-safe helm-ff-history) - default-directory) - default-directory) - (cl-loop for w in wins collect - (with-selected-window w - default-directory))))) - ;; Use default-directory of next-window. - ((and (cdr wins) - (eq helm-dwim-target 'next-window)) - (with-selected-window (next-window) - default-directory)) - ;; Always use default-directory when only one window. - ((and (null (cdr wins)) - (eq helm-dwim-target 'default-directory)) - default-directory) - ;; Use the visited directory. - ((or (null (cdr wins)) - (null helm-dwim-target)) - ;; Using the car of *ff-history allow - ;; staying in the directory visited instead of - ;; current. - (or (car-safe helm-ff-history) default-directory))))))) - -(defsubst helm-ff--file-directory-p (file) - (if (file-remote-p file) - (get-text-property 1 'helm-ff-dir file) - (file-directory-p file))) - -(defun helm-ff--count-and-collect-dups (files) - (cl-loop with dups = (make-hash-table :test 'equal) - for f in files - for file = (if (helm-ff--file-directory-p f) - (concat (helm-basename f) "/") - (helm-basename f)) - for count = (gethash file dups) - if count do (puthash file (1+ count) dups) - else do (puthash file 1 dups) - finally return (cl-loop for k being the hash-keys in dups - using (hash-value v) - if (> v 1) - collect (format "%s(%s)" k v) - else - collect k))) - -(defun helm-find-files-do-action (action &optional target) - "Generic function for creating actions from `helm-source-find-files'. -ACTION can be `rsync' or any action supported by `helm-dired-action'." - (require 'dired-async) - (when (eq action 'rsync) - (cl-assert (executable-find "rsync") nil "No command named rsync")) - (let* (dired-create-destination-dirs ; We handle dirs creation ourself. - (rsync-switches - (when (and (eq action 'rsync) - helm-current-prefix-arg) - (cdr (split-string - (read-string "Run rsync like this: " - (mapconcat - 'identity - (cons "rsync" helm-rsync-switches) " ") - 'helm-rsync-command-history))))) - (ifiles (mapcar 'expand-file-name ; Allow modify '/foo/.' -> '/foo' - ;; Use :all-sources to allow actions on wildcards - ;; marked in dummy source. FIXME: We should use - ;; :all-sources when :all-marked is non nil only, it is - ;; true by default but user may modify HFF source by defmethod. - (helm-marked-candidates :with-wildcard t :all-sources t))) - (cand (unless (cdr ifiles) (helm-get-selection))) ; preselection. - (prefarg helm-current-prefix-arg) - (prompt (format "%s %s file(s) %s: " - (if (and (and (fboundp 'dired-async-mode) - dired-async-mode) - (not (eq action 'rsync)) - (null prefarg)) - (concat "Async " (symbol-name action)) - (capitalize (symbol-name action))) - (length ifiles) - (if (memq action '(symlink relsymlink hardlink)) - "from" "to"))) - (cdir (helm-aand - (eq action 'compress) - (helm-common-dir ifiles) - (if (stringp it) - (file-name-as-directory it) - (error "Try to compress files not belonging to same drive")))) - helm-ff--move-to-first-real-candidate - helm-display-source-at-screen-top ; prevent setting window-start. - helm-ff-auto-update-initial-value - ;; It is not possible to rename a file to a boring name when - ;; helm-ff-skip-boring-files is enabled - helm-ff-skip-boring-files - ;; If HFF is using a frame use a frame as well. - (helm-actions-inherit-frame-settings t) - helm-use-frame-when-more-than-two-windows - (dest (or target - (with-helm-display-marked-candidates - helm-marked-buffer-name - (if cdir - (mapcar (lambda (f) - (file-relative-name f cdir)) - ifiles) - (helm-ff--count-and-collect-dups ifiles)) - (with-helm-current-buffer - (helm-read-file-name - prompt - :preselect - (when cand - (format helm-ff-last-expanded-candidate-regexp - (regexp-quote - (if helm-ff-transformer-show-only-basename - (helm-basename cand) cand)))) - :default (and cdir - (expand-file-name - (format "%s.tar.gz" (if cand - (helm-basename cand) - "new_archive")) - cdir)) - :must-match (and cdir (lambda (f) (not (file-directory-p f)))) - :initial-input (or cdir (helm-dwim-target-directory)) - :history (helm-find-files-history nil :comp-read nil)))))) - (dest-dir-p (file-directory-p dest)) - (dest-dir (if dest-dir-p dest (helm-basedir dest)))) - ;; Ignore `dired-create-destination-dirs' and handle directory creation from - ;; here like we were doing before. Dired is failing to create directories - ;; when e.g. symlinking some files to a not yet existing directory. - (unless (or dest-dir-p (file-directory-p dest-dir)) - (when (y-or-n-p (format "Create directory `%s'? " dest-dir)) - ;; When saying No here with rsync, `helm-rsync-copy-files' will raise an - ;; error about dest not existing. - (make-directory dest-dir t))) - (helm-acase action - (rsync (helm-rsync-copy-files ifiles dest rsync-switches)) - (compress (helm-do-compress-to ifiles dest)) - (t (helm-dired-action - dest :files ifiles :action action :follow prefarg))))) - -;; Rsync -;; -(defun helm-rsync-remote2rsync (file) - (if (file-remote-p file) - (let ((localname (directory-file-name - (expand-file-name (file-remote-p file 'localname)))) - (user (file-remote-p file 'user)) - ;; Tramp name may contain port e.g. /ssh:host#2222:/foo. - (host (replace-regexp-in-string - "#[0-9]+" "" (file-remote-p file 'host)))) - (if user - (format "%s@%s:%s" user host (shell-quote-argument localname)) - (format "%s:%s" host (shell-quote-argument localname)))) - (shell-quote-argument - (directory-file-name - (expand-file-name file))))) - -(defun helm-rsync-format-mode-line-str (proc) - (helm-aif (and (process-live-p proc) - (assoc-default proc helm-rsync-progress-str-alist)) - (progn - ;; When rsync progress bar stop for some reason (e.g. rsync - ;; takes time to finalize writing file to disk), no output is - ;; coming from filter process, as a result the progress bar - ;; disapear for a while giving no information to user while - ;; the rsync process continues, so keep printing the last valid - ;; progress bar (stored in `helm-rsync--last-progress-bar-alist') - ;; instead of sending empty string. - (unless (equal it "") - (push (cons proc it) helm-rsync--last-progress-bar-alist)) - (if (eq helm-ff-rsync-progress-bar-style 'text) - (format " [%s]" (propertize - (or (assoc-default proc helm-rsync--last-progress-bar-alist) - ;; Avoid (wrong-type-argument stringp - ;; nil) when process is not ready. - "") - 'face 'helm-ff-rsync-progress)) - (format " %s" (or (assoc-default proc helm-rsync--last-progress-bar-alist) - ;; Avoid (wrong-type-argument stringp - ;; nil) when process is not ready. - "")))))) - -(defun helm-ff--rsync-progress-bar (progbar proc) - ;; progbar == " 2,83G 92% 98,65MB/s 0:00:02 " - (let ((infos (split-string - (replace-regexp-in-string - "%" helm-rsync-percent-sign - progbar) - " " t)) - percent info) - (if (eq helm-ff-rsync-progress-bar-style 'text) - (mapconcat 'identity infos " ") - (setq info - (mapconcat (lambda (x) - (helm-acase x - (size (nth 0 infos)) - (percent (nth 1 infos)) - (speed (nth 2 infos)) - (remain (nth 3 infos)))) - (helm-mklist helm-ff-rsync-progress-bar-info) - ", ")) - (when (string-match "\\([0-9]+\\)%" progbar) - (setq percent (string-to-number - (match-string 1 progbar)))) - (if percent - (funcall helm-rsync-progress-bar-function proc percent info) - "")))) - -(defun helm-rsync-default-progress-bar (proc percent info) - (format "%s%s%s%s" - (propertize (capitalize (replace-regexp-in-string - "<\\([0-9]+\\)>" "(\\1)" - (process-name proc))) - 'display '(height 0.9) - 'face 'helm-ff-rsync-progress-1) - (propertize " " 'display `(space :width ,(list percent)) - 'face 'helm-ff-rsync-progress-2) - (propertize " " 'display `(space :width ,(list (- 100 percent))) - 'face 'helm-ff-rsync-progress-3) - (propertize info - 'display '(height 0.9) - 'face 'helm-ff-rsync-progress-1))) - -(defun helm-rsync-svg-progress-bar (proc percent info) - (cl-assert (image-type-available-p 'svg) nil - "svg-lib requires Emacs to be compiled with svg support") - (require 'svg-lib) - (format "%s%s%s" - (propertize " " 'display (svg-lib-tag - (process-name proc) - 'helm-ff-rsync-progress-svg)) - (propertize " " 'display (svg-lib-progress-bar - (/ (+ percent 7) 105.0) - 'helm-ff-rsync-progress-svg - :width 10 :margin 1 :stroke 2 :padding 2)) - (if (string= info "") - "" - (propertize " " 'display (svg-lib-tag - info 'helm-ff-rsync-progress-svg))))) - -(defun helm-rsync-mode-line (proc) - "Add Rsync progress to the mode line." - (or global-mode-string (setq global-mode-string '(""))) - (unless (member `(:eval (helm-rsync-format-mode-line-str ,proc)) - global-mode-string) - (setq global-mode-string - (append global-mode-string - `((:eval (helm-rsync-format-mode-line-str ,proc))))))) - -(defun helm-rsync-restore-mode-line (proc) - "Restore the mode line when Rsync finishes." - (setq global-mode-string - (remove `(:eval (helm-rsync-format-mode-line-str ,proc)) - global-mode-string)) - (setq helm-rsync--last-progress-bar-alist nil) - (force-mode-line-update)) - -(defun helm-rsync-copy-files (files dest &optional switches) - "Send FILES to DEST using Rsync with SWITCHES as arguments. - -DEST must be a directory. SWITCHES when unspecified default to -`helm-rsync-switches'." - (cl-assert (file-directory-p dest) t) - (setq files (cl-loop for f in files - collect (helm-rsync-remote2rsync f)) - dest (helm-rsync-remote2rsync dest)) - (let* ((buf (generate-new-buffer-name helm-rsync-process-buffer)) - (host (file-remote-p dest 'host)) - (port (when (and host (string-match "#\\([0-9]+\\)" host)) - (match-string 1 host))) - (proc (start-process-shell-command - "rsync" buf - (format "rsync %s" - (mapconcat - 'identity - (append (or switches helm-rsync-switches) - (and port - ;; Add automatically port - ;; specified in tramp name - ;; unless user already specified - ;; it himself with the -e option - ;; by editing command. - switches - (cl-loop for arg in switches never - (string-match-p - "\\`-e" arg)) - (list (format "-e 'ssh -p %s'" - port))) - files (list dest)) - " "))))) - (helm-rsync-mode-line proc) - (set-process-sentinel - proc (lambda (process event) - (cond ((string= event "finished\n") - (message "%s copied %s files" - (capitalize (process-name process)) - (length files))) - (t (error "Process %s %s with code %s" - (process-name process) - (process-status process) - (process-exit-status process)))) - (setq helm-rsync-progress-str-alist - (delete (assoc process helm-rsync-progress-str-alist) - helm-rsync-progress-str-alist)) - (helm-rsync-restore-mode-line process))) - (set-process-filter proc #'helm-rsync-process-filter))) - -(defun helm-rsync-process-filter (proc output) - "Filter process function used by `helm-rsync-copy-files'." - (let ((inhibit-read-only t) - fname progbar) - (with-current-buffer (process-buffer proc) - (when (string-match comint-password-prompt-regexp output) - ;; FIXME: Fully not tested and - ;; use an agent or auth-source - ;; or whatever to get password if - ;; available. - (process-send-string - proc (concat (read-passwd (match-string 0 output)) "\n"))) - ;; Extract the progress bar. - (with-temp-buffer - (insert output) - (when (re-search-backward "[[:cntrl:]]" nil t) - (setq progbar (buffer-substring-no-properties - (match-end 0) (point-max))))) - ;; Insert the text, advancing the process marker. - (save-excursion - (goto-char (process-mark proc)) - (insert output) - (set-marker (process-mark proc) (point))) - (goto-char (process-mark proc)) - ;; Extract the file name currently - ;; copied (Imply --info=all2 or all1). - (save-excursion - (when (re-search-backward "^[^[:cntrl:]]" nil t) - (setq fname (helm-basename - (buffer-substring-no-properties - (point) (pos-eol)))))) - ;; Now format the string for the mode-line. - (let ((ml-str (helm-ff--rsync-progress-bar progbar proc))) - (setq ml-str (propertize ml-str 'help-echo - (format "%s->%s" (process-name proc) fname))) - ;; Now associate the formatted - ;; progress-bar string with process. - (helm-aif (assoc proc helm-rsync-progress-str-alist) - (setcdr it ml-str) - (setq helm-rsync-progress-str-alist - (push (cons proc ml-str) helm-rsync-progress-str-alist))))) - ;; Finally update mode-line. - (unless helm-rsync-no-mode-line-update - (force-mode-line-update)))) - -(defun helm-ff-kill-rsync-process (process) - "Kill rsync process PROCESS. - -When called interactively prompt user with completion when more than -one process." - (interactive (list (get-process - (helm-comp-read - "Kill rsync process: " - (mapcar (lambda (x) - (process-name (car x))) - helm-rsync-progress-str-alist) - :exec-when-only-one t)))) - (with-current-buffer (process-buffer process) - (delete-process process) - (kill-buffer)) - (setq helm-rsync-progress-str-alist - (delete (assoc process helm-rsync-progress-str-alist) - helm-rsync-progress-str-alist))) - -(defun helm-find-files-rsync (_candidate) - "Rsync files from `helm-find-files'." - (helm-find-files-do-action 'rsync)) - -(defun helm-find-files-copy (_candidate) - "Copy files from `helm-find-files'." - (helm-find-files-do-action 'copy)) - -(defun helm-find-files-backup (_candidate) - "Backup files from `helm-find-files'. -This reproduce the behavior of \"cp --backup=numbered from to\"." - (cl-assert (and (fboundp 'dired-async-mode) dired-async-mode) nil - "Backup only available when `dired-async-mode' is enabled") - (helm-find-files-do-action 'backup)) - -(defun helm-find-files-rename (_candidate) - "Rename files from `helm-find-files'." - (helm-find-files-do-action 'rename)) - -(defun helm-find-files-symlink (_candidate) - "Symlink files from `helm-find-files'." - (helm-find-files-do-action 'symlink)) - -(defun helm-find-files-relsymlink (_candidate) - "Relsymlink files from `helm-find-files'." - (helm-find-files-do-action 'relsymlink)) - -(defun helm-find-files-hardlink (_candidate) - "Hardlink files from `helm-find-files'." - (helm-find-files-do-action 'hardlink)) - -(defun helm-find-files-compress-to (_candidate) - "Compress to archive from `helm-find-files'." - (helm-find-files-do-action 'compress)) - -(defun helm-ff-compress-marked-files (_candidate) - "Compress or uncompress marked files with `dired-compress-file'." - (require 'dired-async) - (let* ((files (helm-marked-candidates :with-wildcard t))) - (if (not (with-helm-display-marked-candidates - helm-marked-buffer-name - (mapcar #'abbreviate-file-name files) - (y-or-n-p (format "Compress or uncompress *%s File(s)" (length files))))) - (message "(No (un)compression performed)") - (process-put - (async-start - `(lambda () - (require 'dired-aux) - (let ((len 0)) - (dolist (i ',files) - (let ((default-directory (file-name-directory i))) - (when (dired-compress-file i) - (cl-incf len)))) - len)) - (lambda (result) - (unless (dired-async-processes 'helm-async-compress) - (helm-ff--compress-async-modeline-mode -1)) - (message "%s File(s) (un)compressed" result) - (run-with-timer - 0.1 nil - (lambda (len flist) - (dired-async-mode-line-message - "%s %d/%d file(s) done" - 'helm-delete-async-message - "(Un)compressing" - len (length flist))) - result files))) - 'helm-async-compress t) - (helm-ff--compress-async-modeline-mode 1)))) - -(helm-make-command-from-action helm-ff-run-compress-marked-files - "Compress or uncompress marked files." - 'helm-ff-compress-marked-files) - -(defun helm-ff-chmod (_candidate) - "Set file mode on marked files. -If no mode is specified in prompt, default mode will be the mode of -the car of marked files i.e. the first marked file." - (let* ((mkd (helm-marked-candidates :with-wildcard t)) - (model (car mkd)) - (default (helm-file-attributes model :octal t)) - (mode (read-file-modes nil model)) - (smode (file-modes-number-to-symbolic mode)) - (candidates (if (string= default (format "%o" mode)) - (cdr mkd) mkd))) - (with-helm-display-marked-candidates - helm-marked-buffer-name - (helm-ff--count-and-collect-dups candidates) - (when (y-or-n-p (format "Change file mode to `%s'? " smode)) - (dolist (f candidates) - (unless (file-symlink-p f) - ;; For now don't use the FLAG arg 'nofollow of `set-file-modes' for - ;; Emacs-26 compatibility. - (set-file-modes f mode))) - (message "Changed file mode to `%s' on %s file(s)" - smode (length candidates)))))) - -(defun helm-ff--dired-marked-files (&rest _args) - ;; Internally dired-do-chxxx needs basenames. - (cl-loop for f in (helm-marked-candidates :with-wildcard t) - collect (helm-basename f))) - -(defun helm-ff--dired-get-filename (&rest _args) - ;; Internally dired-do-chxxx needs basenames. - (helm-aif (helm-get-selection) (helm-basename it))) - -(defun helm-ff-dired-do-chxxx (&rest args) - "Variation of `dired-do-chxxx' for helm." - (require 'dired-aux) - (cl-letf (((symbol-function 'dired-get-marked-files) - #'helm-ff--dired-marked-files) - ((symbol-function 'dired-do-redisplay) - #'ignore) - ((symbol-function 'dired-get-filename) - #'helm-ff--dired-get-filename)) - ;; dired-aux is requiring dired so dired-click-to-select-mode should be - ;; also available. - (let (dired-click-to-select-mode) - (apply #'dired-do-chxxx args)))) - -(defun helm-ff-chown (_candidate) - "Variation of `dired-do-chown' for helm." - (with-helm-default-directory helm-ff-default-directory - (when (and (memq system-type '(ms-dos windows-nt)) - (not (file-remote-p default-directory))) - (error "chown not supported on this system")) - (helm-ff-dired-do-chxxx "Owner" dired-chown-program 'chown nil))) - -(defun helm-ff-chgrp (_candidate) - "Variation of `dired-do-chgrp' for helm." - (with-helm-default-directory helm-ff-default-directory - (when (and (memq system-type '(ms-dos windows-nt)) - (not (file-remote-p default-directory))) - (error "chown not supported on this system")) - (helm-ff-dired-do-chxxx "Group" "chgrp" 'chgrp nil))) - -(helm-make-command-from-action helm-ff-run-chown "Change owner on file(s)." 'helm-ff-chown) -(helm-make-command-from-action helm-ff-run-chgrp "Change group on file(s)." 'helm-ff-chgrp) -(put 'helm-ff-run-chown 'helm-only t) -(put 'helm-ff-run-chgrp 'helm-only t) - -(defun helm-find-files-other-window (_candidate) - "Keep current-buffer and open files in separate windows. -When a prefix arg is detected files are opened in a vertical -windows layout." - (let* ((files (helm-marked-candidates)) - (buffers (mapcar 'find-file-noselect files))) - (helm-window-show-buffers buffers t))) - -(defun helm-find-files-byte-compile (_candidate) - "Byte compile elisp files from `helm-find-files'." - (let ((files (helm-marked-candidates :with-wildcard t)) - (parg helm-current-prefix-arg)) - (cl-loop for fname in files - do (condition-case _err - (with-no-warnings - (byte-compile-file fname parg)) - (wrong-number-of-arguments - ;; Emacs-28 accepts only one arg. - (byte-compile-file fname) - (when parg (load fname))))))) - -(defun helm-find-files-load-files (_candidate) - "Load elisp files from `helm-find-files'." - (let ((files (helm-marked-candidates :with-wildcard t))) - (cl-loop for fname in files - do (load fname)))) - -(defun helm-find-files-ediff-files-1 (candidate &optional merge) - "Generic function to ediff/merge files in `helm-find-files'." - (let* ((helm-dwim-target 'next-window) - (bname (helm-basename candidate)) - (marked (helm-marked-candidates :with-wildcard t)) - (prompt (if merge "Ediff Merge `%s' With File: " - "Ediff `%s' With File: ")) - (fun (if merge 'ediff-merge-files 'ediff-files)) - (input (helm-dwim-target-directory)) - (presel (if helm-ff-transformer-show-only-basename - (helm-basename candidate) - (expand-file-name - (helm-basename candidate) - input)))) - (if (= (length marked) 2) - (funcall fun (car marked) (cadr marked)) - (funcall fun candidate (helm-read-file-name - (format prompt bname) - :initial-input input - :preselect presel))))) - -(defun helm-find-files-ediff-files (candidate) - (helm-find-files-ediff-files-1 candidate)) - -(defun helm-find-files-ediff-merge-files (candidate) - (helm-find-files-ediff-files-1 candidate 'merge)) - -(defun helm-find-files-grep (_candidate) - "Default action to grep files from `helm-find-files'." - (helm-do-grep-1 (helm-marked-candidates :with-wildcard t) - helm-current-prefix-arg)) - -(defun helm-ff-git-grep (_candidate) - "Default action to git-grep `helm-ff-default-directory'." - (helm-grep-git-1 helm-ff-default-directory helm-current-prefix-arg)) - -(defun helm-find-files-ag (_candidate) - (helm-grep-ag helm-ff-default-directory - helm-current-prefix-arg)) - -(defun helm-ff-zgrep (_candidate) - "Default action to zgrep files from `helm-find-files'." - (helm-ff-zgrep-1 (helm-marked-candidates :with-wildcard t) helm-current-prefix-arg)) - -(defun helm-ff-pdfgrep (_candidate) - "Default action to pdfgrep files from `helm-find-files'." - (let* ((recurse nil) - (cands (cl-loop for file in (helm-marked-candidates :with-wildcard t) - for dir = (file-directory-p file) - when dir do (setq recurse t) - when (or dir - (string= (file-name-extension file) "pdf") - (string= (file-name-extension file) "PDF")) - collect file))) - (when cands - (helm-do-pdfgrep-1 cands recurse)))) - -(defun helm-ff-etags-select (candidate) - "Default action to jump to etags from `helm-find-files'." - (when (get-buffer helm-action-buffer) - (kill-buffer helm-action-buffer)) - (let* ((source-name (assoc-default 'name (helm-get-current-source))) - (default-directory (if (string= source-name "Find Files") - helm-ff-default-directory - (file-name-directory candidate)))) - (helm-etags-select helm-current-prefix-arg))) - -;;; Eshell command on file -;; -(defvar eshell-command-aliases-list nil) -(defvar helm-eshell-command-on-file-input-history nil) -(defvar helm-eshell-command-on-file-history nil) -(cl-defun helm-find-files-eshell-command-on-file-1 (&optional map) - "Run `eshell-command' on CANDIDATE or marked candidates. -This is done possibly with an Eshell alias. If no alias found, -you can type in an Eshell command. - -Only aliases accepting a file as argument at the end of command -line are collected, i.e. aliases ending with \"$1\" or \"$*\". - -Basename of CANDIDATE can be a wild-card. -E.g. you can do \"eshell-command command *.el\" -Where \"*.el\" is the CANDIDATE. - -It is possible to do eshell-command command like this: \"command %s some more args\". - -If MAP is given run `eshell-command' on all marked files at once, -Otherwise, run `eshell-command' on each marked files. -In other terms, with a prefix arg do on the three marked files -\"foo\" \"bar\" \"baz\": - -\"eshell-command command foo bar baz\" - -otherwise do - -\"eshell-command command foo\" -\"eshell-command command bar\" -\"eshell-command command baz\" - -Note: -You have to setup some aliases in Eshell with the `alias' command -or by editing yourself the file `eshell-aliases-file' to make -this working." - (require 'helm-adaptive) - (require 'em-alias) (eshell-read-aliases-list) - (unless (> emacs-major-version 27) - ;; This advice has been merged in emacs-28. - (advice-add 'eshell-eval-command :override #'helm--advice-eshell-eval-command)) - (when (or eshell-command-aliases-list - (y-or-n-p "No eshell aliases found, run eshell-command without alias anyway? ")) - (let* ((cand-list (helm-marked-candidates :with-wildcard t)) - (default-directory (or helm-ff-default-directory - ;; If candidate is an url *-ff-default-directory is nil - ;; so keep value of default-directory. - default-directory)) - helm-display-source-at-screen-top - (helm-actions-inherit-frame-settings t) - helm-use-frame-when-more-than-two-windows - (command - (with-helm-display-marked-candidates - helm-marked-buffer-name - (helm-ff--count-and-collect-dups - (mapcar 'helm-basename cand-list)) - (with-helm-current-buffer - (helm-comp-read - "Command: " - (cl-loop with len = 0 - with aliases = - (cl-loop for (a c) in (eshell-read-aliases-list) - for len-key = (length a) - when - (and (string-match - "\\(\\$1\\|\\$\\*\\)" - c) - (not (member a helm-ff-eshell-unwanted-aliases))) - do (when (> len-key len) (setq len len-key)) - and collect (list a c)) - for (a c) in aliases - collect (cons - (concat (propertize - a 'face 'font-lock-keyword-face) - (make-string (1+ (- len (length a))) ? ) - c) - a)) - :fc-transformer #'helm-adaptive-sort - :buffer "*helm eshell on file*" - :name "Eshell command" - :mode-line - '("Eshell alias" - "C-h m: Help, \\[universal-argument]: Insert output at point") - :help-message 'helm-esh-help-message - :history 'helm-eshell-command-on-file-history - :raw-history t - :reverse-history helm-eshell-on-file-reverse-history - :input-history - 'helm-eshell-command-on-file-input-history - ;; Allow quoting when writing in minibuffer i.e. allow usage of - ;; \@ and \#. - :raw-candidate t)))) - (alias-value (car (assoc-default command eshell-command-aliases-list))) - cmd-line) - (if (or (equal helm-current-prefix-arg '(16)) - (equal map '(16))) - ;; Two time C-u from `helm-comp-read' mean print to current-buffer. - ;; i.e `eshell-command' will use this value. - (setq current-prefix-arg '(16)) - ;; Else reset the value of `current-prefix-arg' - ;; to avoid printing in current-buffer. - (setq current-prefix-arg nil)) - (if (and (or - ;; One prefix-arg have been passed before `helm-comp-read'. - ;; If map have been set with C-u C-u (value == '(16)) - ;; ignore it. - (and map (equal map '(4))) - ;; One C-u from `helm-comp-read'. - (equal helm-current-prefix-arg '(4)) - ;; An alias that finish with $* - (and alias-value - ;; If command is an alias be sure it accept - ;; more than one arg i.e $*. - (string-match "\\$\\*" alias-value))) - (cdr cand-list) - (and alias-value - ;; Command is an alias and accept only one arg. - (not (string-match "\\$1" alias-value)))) - - ;; Run eshell-command with ALL marked files as argument. - ;; This wont work on remote files, because tramp handlers depend - ;; on `default-directory' (limitation). - (let ((mapfiles (mapconcat 'shell-quote-argument cand-list " "))) - (if (string-match "%s" command) - (setq cmd-line (format command mapfiles)) ; See [1] - (setq cmd-line (format "%s %s" command mapfiles))) - (eshell-command cmd-line)) - - ;; Run eshell-command sequencially on EACH marked files. - ;; To work with tramp handler we have to call - ;; COMMAND on basename of each file, using - ;; its basedir as `default-directory'. - (unwind-protect - (progn - (cl-loop for f in cand-list - for n from 1 - for dir = (and (not (string-match helm--url-regexp f)) - (helm-basedir f)) - ;; We can use basename here as the command will run - ;; under default-directory. - ;; This allows running e.g. - ;; "tar czvf test.tar.gz %s/*" without creating - ;; an archive expanding from /home. - for file = (shell-quote-argument - (if (string-match helm--url-regexp f) - f (helm-basename f))) - ;; \@ => placeholder for file without extension. - ;; \# => placeholder for incremental number. - for fcmd = (helm-aand command - (replace-regexp-in-string - "\\\\#" (format "%03d" n) - it t t) - (replace-regexp-in-string - "\\\\@" - (regexp-quote - (file-name-sans-extension file)) - it t t)) - for com = (if (string-match "%s" fcmd) - ;; [1] This allows to enter other args AFTER filename - ;; i.e - (format fcmd file) - (format "%s %s" fcmd file)) - do (let ((default-directory (or dir default-directory))) - (eshell-command com)))) - ;; Async process continues running but doesn't need anymore - ;; the advice at this point (see the `eshell-eval-command' - ;; call in `eshell-command'). - (unless (> emacs-major-version 27) - (advice-remove 'eshell-eval-command #'helm--advice-eshell-eval-command))))))) - -(defun helm--advice-eshell-eval-command (command &optional input) - "Fix return value when command ends with \"&\"." - ;; Fix this emacs commit which is plain wrong as it returns - ;; either nil or an error (double because format spec doesn't - ;; always match specifier) whereas it should return either a - ;; single element (CAR DELIM) or DELIM itself if the car of - ;; DELIM is a process. - ;; This prevent running eshell-command async when needed i.e. when - ;; command ends with "&". - ;; - ;; UPDATE: This have now been merged in Emacs-28. - ;; - ;; 6b6f91b357f6fe2f1e0d72f046a1b8d8a2d6d8c3 - ;; Author: John Wiegley - ;; AuthorDate: Fri May 27 02:57:18 2005 +0000 - ;; Commit: John Wiegley - ;; CommitDate: Fri May 27 02:57:18 2005 +0000 - (if eshell-current-command - ;; we can just stick the new command at the end of the current - ;; one, and everything will happen as it should - (setcdr (last (cdr eshell-current-command)) - (list `(let ((here (and (eobp) (point)))) - ,(and input - `(insert-and-inherit ,(concat input "\n"))) - (if here - (eshell-update-markers here)) - (eshell-do-eval ',command)))) - (and eshell-debug-command - (with-current-buffer (get-buffer-create "*eshell last cmd*") - (erase-buffer) - (insert "command: \"" input "\"\n"))) - (setq eshell-current-command command) - (let* ((delim (catch 'eshell-incomplete - (eshell-resume-eval))) - (val (car-safe delim))) - ;; If the return value of `eshell-resume-eval' is wrapped in a - ;; list, it indicates that the command was run asynchronously. - ;; In that case, unwrap the value before checking the delimiter - ;; value. - (if (and val - (not (processp val)) - (not (eq val t))) - (error "Unmatched delimiter: %S" val) - ;; Eshell-command expect a list like () to know if the - ;; command should be async or not. - (or (and (processp val) delim) val))))) - -(defun helm-find-files-eshell-command-on-file (_candidate) - "Run `eshell-command' on CANDIDATE or marked candidates. -See `helm-find-files-eshell-command-on-file-1' for more info." - (helm-find-files-eshell-command-on-file-1 helm-current-prefix-arg)) - -(defun helm-ff--shell-interactive-buffer-p (buffer &optional mode) - (with-current-buffer buffer - (when (eq major-mode (or mode 'eshell-mode)) - (let ((next-prompt-fn (cl-case major-mode - (shell-mode #'comint-next-prompt) - (eshell-mode #'eshell-next-prompt) - (term-mode #'term-next-prompt)))) - (save-excursion - (goto-char (point-min)) - (funcall next-prompt-fn 1) - (null (eql (point) (point-min)))))))) - -(defun helm-ff-switch-to-shell (_candidate) - "Switch to a shell buffer and cd to `helm-ff-default-directory'. -Set your preferred shell mode in `helm-ff-preferred-shell-mode'. - -With a numeric prefix arg switch to numbered shell buffer, if no -prefix arg provided and more than one shell buffer exists, provide -completions on those buffers. If only one shell buffer exists, -switch to this one, if no shell buffer exists or if the numeric -prefix arg shell buffer doesn't exists, create it and switch to it." - ;; Reproduce the Emacs-25 behavior to be able to edit and send - ;; command in term buffer. - (let (term-char-mode-buffer-read-only ; Emacs-25 behavior. - term-char-mode-point-at-process-mark ; Emacs-25 behavior. - (cd-eshell (lambda () - (eshell/cd helm-ff-default-directory) - (eshell-reset))) - (cd-shell - (lambda () - (goto-char (point-max)) - (when (eq helm-ff-preferred-shell-mode 'shell-mode) - (comint-delete-input)) - (insert (format "cd %s" - (shell-quote-argument - (or (file-remote-p - helm-ff-default-directory 'localname) - helm-ff-default-directory)))) - (cl-case helm-ff-preferred-shell-mode - (shell-mode (comint-send-input)) - (term-mode (progn (term-char-mode) (term-send-input)))))) - (bufs (cl-loop for b in (mapcar 'buffer-name (buffer-list)) - when (helm-ff--shell-interactive-buffer-p - b helm-ff-preferred-shell-mode) - collect b))) - ;; Jump to a shell buffer or open a new session. - (helm-aif (and (not helm-current-prefix-arg) - (if (cdr bufs) - (helm-comp-read "Switch to shell buffer: " bufs - :must-match t) - (car bufs))) - ;; Display in same window by default to preserve the - ;; historical behaviour - (pop-to-buffer it '(display-buffer-same-window)) - (cl-case helm-ff-preferred-shell-mode - (eshell-mode - (eshell helm-current-prefix-arg)) - (shell-mode - (shell (helm-aif (and helm-current-prefix-arg - (prefix-numeric-value - helm-current-prefix-arg)) - (format "*shell<%s>*" it)))) - (term-mode - (progn - (ansi-term (getenv "SHELL") - (helm-aif (and helm-current-prefix-arg - (prefix-numeric-value - helm-current-prefix-arg)) - (format "*ansi-term<%s>*" it))) - (term-line-mode))))) - ;; Now cd into directory. - (helm-aif (and (memq major-mode '(shell-mode term-mode)) - (get-buffer-process (current-buffer))) - (accept-process-output it 0.1)) - (unless (helm-ff-shell-alive-p major-mode) - (funcall - (if (eq major-mode 'eshell-mode) cd-eshell cd-shell))))) - -(defun helm-ff-shell-alive-p (mode) - "Returns non nil when a process is running inside `shell-mode' buffer." - (cl-ecase mode - (shell-mode - (save-excursion - (comint-goto-process-mark) - (or (null comint-last-prompt) - (not (eql (point) - (marker-position (cdr comint-last-prompt))))))) - (eshell-mode - (get-buffer-process (current-buffer))) - (term-mode - (save-excursion - (goto-char (term-process-mark)) - (not (looking-back "\\$ " (- (point) 2))))))) - -(defun helm-ff-touch-files (_candidate) - "The touch files action for helm-find-files." - (let* ((files (helm-marked-candidates)) - (split (cl-loop for f in files - for spt = (unless helm-current-prefix-arg - (cons (helm-basedir f) - (split-string f ", ?"))) - if spt - append (cl-loop with dir = (car spt) - for ff in (cdr spt) - collect (expand-file-name ff dir)) - else collect f)) - (timestamp (helm-comp-read - "Timestamp (default Now): " - (cl-loop for f in split - for time = (file-attributes f) - for date = (and time - (format-time-string - "%Y-%m-%d %H:%M:%S" - (nth 5 time))) - when date - collect (cons (format "%s: %s" - (helm-basename f) date) - date)) - :default - (format-time-string "%Y-%m-%d %H:%M:%S" - (current-time)))) - (failures - (cl-loop with default-directory = helm-ff-default-directory - for f in split - for file = (or (file-remote-p f 'localname) f) - when (> (process-file - "touch" nil nil nil "-d" timestamp file) - 0) - collect f))) - (when failures - (message "Failed to touch *%s files:\n%s" - (length failures) - (mapconcat (lambda (f) (format "- %s\n" f)) failures ""))))) - -(defun helm-ff-encrypt-files (_candidate) - "Encrypt marked files." - (require 'epg) (require 'epa) (require 'helm-epa) - (let* ((mkds (helm-marked-candidates :with-wildcard t)) - (recipients (helm :sources (helm-build-sync-source - "Select recipient for encryption: " - :persistent-action 'ignore - :candidates 'helm-epa-get-key-list - :action (lambda (_candidate) - (helm-marked-candidates)) - :must-match t) - :buffer "*helm-ff epg keys*")) - (keys (and recipients (helm-epa-collect-keys-from-candidates recipients))) - (ids (and recipients (helm-epa-collect-id-from-candidates recipients)))) - (when recipients ; may be aborted by quit. - (cl-loop for f in mkds - do (epa-encrypt-file f recipients)) - (helm-epa-success-message (concat (format "%s File(s) encrypted" (length mkds)) - " with key(s):\n %s") - keys ids)))) - -(helm-make-command-from-action helm-ff-run-touch-files - "Used to interactively run touch file action from keyboard." - 'helm-ff-touch-files) - -(defun helm-ff-sort-by-size () - (interactive) - (let ((helm-ff-initial-sort-method 'size)) - (helm-force-update - (concat (regexp-quote (helm-get-selection - nil helm-ff-transformer-show-only-basename)) - "$")) - (message "Sorting by size"))) -(put 'helm-ff-sort-by-size 'helm-only t) - -(defun helm-ff-sort-by-newest () - (interactive) - (let ((helm-ff-initial-sort-method 'newest)) - (helm-force-update - (concat (regexp-quote (helm-get-selection - nil helm-ff-transformer-show-only-basename)) - "$")) - (message "Sorting by newest"))) -(put 'helm-ff-sort-by-newest 'helm-only t) - -(defun helm-ff-sort-by-ext () - (interactive) - (let ((helm-ff-initial-sort-method 'ext)) - (helm-force-update - (concat (regexp-quote (helm-get-selection - nil helm-ff-transformer-show-only-basename)) - "$")) - (message "Sorting by extensions"))) -(put 'helm-ff-sort-by-ext 'no-helm-mx t) - -(defun helm-ff-sort-alpha () - (interactive) - (let ((helm-ff-initial-sort-method nil)) - (helm-force-update - (concat (regexp-quote (helm-get-selection - nil helm-ff-transformer-show-only-basename)) - "$")) - (message "Sorting alphabetically"))) -(put 'helm-ff-sort-alpha 'helm-only t) - -(defun helm-ff-directories-only (candidates _source) - (if helm-ff--show-directories-only - (cl-loop for (d . r) in candidates - when (file-directory-p r) - ;; We can use this as long as this filtering function - ;; is called after `helm-ff-fct' otherwise candidates - ;; may not be cons cell at first call [1]. - collect (cons d r)) - candidates)) - -(defun helm-ff-files-only (candidates _source) - (if helm-ff--show-files-only - (cl-loop for (d . r) in candidates - unless (file-directory-p r) - ;; Same comment as in [1] above. - collect (cons d r)) - candidates)) - -(defun helm-ff-toggle-dirs-only () - "Show only directories in helm-find-files." - (interactive) - (with-helm-alive-p - (setq helm-ff--show-directories-only (not helm-ff--show-directories-only)) - (setq helm-ff--show-files-only nil) - (helm-update (helm-get-selection nil t)))) -(put 'helm-ff-toggle-dirs-only 'helm-only t) - -(defun helm-ff-toggle-files-only () - "Show only files in helm-find-files." - (interactive) - (with-helm-alive-p - (setq helm-ff--show-files-only (not helm-ff--show-files-only)) - (setq helm-ff--show-directories-only nil) - (helm-update (helm-get-selection nil t)))) -(put 'helm-ff-toggle-files-only 'helm-only t) - -(defun helm-ff-after-persistent-show-all () - (when helm-ff-reset-filters-on-update - (setq helm-ff--show-directories-only nil - helm-ff--show-files-only nil))) - -(defun helm-ff-serial-rename-action (method) - "Rename all marked files in `helm-ff-default-directory' with METHOD. -See `helm-ff-serial-rename-1'." - (let* ((helm--reading-passwd-or-string t) - (cands (helm-marked-candidates :with-wildcard t)) - (def-name (car cands)) - (name (helm-read-string "NewName: " - (replace-regexp-in-string - "[0-9]+$" "" - (helm-basename - def-name - (file-name-extension def-name))))) - (start (read-number "StartAtNumber: ")) - (extension (helm-read-string "Extension: " - (file-name-extension (car cands)))) - (dir (expand-file-name - (helm-read-file-name - "Serial Rename to directory: " - :initial-input - (expand-file-name helm-ff-default-directory) - :test 'file-directory-p - :must-match t))) - done) - (with-helm-display-marked-candidates - helm-marked-buffer-name (helm-ff--count-and-collect-dups cands) - (if (y-or-n-p - (format "Rename %s file(s) to <%s> like this ?\n%s " - (length cands) dir (format "%s <-> %s%s.%s" - (helm-basename (car cands)) - name start extension))) - (progn - (helm-ff-serial-rename-1 - dir cands name start extension :method method) - (setq done t) - (message nil)))) - (if done - (with-helm-current-buffer (helm-find-files-1 dir)) - (message "Operation aborted")))) - -(defun helm-ff-member-directory-p (file directory) - (let ((dir-file (expand-file-name - (file-name-as-directory (file-name-directory file)))) - (cur-dir (expand-file-name (file-name-as-directory directory)))) - (string= dir-file cur-dir))) - -(cl-defun helm-ff-serial-rename-1 - (directory collection new-name start-at-num extension &key (method 'rename)) - "Rename files in COLLECTION to DIRECTORY with the prefix name NEW-NAME. -Rename start at number START-AT-NUM - ex: prefixname-01.jpg. -EXTENSION is the file extension to use. In empty prompt, reuse -the original extension of file. -METHOD can be one of rename, copy or symlink. -Files will be renamed if they are files of current directory, -otherwise they will be treated with METHOD. -Default METHOD is rename." - ;; Maybe remove directories selected by error in collection. - (setq collection (cl-remove-if 'file-directory-p collection)) - (let* ((tmp-dir (file-name-as-directory - (concat (file-name-as-directory directory) - (symbol-name (cl-gensym "tmp"))))) - (fn (cl-case method - (copy 'copy-file) - (symlink 'make-symbolic-link) - (rename 'rename-file) - (t (error "Error: Unknown method %s" method))))) - (make-directory tmp-dir) - (unwind-protect - (progn - ;; Rename all files to tmp-dir with new-name. - ;; If files are not from start directory, use method - ;; to move files to tmp-dir. - (cl-loop for i in collection - for count from start-at-num - for fnum = (if (< count 10) "0%s" "%s") - for nname = (concat tmp-dir new-name (format fnum count) - (if (not (string= extension "")) - (format ".%s" (replace-regexp-in-string - "[.]" "" extension)) - (file-name-extension i 'dot))) - do (if (helm-ff-member-directory-p i directory) - (rename-file i nname) - (funcall fn i nname))) - ;; Now move all from tmp-dir to destination. - (cl-loop with dirlist = (directory-files - tmp-dir t directory-files-no-dot-files-regexp) - for f in dirlist do - (if (file-symlink-p f) - (make-symbolic-link (file-truename f) - (concat (file-name-as-directory directory) - (helm-basename f))) - (rename-file f directory)))) - (delete-directory tmp-dir t)))) - -(defun helm-ff-serial-rename (_candidate) - "Serial rename all marked files to `helm-ff-default-directory'. -Rename only file of current directory, and symlink files coming from -other directories. -See `helm-ff-serial-rename-1'." - (helm-ff-serial-rename-action 'rename)) - -(defun helm-ff-serial-rename-by-symlink (_candidate) - "Serial rename all marked files to `helm-ff-default-directory'. -Rename only file of current directory, and symlink files coming -from other directories. -See `helm-ff-serial-rename-1'." - (helm-ff-serial-rename-action 'symlink)) - -(defun helm-ff-serial-rename-by-copying (_candidate) - "Serial rename all marked files to `helm-ff-default-directory'. -Rename only file of current directory, and copy files coming from -other directories. -See `helm-ff-serial-rename-1'." - (helm-ff-serial-rename-action 'copy)) - -(defvar helm-ff-query-replace-fnames-history-from nil) -(defvar helm-ff-query-replace-fnames-history-to nil) -(defun helm-ff-query-replace-on-filenames (candidates) - "Query replace on filenames of CANDIDATES. -This doesn't replace inside the files, only modify filenames." - (with-helm-display-marked-candidates - helm-marked-buffer-name - (mapcar 'helm-basename candidates) - (let* ((regexp (read-string "Replace regexp on filename(s): " - nil 'helm-ff-query-replace-history-from - (helm-basename (car candidates)))) - (rep (read-string (format "Replace regexp `%s' with: " regexp) - nil 'helm-ff-query-replace-history-to))) - (cl-loop with query = "y" - with count = 0 - for old in candidates - for new = (helm-ff--query-replace-in-fname-set-new-name - old regexp rep count) - ;; If `regexp' is not matched in `old' - ;; `replace-regexp-in-string' will - ;; return `old' unmodified. - unless (string= old new) - do (progn - (when (file-exists-p new) - (setq new (concat (file-name-sans-extension new) - (format "(%s)" count) - (file-name-extension new t)))) - (unless (string= query "!") - (setq query (helm-read-answer (format - "Replace `%s' by `%s' [!,y,n,q,h]" - (helm-basename old) - (helm-basename new)) - '("y" "n" "!" "q") - #'helm-read-answer-default-help-fn))) - (when (string= query "q") - (cl-return (message "Operation aborted"))) - (unless (string= query "n") - (rename-file old new) - (cl-incf count))) - finally (message "%d Files renamed" count)))) - ;; This fix the emacs bug where "Emacs-Lisp:" is sent - ;; in minibuffer (not the echo area). - (sit-for 0.1) - (with-current-buffer (window-buffer (minibuffer-window)) - (delete-minibuffer-contents))) - -(defun helm-ff--query-replace-in-fname-set-new-name (old regexp rep count) - "Setup a new name for OLD replacing part matching REGEXP with REP. -COUNT is used for incrementing new name if needed." - (let (subexp target) - (concat (helm-basedir old) - (helm--replace-regexp-in-buffer-string - (save-match-data - (cond ((string= regexp "%.") - (setq subexp 1) - (helm-ff--prepare-str-with-regexp - (setq target (helm-basename old t)))) - ((string= regexp ".%") - (setq subexp 1) - (helm-ff--prepare-str-with-regexp - (setq target (file-name-extension old)))) - ((string= regexp "%") - (regexp-quote - (setq target (helm-basename old)))) - ((string-match "%:\\([0-9]+\\):\\([0-9]+\\)" regexp) - (setq subexp 1) - (let ((beg (match-string 1 regexp)) - (end (match-string 2 regexp)) - (str (helm-basename old))) - (setq target (substring str - (string-to-number beg) - (string-to-number end))) - (helm-ff--prepare-str-with-regexp str beg end))) - (t regexp))) - (save-match-data - (cond (;; Handle incremental - ;; replacement with \# in - ;; search and replace - ;; feature in placeholder \@. - (string-match "\\\\@/\\(.*\\)/\\(.*\\)/" rep) - (helm-aand (save-match-data - (replace-regexp-in-string - "\\\\#" (format "%03d" (1+ count)) - (match-string 2 rep))) - (replace-regexp-in-string - (match-string 1 rep) it target))) - ;; Incremental replacement - ;; before or after \@. - ((or (string-match "\\`\\\\#\\\\@\\'" rep) - (string-match "\\`\\\\@\\\\#\\'" rep)) - (replace-regexp-in-string - "\\\\#" (format "%03d" (1+ count)) - (replace-match target t t rep))) - ;; Simple incremental replacement. - ((or (string-match "\\`\\\\#" rep) - (string-match "\\\\#\\'" rep)) - (replace-match - (format "%03d" (1+ count)) t t rep)) - ;; Substring replacement in placeholder. - ((string-match - "\\\\@:\\([0-9]*\\):\\([0-9]*\\)" rep) - (replace-match (substring - target - (string-to-number - (match-string 1 rep)) - (helm-acase (match-string 2 rep) - ((guard* (string= it "")) - (length target)) - (t (string-to-number it)))) - t t rep)) - ;; Simple replacement by placeholder. - ((string-match "\\\\@" rep) - (replace-match target t t rep)) - ;; Replacement with - ;; upcase, downcase or - ;; capitalized text. - ((string= rep "%u") #'upcase) - ((string= rep "%d") #'downcase) - ((string= rep "%c") #'capitalize) - ;; Simple replacement with - ;; whole replacement regexp. - (t rep))) - (helm-basename old) t nil subexp)))) - -(defun helm-ff--prepare-str-with-regexp (str &optional rep1 rep2) - ;; This is used in `helm-ff-query-replace-on-filenames' to prepare - ;; STR when REGEXP is specified as substring e.g %:1:3 in this case - ;; substring from 1 to 3 in STR will be enclosed with parenthesis to - ;; match this substring as a subexp e.g %:1:3 on string "emacs" will - ;; be replaced by "e\\(ma\\)cs" using subexp 1 like this: - ;; (helm--replace-regexp-in-buffer-string "e\\(ma\\)cs" "fo" "emacs" nil t 1) - ;; => "efocs" - ;; ^^ - ;; Where "1" and "3" will be strings extracted with match-string - ;; from regexp and refered respectively in this function as REP1 and - ;; REP2. - (let* ((from (or (and rep1 (string-to-number rep1)) 0)) - (to (or (and rep2 (string-to-number rep2)) (length str))) - (subexp (concat "\\(" (regexp-quote (substring str from to)) "\\)")) - (before-str (unless (zerop from) - (regexp-quote (substring str 0 from)))) - (after-str (unless (= to (length str)) - (regexp-quote (substring str to (length str)))))) - (concat before-str subexp after-str))) - -;; The action. -(defun helm-ff-query-replace-fnames-on-marked (_candidate) - (let ((marked (helm-marked-candidates :with-wildcard t))) - (helm-ff-query-replace-on-filenames marked))) - -;; The command for `helm-find-files-map'. -(helm-make-command-from-action helm-ff-run-query-replace-fnames-on-marked - "Run query-replace on filenames from HFF." - 'helm-ff-query-replace-fnames-on-marked) - -(defun helm-ff-query-replace (_candidate) - (let ((bufs (cl-loop for f in (helm-marked-candidates :with-wildcard t) - collect (buffer-name (find-file-noselect f))))) - (helm-buffer-query-replace-1 nil bufs))) - -(helm-make-command-from-action helm-ff-run-query-replace - "Run query-replace from HFF." - 'helm-ff-query-replace) - -(defun helm-ff-query-replace-regexp (_candidate) - (let ((bufs (cl-loop for f in (helm-marked-candidates :with-wildcard t) - collect (buffer-name (find-file-noselect f))))) - (helm-buffer-query-replace-1 'regexp bufs))) - -(helm-make-command-from-action helm-ff-run-query-replace-regexp - "Run query-replace regexp from HFF." - 'helm-ff-query-replace-regexp) - -(defun helm-ff-toggle-auto-update () - (if helm-ff--deleting-char-backward - (progn - (message "[Auto expansion disabled]") - (sit-for 1) (message nil) - (setq helm-ff--auto-update-state nil)) - (setq helm-ff-auto-update-flag (not helm-ff-auto-update-flag)) - (setq helm-ff--auto-update-state helm-ff-auto-update-flag) - (message "[Auto expansion %s]" - (if helm-ff-auto-update-flag "enabled" "disabled")))) - -(defun helm-ff-run-toggle-auto-update () - (interactive) - (with-helm-alive-p - (helm-ff-toggle-auto-update))) -(put 'helm-ff-run-toggle-auto-update 'helm-only t) - -(defun helm-ff-delete-char-backward () - "Go up one level or disable HFF auto update and delete char backward. - -Going up one level works only when pattern is a directory endings -with \"/\", otherwise this command deletes char backward. - -Going up one level can be disabled if necessary by deleting \"/\" -at end of pattern using \\\\[backward-char] and -\\[helm-delete-minibuffer-contents]." - (interactive) - (with-helm-alive-p - (if (and helm-ff-DEL-up-one-level-maybe - (string-match "/\\'" helm-pattern) - (file-directory-p helm-pattern)) - (call-interactively 'helm-find-files-up-one-level) - (setq helm-ff-auto-update-flag nil) - (setq helm-ff--deleting-char-backward t) - (call-interactively - (lookup-key (current-global-map) - (read-kbd-macro "DEL")))))) -(put 'helm-ff-delete-char-backward 'helm-only t) - -(defun helm-ff-delete-char-backward--exit-fn () - (setq helm-ff-auto-update-flag helm-ff--auto-update-state) - (setq helm-ff--deleting-char-backward nil)) - -(defvar helm-ff--RET-disabled nil) -(defun helm-ff-RET-1 () - "Used for RET action in `helm-find-files' and `helm-read-file-name'. -See `helm-ff-RET' for details." - (catch 'must-match - (let ((sel (helm-get-selection)) - ;; Ensure `file-directory-p' works on remote files. - non-essential) - ;; `helm--minibuffer-completing-file-name' is non nil that's mean we are - ;; in `helm-read-file-name'. - (if (and helm--minibuffer-completing-file-name (null sel)) - (throw 'must-match (minibuffer-message "[No match]")) - (cl-assert sel nil "Trying to exit with no candidates")) - (if (and (or (file-directory-p sel) - (helm-ff--invalid-tramp-name-p sel)) - ;; Allows exiting with default action when a prefix arg - ;; is specified. - (null current-prefix-arg) - (null helm-ff--RET-disabled) - (or (and (file-remote-p sel) - (string= "." (helm-basename sel)) - (string-match-p "\\`[/].*:.*:\\'" - helm-pattern)) - (not (string= "." (helm-basename sel))))) - (helm-execute-persistent-action) - (helm-maybe-exit-minibuffer))))) - -(defun helm-ff-RET () - "Default action for RET in `helm-find-files'. - -Behave differently depending on `helm-selection': - -- candidate basename is \".\" => open it in dired. -- candidate is a directory => expand it. -- candidate is a file => open it." - (interactive) - (helm-ff-RET-1)) -(put 'helm-ff-RET 'helm-only t) - -(defun helm-ff-TAB-1 (&optional force-menu) - "Used for TAB action in `helm-find-files'." - (let ((sel (helm-get-selection))) - (if (and (null force-menu) - (file-directory-p sel) - (not (string= "." (helm-basename sel)))) - (helm-execute-persistent-action) - (helm-select-action)))) - -(defun helm-ff-TAB (arg) - "Default action for TAB in `helm-find-files'. - -Behave differently depending on `helm-selection': - -- candidate basename is \".\" => open the action menu. -- candidate is a directory => expand it. -- candidate is a file => open action menu. - -Called with a prefix arg open menu unconditionally." - (interactive "P") - (helm-ff-TAB-1 arg)) -(put 'helm-ff-TAB 'helm-only t) - -(helm-make-command-from-action helm-ff-run-grep - "Run Grep action from `helm-source-find-files'." - 'helm-find-files-grep) - -(helm-make-command-from-action helm-ff-run-git-grep - "Run git-grep action from `helm-source-find-files'." - 'helm-ff-git-grep) - -(helm-make-command-from-action helm-ff-run-grep-ag - "Run grep AG action from `helm-source-find-files'." - 'helm-find-files-ag) - -(helm-make-command-from-action helm-ff-run-pdfgrep - "Run Pdfgrep action from `helm-source-find-files'." - 'helm-ff-pdfgrep) - -(helm-make-command-from-action helm-ff-run-zgrep - "Run Grep action from `helm-source-find-files'." - 'helm-ff-zgrep) - -(helm-make-command-from-action helm-ff-run-copy-file - "Run Copy file action from `helm-source-find-files'." - 'helm-find-files-copy) - -(helm-make-command-from-action helm-ff-run-rsync-file - "Run Rsync file action from `helm-source-find-files'." - 'helm-find-files-rsync) - -(helm-make-command-from-action helm-ff-run-rename-file - "Run Rename file action from `helm-source-find-files'." - 'helm-find-files-rename) - -(helm-make-command-from-action helm-ff-run-byte-compile-file - "Run Byte compile file action from `helm-source-find-files'." - 'helm-find-files-byte-compile) - -(helm-make-command-from-action helm-ff-run-load-file - "Run Load file action from `helm-source-find-files'." - 'helm-find-files-load-files) - -(helm-make-command-from-action helm-ff-run-eshell-command-on-file - "Run eshell command on file action from `helm-source-find-files'." - 'helm-find-files-eshell-command-on-file) - -(helm-make-command-from-action helm-ff-run-ediff-file - "Run Ediff file action from `helm-source-find-files'." - 'helm-find-files-ediff-files) - -(helm-make-command-from-action helm-ff-run-ediff-merge-file - "Run Ediff merge file action from `helm-source-find-files'." - 'helm-find-files-ediff-merge-files) - -(helm-make-command-from-action helm-ff-run-symlink-file - "Run Symlink file action from `helm-source-find-files'." - 'helm-find-files-symlink) - -(helm-make-command-from-action helm-ff-run-relsymlink-file - "Run Symlink file action from `helm-source-find-files'." - 'helm-find-files-relsymlink) - -(helm-make-command-from-action helm-ff-run-hardlink-file - "Run Hardlink file action from `helm-source-find-files'." - 'helm-find-files-hardlink) - -(helm-make-command-from-action helm-ff-run-compress-to - "Run Compress to archive action from `helm-source-find-files'." - 'helm-find-files-compress-to) - -(helm-make-command-from-action helm-ff-run-chmod - "Run chmod action from `helm-source-find-files'." - 'helm-ff-chmod) - -(defun helm-ff-delete-files (candidate) - "Delete files default action." - (funcall helm-ff-delete-files-function candidate)) - -(helm-make-command-from-action helm-ff-run-delete-file - "Run Delete file action from `helm-source-find-files'." - 'helm-ff-delete-files) - -(helm-make-command-from-action helm-ff-run-complete-fn-at-point - "Run complete file name action from `helm-source-find-files'." - 'helm-insert-file-name-completion-at-point) - -(helm-make-command-from-action helm-ff-run-switch-to-shell - "Run switch to eshell action from `helm-source-find-files'." - 'helm-ff-switch-to-shell) - -(helm-make-command-from-action helm-ff-run-switch-other-window - "Run switch to other window action from `helm-source-find-files'. -When a prefix arg is provided, split is done vertically." - 'helm-find-files-other-window) - -(helm-make-command-from-action helm-ff-run-switch-other-frame - "Run switch to other frame action from `helm-source-find-files'." - 'find-file-other-frame) - -(helm-make-command-from-action helm-ff-run-open-file-externally - "Run open file externally command action from `helm-source-find-files'." - 'helm-open-file-externally) - -(helm-make-command-from-action helm-ff-run-open-file-with-default-tool - "Run open file externally command action from `helm-source-find-files'." - 'helm-open-file-with-default-tool) - -(defun helm-ff-locate (candidate) - "Locate action function for `helm-find-files'." - (helm-locate-set-command) - (let ((default (concat (helm-basename - (expand-file-name - candidate - helm-ff-default-directory)) - (unless (or - ;; "-b" is already added when fuzzy matching. - helm-locate-fuzzy-match - ;; The locate '-b' option doesn't exists - ;; in everything (es). - (and (eq system-type 'windows-nt) - (string-match "^es" helm-locate-command))) - " -b")))) - (helm-locate-1 helm-current-prefix-arg nil 'from-ff default))) - -(helm-make-command-from-action helm-ff-run-locate - "Run locate action from `helm-source-find-files'." - 'helm-ff-locate) - -(defun helm-files-insert-as-org-link (candidate) - (insert (format "[[%s][]]" candidate)) - (goto-char (- (point) 2))) - -(helm-make-command-from-action helm-ff-run-insert-org-link - "Run insert org link from HFF." - 'helm-files-insert-as-org-link) - -(helm-make-command-from-action helm-ff-run-find-file-as-root - "Run find file as root from HFF." - 'helm-find-file-as-root) - -(helm-make-command-from-action helm-ff-run-find-alternate-file - "Run `find-alternate-file' from HFF." - 'find-alternate-file) - -(helm-make-command-from-action helm-ff-run-mail-attach-files - "Run mail attach files command action from `helm-source-find-files'." - 'helm-ff-mail-attach-files) - -(helm-make-command-from-action helm-ff-run-etags - "Run Etags command action from `helm-source-find-files'." - 'helm-ff-etags-select) - -(defvar lpr-printer-switch) -(defun helm-ff-print (_candidate) - "Print marked files. - -You may to set in order variables `lpr-command',`lpr-switches' -and/or `printer-name', but with no settings Helm should detect -your printer(s) and print with the default `lpr' settings. - -NOTE: DO NOT set the \"-P\" flag in `lpr-switches'. If you really -have to modify this, do it in `lpr-printer-switch'. - -Same as `dired-do-print' but for Helm." - (require 'lpr) - (when (or helm-current-prefix-arg - (not helm-ff-printer-list)) - (setq helm-ff-printer-list - (helm-ff-find-printers))) - (let* ((file-list (helm-marked-candidates :with-wildcard t)) - (len (length file-list)) - (printer-name (if helm-ff-printer-list - (helm-comp-read - "Printer: " helm-ff-printer-list) - printer-name)) - (lpr-switches - (if (and (stringp printer-name) - (string< "" printer-name)) - (cons (concat lpr-printer-switch " " printer-name) - lpr-switches) - lpr-switches)) - (command (helm-read-string - (format "Print *%s File(s):\n%s with: " - len - (mapconcat - (lambda (f) (format "- %s\n" f)) - file-list "")) - (when (and lpr-command lpr-switches) - (mapconcat 'identity - (cons lpr-command - (if (stringp lpr-switches) - (list lpr-switches) - lpr-switches)) - " ")))) - (file-args (mapconcat #'shell-quote-argument - file-list " ")) - (cmd-line (concat command " " file-args))) - (if command - (start-process-shell-command "helm-print" nil cmd-line) - (error "Error: Please verify your printer settings in Emacs.")))) - -(helm-make-command-from-action helm-ff-run-print-file - "Run Print file action from `helm-source-find-files'." - 'helm-ff-print) - -(defun helm-ff-checksum (file) - "Calculate the checksum of FILE. -The checksum is copied to `kill-ring'. -Checksum is calculated with the md5sum, sha1sum, sha224sum, -sha256sum, sha384sum and sha512sum when available, otherwise the -Emacs function `secure-hash' is used but it is slow and may crash -Emacs and even the whole system as it eats all memory." - (cl-assert (file-regular-p file) - nil "`%s' is not a regular file" file) - (let* ((algo (intern (helm-comp-read - "Algorithm: " - '(md5 sha1 sha224 sha256 sha384 sha512)))) - (cmd (concat (symbol-name algo) "sum")) - (bn (helm-basename file)) - proc) - (message "Calculating %s checksum for %s..." algo bn) - (if (executable-find cmd) - (progn - (set-process-filter - (setq proc (start-file-process cmd nil cmd "-b" file)) - (lambda (_process output) - (when output (kill-new output)))) - (set-process-sentinel - proc - `(lambda (_process event) - (when (string= event "finished\n") - (message "Calculating %s checksum for `%s' done and copied to kill-ring" - ,(symbol-name algo) ,bn))))) - (async-let ((sum (with-temp-buffer - (insert-file-contents-literally file) - (secure-hash algo (current-buffer))))) - (kill-new sum) - (message "Calculating %s checksum for `%s' done and copied to kill-ring" - algo bn))))) - -(defun helm-ff-toggle-basename () - (with-helm-buffer - (setq helm-ff-transformer-show-only-basename - (not helm-ff-transformer-show-only-basename)) - (let* ((cand (helm-get-selection)) - (target (if helm-ff-transformer-show-only-basename - (helm-basename cand) cand))) - (helm-force-update - (format helm-ff-last-expanded-candidate-regexp - (regexp-quote target)))))) - -(defun helm-ff-run-toggle-basename () - (interactive) - (with-helm-alive-p - (unless (helm-empty-source-p) - (helm-ff-toggle-basename)))) -(put 'helm-ff-run-toggle-basename 'helm-only t) - -(defun helm-ff-mark-similar-files-1 () - "Mark similar files. -Files are considered similar if they have the same face and same -extension." - (with-helm-window - (let* ((src (helm-get-current-source)) - (file (helm-get-selection nil 'withprop src)) - (face (get-text-property (min 2 (length file)) 'face file)) - (ext (file-name-extension file))) - (helm-map-candidates-in-source src - (lambda (_cand) (helm-make-visible-mark)) - (lambda (cand) - (and (not (helm-this-visible-mark)) - (eq (get-text-property (min 2 (length cand)) 'face cand) face) - (equal ext (file-name-extension cand))))) - (helm-mark-current-line) - (helm-display-mode-line src t) - (when helm-marked-candidates - (message "%s candidates marked" (length helm-marked-candidates)) - (set-window-margins (selected-window) 1))))) - -(defun helm-ff-mark-similar-files () - "Mark all files similar to selection." - (interactive) - (with-helm-alive-p - (let ((marked (helm-marked-candidates))) - (if (and (>= (length marked) 1) - (with-helm-window helm-visible-mark-overlays)) - (helm-unmark-all) - (helm-ff-mark-similar-files-1))))) -(put 'helm-ff-mark-similar-files 'helm-only t) - -(defun helm-reduce-file-name-1 (fname level) - ;; This is the old version of helm-reduce-file-name, we still use it - ;; with ftp fnames as expand-file-name is not working as expected - ;; with ftp fnames (emacs bug). - (cl-loop with result - with iter = (helm-iter-reduce-fname (expand-file-name fname)) - repeat level do (setq result (helm-iter-next iter)) - finally return (or result (expand-file-name "/")))) - -(defun helm-reduce-file-name-2 (fname level) - ;; This version comes from Bug#2004 (UNC paths) and should fix - ;; it. It works with local files and remote files as well but not - ;; with ftp, see helm-reduce-file-name-1. - (while (> level 0) - (unless (or (string= fname "/") - (string= (file-remote-p fname 'localname) "/")) - (setq fname (expand-file-name - (concat (expand-file-name fname) "/../")))) - (setq level (1- level))) - fname) - -(defun helm-reduce-file-name (fname level) - "Reduce FNAME by number LEVEL from end." - (if (helm-aand (file-remote-p fname 'method) - (string= it "ftp")) - (helm-reduce-file-name-1 fname level) - (helm-reduce-file-name-2 fname level))) - -(defun helm-iter-reduce-fname (fname) - "Yield FNAME reduced by one level at each call." - (let ((split (split-string fname "/" t))) - (unless (or (null split) - (string-match "\\`\\(~\\|[[:alpha:]]:\\)" (car split))) - (setq split (cons "/" split))) - (lambda () - (when (and split (cdr split)) - (cl-loop for i in (setq split (butlast split)) - concat (if (string= i "/") i (concat i "/"))))))) - -(defvar helm-find-files--level-tree nil) -(defvar helm-find-files--level-tree-iterator nil) -(defun helm-find-files-up-one-level (arg) - "Go up one level like unix command `cd ..'. -If prefix numeric arg is given go ARG level up." - (interactive "p") - (with-helm-alive-p - (helm-ff-after-persistent-show-all) - (let ((src (helm-get-current-source))) - (when (and (helm-file-completion-source-p src) - (not (helm-ff--invalid-tramp-name-p))) - (with-helm-window - (when (helm-follow-mode-p) - (helm-follow-mode -1) (message nil))) - ;; When going up one level we want to be at the line - ;; corresponding to actual directory, so store this info - ;; in `helm-ff-last-expanded'. - (let ((cur-cand (helm-get-selection nil nil src)) - (new-pattern (helm-reduce-file-name helm-pattern arg))) - ;; Ensure visibility on all candidates for preselection. - (unless (helm-empty-source-p) - ;; We may have an empty source in read-file-name when a - ;; predicate is used e.g. images and the default is a non - ;; file image. - (helm-set-attr 'candidate-number-limit - (if helm-ff-dynamic-candidate-number-limit - (max (gethash new-pattern - helm-ff--directory-files-length - helm-ff-candidate-number-limit) - helm-ff-candidate-number-limit) - helm-ff-candidate-number-limit))) - (cond ((file-directory-p helm-pattern) - (setq helm-ff-last-expanded helm-ff-default-directory)) - ((file-exists-p helm-pattern) - (setq helm-ff-last-expanded helm-pattern)) - ((and cur-cand (file-exists-p cur-cand)) - (setq helm-ff-last-expanded cur-cand))) - (unless helm-find-files--level-tree - (setq helm-find-files--level-tree - (cons helm-ff-default-directory - helm-find-files--level-tree))) - (setq helm-find-files--level-tree-iterator nil) - (push new-pattern helm-find-files--level-tree) - (setq helm-ff--show-thumbnails - (member new-pattern helm-ff--thumbnailed-directories)) - (helm-set-pattern new-pattern helm-suspend-update-flag) - (with-helm-after-update-hook (helm-ff-retrieve-last-expanded))))))) -(put 'helm-find-files-up-one-level 'helm-only t) - -(defun helm-find-files-down-last-level () - "Retrieve previous paths reached by `C-l' in helm-find-files." - (interactive) - (with-helm-alive-p - (when (and (helm-file-completion-source-p) - (not (helm-ff--invalid-tramp-name-p))) - (unless helm-find-files--level-tree-iterator - (setq helm-find-files--level-tree-iterator - (helm-iter-list (cdr helm-find-files--level-tree)))) - (setq helm-find-files--level-tree nil) - (helm-aif (helm-iter-next helm-find-files--level-tree-iterator) - (progn - (setq helm-ff--show-thumbnails - (member it helm-ff--thumbnailed-directories)) - (helm-set-pattern it)) - (setq helm-find-files--level-tree-iterator nil))))) -(put 'helm-find-files-down-last-level 'helm-only t) - -(defun helm-find-files--reset-level-tree () - (setq helm-find-files--level-tree-iterator nil - helm-find-files--level-tree nil)) - -(add-hook 'helm-cleanup-hook 'helm-find-files--reset-level-tree) -(add-hook 'post-self-insert-hook 'helm-find-files--reset-level-tree) -(add-hook 'helm-after-persistent-action-hook 'helm-find-files--reset-level-tree) - -(defun helm-ff-retrieve-last-expanded () - "Move overlay to last visited directory `helm-ff-last-expanded'. -This happen after using `helm-find-files-up-one-level', or -hitting C-j on \"..\"." - (when helm-ff-last-expanded - (let ((presel (if helm-ff-transformer-show-only-basename - (helm-basename - (directory-file-name helm-ff-last-expanded)) - (directory-file-name helm-ff-last-expanded)))) - (with-helm-window - (when (re-search-forward - (format helm-ff-last-expanded-candidate-regexp - ;; The space at eol may contain a display property - ;; e.g. "-> symlink truename". - (concat (regexp-quote presel) " ?$")) - nil t) - (forward-line 0) - (helm-mark-current-line))) - (setq helm-ff-last-expanded nil)))) - -(defun helm-ff-undo () - "Undo minibuffer in `helm-find-files'. -Ensure disabling `helm-ff-auto-update-flag' before undoing." - (interactive) - (let ((old--flag helm-ff-auto-update-flag)) - (setq helm-ff-auto-update-flag nil) - (setq helm-ff--auto-update-state nil) - (unwind-protect - (progn - (undo) - (helm-check-minibuffer-input)) - (setq helm-ff-auto-update-flag old--flag) - (setq helm-ff--auto-update-state helm-ff-auto-update-flag)))) -(put 'helm-ff-undo 'helm-only t) - -;;; Auto-update - helm-find-files auto expansion of directories. -;; -;; -(defun helm-ff-update-when-only-one-matched () - "Expand to directory when sole completion. -When only one candidate is remaining and it is a directory, -expand to this directory. -This happen only when `helm-ff-auto-update-flag' is non-nil or -when `helm-pattern' is equal to \"~/\"." - (let ((src (helm-get-current-source))) - (when (and (helm-file-completion-source-p src) - (not (get-buffer-window helm-action-buffer 'visible)) - (not (helm-ff--invalid-tramp-name-p)) - (not (string-match-p "\\`[.]\\{2\\}[^/]+" - (helm-basename helm-pattern)))) - (with-helm-buffer - (let* ((history-p (string= (assoc-default 'name src) - "Read File Name History")) - (pat (helm-ff-set-pattern helm-pattern)) - ;; Try to shut up persistent tramp error with adb method when - ;; adding tilde to path. - (tramp-tolerate-tilde (equal (file-remote-p pat 'method) - tramp-adb-method)) - (completed-p (helm-aand (expand-file-name - (substitute-in-file-name pat)) - (string= (file-name-as-directory it) - helm-ff-default-directory))) - (candnum (helm-get-candidate-number)) - (lt2-p (and (<= candnum 2) - (>= (string-width (helm-basename helm-pattern)) 2))) - (cur-cand (helm-get-selection nil nil src)) - expand-to) - (when (and (or (and helm-ff-auto-update-flag - (null helm-ff--deleting-char-backward) - ;; Bug#295 - ;; File predicates are returning t - ;; with paths like //home/foo. - ;; So check it is not the case by regexp - ;; to allow user to do C-a / to start e.g - ;; entering a tramp method e.g /sudo::. - (not (string-match "\\`//" helm-pattern)) - (not (eq last-command 'helm-yank-text-at-point))) - ;; Fix Bug#542. - (string= helm-pattern "~/") - ;; Only one remaining directory, expand it. - (and (= candnum 1) - helm-ff--auto-update-state - (file-accessible-directory-p pat) - (null helm-ff--deleting-char-backward))) - (or - ;; Only one candidate remaining - ;; and at least 2 char in basename. - lt2-p - ;; Already completed. - completed-p) - (not history-p) ; Don't try to auto complete in history. - (stringp cur-cand) - (file-accessible-directory-p cur-cand)) - (if (and (not (helm-ff-dot-file-p cur-cand)) ; [1] - ;; Maybe we are here because completed-p is true - ;; but check this again to be sure. (Windows fix) - (<= candnum 2)) ; [2] - ;; If after going to next line the candidate - ;; is not one of "." or ".." [1] - ;; and only one candidate is remaining [2], - ;; assume candidate is a new directory to expand, and do it. - (progn - (setq expand-to (file-name-as-directory - (substring-no-properties cur-cand))) - (setq helm-ff--show-thumbnails - (member expand-to helm-ff--thumbnailed-directories)) - (helm-set-pattern expand-to) - ;; Reset flags to show all when changing dir. - (helm-ff-after-persistent-show-all)) - ;; The candidate is one of "." or ".." - ;; that mean we have entered the last letter of the directory name - ;; in prompt, so expansion is already done, just add the "/" at end - ;; of name unless helm-pattern ends with "." - ;; (i.e we are writing something starting with ".") - (unless (string-match "\\`.*[.]\\{1\\}\\'" helm-pattern) - ;; Need to expand-file-name to avoid e.g /ssh:host:./ in prompt. - (setq expand-to (expand-file-name (file-name-as-directory helm-pattern))) - (setq helm-ff--show-thumbnails - (member expand-to helm-ff--thumbnailed-directories)) - (helm-set-pattern expand-to))) - ;; When typing pattern in minibuffer, helm - ;; expand very fast to a directory matching pattern and - ;; don't let undo the time to set a boundary, the result - ;; is when e.g. going to root with "//" and undoing, undo - ;; doesn't undo to previous input. One fix for this is to - ;; advice `undo-auto--boundary-ensure-timer' so that it is - ;; possible to modify its delay (use a value of 1s for - ;; helm), a second fix is to run directly here `undo-boundary' - ;; inside a timer. - (run-at-time helm-input-idle-delay nil #'undo-boundary) - (helm-check-minibuffer-input))))))) - -(defun helm-ff-auto-expand-to-home-or-root () - "Allow expanding to $HOME or \"/\" or text yanked after minibuffer input." - (when (and (helm-file-completion-source-p) - (with-current-buffer (window-buffer (minibuffer-window)) (eolp)) - (not (string-match helm-ff-url-regexp helm-pattern))) - (cond ((and (not (file-remote-p helm-pattern)) - (null (file-exists-p helm-pattern)) - (string-match-p - "\\`\\([.]\\)\\{2\\}[^/]+" - (helm-basename helm-pattern)) - (string-match-p "/\\'" helm-pattern)) - (helm-ff-recursive-dirs helm-pattern) - (helm-ff--maybe-set-pattern-and-update)) - ((string-match - "\\(?:\\`~/\\)\\|/?\\$.*/\\|/\\./\\|/\\.\\./\\|/~.*/\\|//\\|\\(/[[:alpha:]]:/\\)" - helm-pattern) - (let* ((match (match-string 0 helm-pattern)) - (input (cond ((string= match "/./") - (expand-file-name default-directory)) - ((string= helm-pattern "/../") "/") - ((string-match-p "\\`/\\$" match) - (let ((sub (substitute-in-file-name match))) - (if (file-directory-p sub) - sub (replace-regexp-in-string "/\\'" "" sub)))) - (t (helm-ff--expand-substitued-pattern helm-pattern))))) - ;; `file-directory-p' returns t on "/home/me/." (Bug#1844). - (if (and (file-directory-p input) - (not (string-match-p "[^.]\\.\\'" input))) - (progn - (setq helm-ff-default-directory - (setq input (file-name-as-directory input))) - ;; When changing directory ensure to show all. - (helm-ff-after-persistent-show-all)) - (setq helm-ff-default-directory (file-name-as-directory - (file-name-directory input)))) - (helm-ff--maybe-set-pattern-and-update input))) - ((string-match "\\`/\\(-\\):.*" helm-pattern) - (helm-ff--maybe-set-pattern-and-update - (replace-match tramp-default-method t t helm-pattern 1)))))) - -(defun helm-ff--maybe-set-pattern-and-update (&optional str) - (with-helm-window - (when str (helm-set-pattern str)) - (helm-check-minibuffer-input))) - -(defun helm-ff--expand-file-name-no-dot (name &optional directory) - "Prevent expanding \"/home/user/.\" to \"/home/user\"." - ;; Bug#1844 - If user enter "~/." to type an hidden filename - ;; don't expand to /home/him e.g. - ;; (expand-file-name "~/.") =>"/home/thierry" - ;; (helm-ff--expand-substitued-pattern "~/.") =>"/home/thierry/." - (concat (expand-file-name name directory) - (and (string-match "[^.]\\.\\'" name) "/."))) - -(defun helm-ff--expand-substitued-pattern (pattern) - ;; [Windows] On UNC paths "/" expand to current machine, - ;; 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 Bug#2004. - (expand-fn (if directory - #'expand-file-name - #'helm-ff--expand-file-name-no-dot))) - ;; Fix Bug#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))) - -(defun helm-substitute-in-filename (fname) - "Substitute all parts of FNAME from start up to \"~/\" or \"/\". -On windows system substitute from start up to \"/[[:lower:]]:/\". -This function is needed for `helm-ff-auto-expand-to-home-or-root' -and should be used carefully elsewhere, or not at all, using -`substitute-in-file-name' instead." - (cond ((and helm--url-regexp - (string-match-p helm--url-regexp fname)) - fname) - ((and (file-remote-p fname) - helm-substitute-in-filename-stay-on-remote) - (let ((sub (substitute-in-file-name fname))) - (if (file-directory-p sub) - sub (replace-regexp-in-string "/\\'" "" sub)))) - (t - (with-temp-buffer - (insert fname) - (goto-char (point-min)) - (when (memq system-type '(windows-nt ms-dos)) - (skip-chars-forward "/")) ;; Avoid infloop in UNC paths Bug#424 - (if (re-search-forward "~.*/?\\|//\\|/[[:alpha:]]:/" nil t) - (let ((match (match-string 0))) - (goto-char (if (or (string= match "//") - (string-match-p "/[[:alpha:]]:/" match)) - (1+ (match-beginning 0)) - (match-beginning 0))) - (buffer-substring-no-properties (point) (pos-eol))) - fname))))) - -(defun helm-point-file-in-dired (file) - "Put point on filename FILE in dired buffer." - (unless (and helm--url-regexp - (string-match-p helm--url-regexp file)) - (let ((target (expand-file-name (helm-substitute-in-filename file)))) - (dired (file-name-directory target)) - (dired-goto-file target)))) - -(defun helm-marked-files-in-dired (_candidate) - "Open a dired buffer with only marked files. - -With a prefix arg toggle dired buffer to wdired mode. - -Note: This function works only in Emacs-29+ because Wdired doesn't support -editing absolute fnames in previous Emacs versions." - (let* ((marked (helm-marked-candidates :with-wildcard t)) - (current (car marked))) - (unless (and helm--url-regexp - (string-match-p helm--url-regexp current)) - (let ((target (expand-file-name (helm-substitute-in-filename current)))) - (dired (cons helm-ff-default-directory marked)) - (dired-goto-file target) - (when (or helm-current-prefix-arg current-prefix-arg) - (call-interactively 'wdired-change-to-wdired-mode)))))) - -(defun helm-ff-wfnames (_candidate) - "Edit marked fnames with `Wfnames' package." - (cl-assert (require 'wfnames nil t) nil "Wfnames package not found") - (let ((marked (helm-marked-candidates :with-wildcard t))) - (wfnames-setup-buffer - marked #'switch-to-buffer (buffer-live-p (get-buffer wfnames-buffer))))) - -(defun helm-ff-edit-marked-files (candidate) - "Edit marked files with `helm-ff-edit-marked-files-fn' fn." - (funcall helm-ff-edit-marked-files-fn candidate)) - -(helm-make-command-from-action helm-ff-run-edit-marked-files - "Execute `helm-ff-edit-marked-files' interactively." - 'helm-ff-edit-marked-files) - -(defun helm-ff--get-tramp-methods () - "Return a list of the car of `tramp-methods'." - (or helm-ff--tramp-methods - (setq helm-ff--tramp-methods (mapcar 'car tramp-methods)))) - -(defun helm-ff--previous-mh-tramp-method (str) - (save-match-data - (with-temp-buffer - (insert str) - (when (re-search-backward - (concat "\\([|]\\)\\(" - (mapconcat 'identity (helm-ff--get-tramp-methods) "\\|") - "\\):") - nil t) - (list - (buffer-substring-no-properties (pos-bol) (match-beginning 2)) - (buffer-substring-no-properties (match-beginning 2) (match-end 2))))))) - -(defun helm-ff--get-host-from-tramp-invalid-fname (fname) - "Extract hostname from an incomplete tramp file name. -Return nil on valid file name remote or not." - ;; Check first if whole file is remote (file-remote-p is inefficient - ;; in this case) otherwise we are matching e.g. /home/you/ssh:foo/ - ;; which is not a remote name. - ;; FIXME this will not work with a directory or a file named like - ;; "ssh:foo" and located at root (/) but it seems there is no real - ;; solution apart disabling tramp-mode when a file/dir located at / - ;; is matching helm-tramp-file-name-regexp; This would prevent usage - ;; of tramp if one have such a directory at / (who would want to - ;; have such a dir at / ???) See https://debbugs.gnu.org/31489. - (when (string-match-p helm-tramp-file-name-regexp fname) - (let* ((bn (helm-basename fname)) - (bd (replace-regexp-in-string (regexp-quote bn) "" fname)) - (split (split-string bn ":" t)) - (meth (car (member (car split) - (helm-ff--get-tramp-methods))))) - (and meth (string= bd "/") (car (last split)))))) - -(cl-defun helm-ff--tramp-hostnames (&optional (pattern helm-pattern)) - "Get a list of hosts for tramp method found in `helm-pattern'. -Argument PATTERN default to `helm-pattern'. It is here only for -debugging purpose." - (when (string-match helm-tramp-file-name-regexp pattern) - (let* ((mh-method (helm-ff--previous-mh-tramp-method pattern)) - (method (or (cadr mh-method) (match-string 1 pattern)))) - (cl-loop with all-methods = (helm-ff--get-tramp-methods) - for (f . h) in (tramp-get-completion-function method) - append (cl-loop for e in (funcall f (car h)) - for host = (and (consp e) (cadr e)) - ;; On emacs-27 host may be - ;; ("root" t) in sudo method. - when (and (stringp host) - (not (member host all-methods))) - collect (helm-ff-filter-candidate-one-by-one - (concat (or (car mh-method) "/") - method ":" host))) - into comps - finally return - (helm-fast-remove-dups comps :test 'equal))))) - -(defun helm-ff-before-action-hook-fn () - "Exit Helm when user try to execute action on an invalid tramp fname." - (let* ((src (helm-get-current-source)) - (cand (helm-get-selection nil nil src))) - (when (and (helm-file-completion-source-p src) - (stringp cand) - (helm-ff--invalid-tramp-name-p cand) ; Check candidate. - (helm-ff--invalid-tramp-name-p)) ; check helm-pattern. - (error "Error: Unknown file or directory `%s'" cand)))) -(add-hook 'helm-before-action-hook 'helm-ff-before-action-hook-fn) - -(cl-defun helm-ff--invalid-tramp-name-p (&optional (pattern helm-pattern)) - "Return non-nil when PATTERN is an invalid tramp filename." - (or (string= (helm-ff-set-pattern pattern) - "@@TRAMP@@") - ;; Tramp methods completion. - (string-match helm-ff-tramp-method-regexp pattern))) - -(defun helm-ff--tramp-multihops-p (name) - (cl-loop for m in (helm-ff--get-tramp-methods) - thereis (string-match (format "\\`\\(/%s:.*[|]\\).*" m) name))) - -(defun helm-ff-complete-tramp-methods () - "Completion on tramp methods in a nested helm session." - (interactive) - (with-helm-alive-p - (let* (initial-input - (str helm-pattern) - (pattern (with-temp-buffer - (insert str) - (let ((end (point)) beg) - (when (re-search-backward "[/|]" nil t) - (setq beg (1+ (point))) - (unless (= beg end) - (setq initial-input - (buffer-substring beg end)) - (delete-region beg end)) - (buffer-string))))) - (collection (helm-ff--get-tramp-methods)) - (method (helm-comp-read - "Tramp methods: " - (sort collection #'string<) - :initial-input initial-input - :fc-transformer - (lambda (candidates _source) - (cl-loop for c in candidates - collect (propertize c 'face 'helm-ff-file))) - :allow-nest t - :must-match t))) - (helm-set-pattern (concat pattern method ":"))))) -(put 'helm-ff-complete-tramp-methods 'no-helm-mx t) - -(defun helm-ff-set-pattern (pattern) - "Handle tramp filenames in `helm-pattern'." - (let* ((methods (helm-ff--get-tramp-methods)) - ;; Returns the position of last ":" entered. - (postfixed (file-remote-p pattern)) - (reg "\\`/\\([^[/:]+\\|[^/]+]\\):.*:") - cur-method tramp-name) - (when (string-match "\\`/\\(-\\):" pattern) - (setq pattern (replace-match tramp-default-method t t pattern 1))) - ;; In some rare cases tramp can return a nil input, - ;; so be sure pattern is a string for safety (Bug#476). - (unless pattern (setq pattern "")) - (cond ((string-match helm-ff-url-regexp pattern) pattern) - ((string-match "\\`\\$" pattern) - (substitute-in-file-name pattern)) - ((string= pattern "") "") - ((string-match "\\`[.]\\{1,2\\}/\\'" pattern) - (expand-file-name pattern)) - ;; Directories ending by a dot (Bug#1940) - ((string-match "[^/][.]/\\'" pattern) - (expand-file-name pattern)) - ((string-match ".*\\(~?/?[.]\\{1\\}/\\)\\'" pattern) - (expand-file-name default-directory)) - ((string-match ".*\\(~//\\|//\\)\\'" pattern) - (expand-file-name "/")) ; Expand to "/" or "c:/" - ((string-match "\\`\\(~/\\|.*/~/\\)\\'" pattern) - (expand-file-name "~/")) - ((string-match "\\`~/" pattern) - (expand-file-name pattern)) - ((string-match helm-ff-tramp-method-regexp pattern) - pattern) - ;; Match "/method:maybe_hostname:~" - ((and (string-match (concat reg "~") pattern) - postfixed - (setq cur-method (match-string 1 pattern)) - (member cur-method methods)) - (setq tramp-name (expand-file-name - (file-remote-p - (match-string 0 pattern)))) - (replace-match tramp-name nil t pattern)) - ;; Match "/method:maybe_hostname:" - ((and (string-match reg pattern) - postfixed - (setq cur-method (match-string 1 pattern)) - (member cur-method methods)) - (setq tramp-name (file-remote-p - (match-string 0 pattern))) - (replace-match tramp-name nil t pattern)) - ;; Match "/hostname:" - ((and (string-match helm-tramp-file-name-regexp pattern) - postfixed - (setq cur-method (match-string 1 pattern)) - (and cur-method (not (member cur-method methods)))) - (setq tramp-name (file-remote-p - (match-string 0 pattern))) - (replace-match tramp-name nil t pattern)) - ;; Match "/method:" in this case don't try to connect. - ((and (null postfixed) - (string-match helm-tramp-file-name-regexp pattern) - (member (match-string 1 pattern) methods)) - ;; A flag to notify tramp name is incomplete. - "@@TRAMP@@") - ;; Return PATTERN unchanged. - (t pattern)))) - -(defun helm-find-files-get-candidates () - "Create candidate list for `helm-source-find-files'." - (let* ((path (helm-ff-set-pattern helm-pattern)) - (dir-p (file-accessible-directory-p path)) - basedir - invalid-basedir - non-essential - (tramp-verbose helm-tramp-verbose)) ; No tramp message when 0. - ;; Tramp check if path is valid without waiting a valid - ;; connection and may send a file-error. - (setq helm--ignore-errors (file-remote-p path)) - (set-text-properties 0 (length path) nil path) - ;; Bug#118 allow creation of newdir+newfile. - (unless (or - ;; A tramp file name not completed. - (string= path "@@TRAMP@@") - ;; An empty pattern - (string= path "") - (file-remote-p path) - ;; Check if base directory of PATH is valid. - (helm-aif (file-name-directory path) - ;; If PATH is a valid directory IT=PATH, - ;; else IT=basedir of PATH. - (file-directory-p it))) - ;; BASEDIR is invalid, that's mean user is starting - ;; to write a non--existing path in minibuffer - ;; probably to create a 'new_dir' or a 'new_dir+new_file'. - (setq invalid-basedir t)) - ;; Don't set now `helm-pattern' if `path' == "@@TRAMP@@" - ;; like that the actual value (e.g /ssh:) is passed to - ;; `helm-ff--tramp-hostnames'. - (unless (or (string= path "@@TRAMP@@") - invalid-basedir) ; Leave helm-pattern unchanged. - (setq helm-ff-auto-update-flag ; [1] - ;; Unless auto update is disabled start auto updating only - ;; at third char. - (unless (or (null helm-ff--auto-update-state) - ;; But don't enable auto update when - ;; deleting backward. - helm-ff--deleting-char-backward - (and dir-p (not (string-match-p "/\\'" path)))) - (or (>= (length (helm-basename path)) 3) dir-p))) - ;; At this point the tramp connection is triggered. - (helm-log - "helm-find-files-get-candidates" - "Pattern=%S" - (setq helm-pattern (if (string-match helm-ff-tramp-method-regexp path) - ;; A tramp method, don't modify pattern. - helm-pattern - (helm-ff--transform-pattern-for-completion path)))) - ;; This have to be set after [1] to allow deleting char backward. - (setq basedir (or (helm-aand - (if (and dir-p helm-ff-auto-update-flag) - ;; Add the final "/" to path - ;; when `helm-ff-auto-update-flag' is enabled. - (file-name-as-directory path) - (if (string= path "") - "/" (file-name-directory path))) - (expand-file-name it)) - default-directory)) - (setq helm-ff-default-directory - (if (string= helm-pattern "") - (expand-file-name "/") ; Expand to "/" or "c:/" - ;; If path is an url *default-directory have to be nil. - (unless (or (string-match helm-ff-url-regexp path) - (and helm--url-regexp - (string-match helm--url-regexp path))) - basedir)))) - (when (and (string-match ":\\'" path) - (file-remote-p basedir nil t)) - (setq helm-pattern basedir)) - (cond (invalid-basedir nil) - ((string-match helm-ff-tramp-method-regexp path) ; Tramp methods - (mapcar (lambda (method) - (helm-ff-filter-candidate-one-by-one - (concat "/" ":" method))) - (helm-ff--get-tramp-methods))) - ((string= path "@@TRAMP@@") - (helm-ff--tramp-hostnames)) ; Hostnames completion. - ((or (and (file-regular-p path) - (eq last-repeatable-command 'helm-execute-persistent-action)) - ;; `ffap-url-regexp' don't match until url is complete. - (string-match helm-ff-url-regexp path) - (and helm--url-regexp (string-match helm--url-regexp path))) - ;; Do NOT filter boring files here (Bug#2330). - (list (helm-ff-filter-candidate-one-by-one path nil t))) - ((string= path "") (helm-ff-directory-files "/")) - ;; Check here if directory is accessible (not working on Windows). - ((and (file-directory-p path) (not (file-readable-p path))) - ;; Prefix error message with @@@@ for safety - ;; (some files may match file-error See bug#2400) - (list (cons (format "@@@@file-error: Opening directory permission denied `%s'" path) - path))) - ;; A fast expansion of PATH is made only if `helm-ff-auto-update-flag' - ;; is enabled. - ((and dir-p helm-ff-auto-update-flag) - (helm-ff-directory-files path)) - (t (helm-ff-directory-files basedir))))) - -(defun helm-list-directory (directory &optional sel) - "List directory DIRECTORY. - -If DIRECTORY is remote use `helm-list-remote-directory-fn', -otherwise use `directory-files'. -SEL argument is only here for debugging purpose, it default to -`helm-get-selection'." - (let* ((remote (file-remote-p directory 'method)) - (helm-list-remote-directory-fn - (helm-acase remote - ("ftp" #'helm-list-dir-lisp) - ("adb" #'helm-list-dir-adb) - (t helm-list-remote-directory-fn))) - (use-ext-remote-fn - (and remote - (eq helm-list-remote-directory-fn 'helm-list-dir-external))) - (sort-method (helm-acase helm-ff-initial-sort-method - (newest (if use-ext-remote-fn - "-t" #'file-newer-than-file-p)) - (size (if use-ext-remote-fn - "-S" #'helm-ff-file-larger-that-file-p)) - (ext (if use-ext-remote-fn - #'identity - #'helm-group-candidates-by))))) - (if remote - (ignore-errors - (funcall helm-list-remote-directory-fn directory sort-method)) - (helm-acase helm-ff-initial-sort-method - ((newest size) - (sort (helm-local-directory-files - directory t directory-files-no-dot-files-regexp) - sort-method)) - (ext (funcall sort-method - (helm-local-directory-files - directory t directory-files-no-dot-files-regexp) - #'file-name-extension - (or sel (helm-get-selection) ""))) - (t (helm-local-directory-files - directory t directory-files-no-dot-files-regexp)))))) - -(defsubst helm-ff-file-larger-that-file-p (f1 f2) - (let ((attr1 (file-attributes f1)) - (attr2 (file-attributes f2))) - (> (nth 7 attr1) (nth 7 attr2)))) - -(defun helm-list-dir-lisp (directory &optional sort-method) - "List DIRECTORY with `file-name-all-completions' as backend. - -Add a `helm-ff-dir' property on each fname ending with \"/\"." - ;; NOTE: `file-name-all-completions' and `directory-files' and most - ;; tramp file handlers don't handle cntrl characters in fnames, so - ;; the displayed files will be plain wrong in this case, even worst - ;; the filenames will be splitted in two or more filenames. - (cl-loop for f in (sort (file-name-all-completions "" directory) - (or sort-method 'string-lessp)) - unless (or (string= f "") - (member f '("./" "../" "." ".."))) - if (and (helm--dir-name-p f) - (helm--dir-file-name f directory)) - collect (propertize it 'helm-ff-dir t) - else collect (propertize (expand-file-name f directory) - 'helm-ff-file t))) - -(defun helm-file-name-all-completions-internal (directory) - (let ((switches "-1F")) - (with-temp-buffer - (insert-directory (format "%s*" - (file-name-as-directory directory)) - switches t) - (split-string - (buffer-substring-no-properties (point-min) (point-max)) - "\n" t)))) - -(defun helm-list-dir-adb (directory &optional sort-method) - "List DIRECTORY with `helm-file-name-all-completions-internal' as backend. - -This is used for tramp adb backend. - -Add a `helm-ff-dir' property on each fname ending with \"/\"." - (let ((inhibit-message t)) - (cl-loop with files = (helm-file-name-all-completions-internal directory) - for f in (sort files (or sort-method 'string-lessp)) - for split = (split-string f "->" t) - ;; For some reasons adb (or tramp) add a "*" at end of fnames, but - ;; the real name is without the ending "*". - for fname = (helm-aand (replace-regexp-in-string " $" "" (car split)) - (replace-regexp-in-string "\\*\\'" "" it)) - for truename = (cadr split) - collect (cond ((string-match "/\\'" fname) - (propertize (helm--dir-file-name fname directory) - 'helm-ff-dir t)) - (truename - (propertize (expand-file-name - (substring fname 0 (1- (length fname))) - directory) - 'helm-ff-sym truename)) - (t (propertize (expand-file-name fname directory) - 'helm-ff-file t)))))) - -(defun helm-list-dir-external (dir &optional sort-method) - "List directory DIR with external shell command as backend. - -This function is fast enough to be used for remote files and save -the type of files at the same time in a property for using it -later in the transformer." - (let ((default-directory (file-name-as-directory - (expand-file-name dir)))) - (with-temp-buffer - (when (eq (process-file-shell-command - (format - ;; -A remove dot files, -F append [*=@|/>] at eof - ;; and -Q quote the real filename. If not using -Q, - ;; there is no way to distinguish if foo* is a real - ;; file or if it is foo the executable file so with - ;; -Q we have "foo"* for the executable file foo and - ;; "foo*" for the real file foo. The downside is - ;; that we need an extra step to remove the quotes - ;; at the end which impact performances. - "ls -A -1 -F -b -Q %s | awk -v dir=%s '{print dir $0}'" - (or sort-method "") - (shell-quote-argument default-directory)) - nil t nil) - 0) - (goto-char (point-min)) - (save-excursion - (while (re-search-forward "[*=@|/>]$" nil t) - ;; A line looks like /home/you/"foo"@ - (helm-acase (match-string 0) - ("*" (replace-match "") - (put-text-property - (pos-bol) (pos-eol) 'helm-ff-exe t)) - ("@" (replace-match "") - (put-text-property - (pos-bol) (pos-eol) 'helm-ff-sym t)) - ("/" (replace-match "") - (put-text-property - (pos-bol) (pos-eol) 'helm-ff-dir t)) - (("=" "|" ">") (replace-match ""))))) - (while (re-search-forward "[\"]" nil t) - (replace-match "")) - (add-text-properties (point-min) (point-max) '(helm-ff-file t)) - (split-string (buffer-string) "\n" t))))) - -;; This is to fix issue with file-notify.el no more following symlinks -;; on emacs-29 (regression) with inotify backend at least. Also it -;; seems inotify is not configured to follow symlinks on other systems -;; (MacOS) so this should fix as well this issue on such systems see -;; bug#2542. -;; Store here associations of (truename . symlink) when opening a -;; symlinked directory, then add the watch to the truename; When the -;; watcher ring on the truename remove the symlinked directory from cache. -(defvar helm-ff--list-directory-links nil) - -(defun helm-ff-directory-files (directory &optional force-update) - "List contents of DIRECTORY. -Argument FULL mean absolute path. -It is same as `directory-files' but always returns the dotted -filename \\='.' and \\='..' even on root directories in Windows -systems. -When FORCE-UPDATE is non nil recompute candidates even if DIRECTORY is -in cache." - (let* ((method (file-remote-p directory 'method)) - (dfn (directory-file-name directory)) - (truename (and (file-symlink-p dfn) (file-truename dfn)))) - (setq directory (file-name-as-directory - (expand-file-name directory))) - (when truename - (cl-pushnew (cons truename directory) - helm-ff--list-directory-links :test 'equal)) - (or (and (not force-update) - (not (member method helm-ff-inotify-unsupported-methods)) - (gethash directory helm-ff--list-directory-cache)) - (let* (file-error - (ls (condition-case err - (helm-list-directory directory) - ;; Handle file-error from here for Windows - ;; because predicates like `file-readable-p' and friends - ;; seem broken on emacs for Windows systems (always returns t). - ;; This should never be called on GNU/Linux/Unix - ;; as the error is properly intercepted in - ;; `helm-find-files-get-candidates' by `file-readable-p'. - (file-error - (prog1 - ;; Prefix error message with @@@@ for safety - ;; (some files may match file-error See bug#2400) - (list (format "@@@@%s:%s" - (car err) - (mapconcat 'identity (cdr err) " "))) - (setq file-error t))))) - (dot (concat directory ".")) - (dot2 (concat directory "..")) - (candidates (append (and (not file-error) (list dot dot2)) ls)) - watcher) - (puthash directory (+ (length ls) 2) helm-ff--directory-files-length) - (prog1 - (puthash directory - (cl-loop for f in candidates - when (helm-ff-filter-candidate-one-by-one f) - collect it) - helm-ff--list-directory-cache) - ;; Put an inotify watcher to check directory modifications. - (unless (or (null helm-ff-use-notify) - (member method helm-ff-inotify-unsupported-methods) - (helm-aand (setq watcher (gethash - directory - helm-ff--file-notify-watchers)) - ;; [1] If watcher is invalid enter - ;; next and delete it. - (file-notify-valid-p it))) - (condition-case-unless-debug err - (let ((to-watch (or truename directory))) - (when watcher - ;; If watcher is still in cache and we are here, - ;; that's mean test [1] above fails and watcher - ;; is invalid, so delete it. - (file-notify-rm-watch watcher) - (remhash directory helm-ff--file-notify-watchers)) - ;; Keep adding DIRECTORY to - ;; helm-ff--file-notify-watchers but watch on the - ;; truename and not the symlink as before bug#2542. - (puthash directory - (file-notify-add-watch - to-watch - '(change attribute-change) - (helm-ff--inotify-make-callback to-watch)) - helm-ff--file-notify-watchers)) - (file-notify-error (user-error "Error: %S %S" (car err) (cdr err)))))))))) - -(defun helm-ff--inotify-make-callback (directory) - "Return a callback for `file-notify-add-watch'." - (lambda (event) - (let ((desc (cadr event)) - (target directory)) ; Either truename or directory. - (helm-log "Inotify callback" "Event %S called on %S" event directory) - ;; `attribute-changed' means permissions have changed, not - ;; file modifications like file changes, visit - ;; etc... AFAIU the desc for this is `changed' and for our - ;; use case we don't care of this. Elemnts of - ;; `helm-ff--list-directory-links' are of the form - ;; (truename . visited-symlink-directory) - (when (memq desc '(created deleted renamed attribute-changed)) - ;; Watched directory is the truename which is not in the - ;; cache, so remove its associated directory (the symlink) - ;; from the cache bug#2542. - (helm-aif (assoc directory helm-ff--list-directory-links) - (progn - (setq target (cdr it)) - (setq helm-ff--list-directory-links - (delete it helm-ff--list-directory-links)))) - ;; When TARGET is modified remove it from cache. - (helm-log "Inotify callback" - "Removing %S from `helm-ff--list-directory-cache'" target) - (remhash target helm-ff--list-directory-cache))))) - -(defun helm-ff-tramp-cleanup-hook (vec) - "Remove remote directories related to VEC in helm-ff* caches. -Remove as well all related file-notify watchers. - -This is meant to run in `tramp-cleanup-connection-hook'." - (cl-loop for key being the hash-keys in helm-ff--list-directory-cache - when (equal (file-remote-p key 'method) (cadr vec)) - do (remhash key helm-ff--list-directory-cache)) - (cl-loop for key being the hash-keys in helm-ff--file-notify-watchers - when (equal (file-remote-p key 'method) (cadr vec)) - do (progn - (file-notify-rm-watch - (gethash key helm-ff--file-notify-watchers)) - (remhash key helm-ff--file-notify-watchers)))) -(add-hook 'tramp-cleanup-connection-hook #'helm-ff-tramp-cleanup-hook) - -(defun helm-ff-handle-backslash (fname) - ;; Allow creation of filenames containing a backslash. - (cl-loop with bad = '((92 . "")) - for i across fname - if (assq i bad) concat (cdr it) - else concat (string i))) - -;; Keep it like this i.e. a function for evaluation in source definition. -(defun helm-ff--fuzzy-matching-p () - helm-ff-fuzzy-matching) - -(defun helm-ff--transform-pattern-for-completion (pattern) - "Maybe return PATTERN with it's basename modified as a regexp. -This happens only when `helm-ff-fuzzy-matching' is enabled. -This provides a similar behavior as `ido-enable-flex-matching'. -See also `helm--mapconcat-pattern'. -If PATTERN is an url return it unmodified. -When PATTERN contains a space fallback to multi-match. -If basename contains one or more space fallback to multi-match. -If PATTERN is a valid directory name, return PATTERN unchanged." - ;; handle bad filenames containing a backslash (no more needed in - ;; emacs-26, also prevent regexp matching with e.g. "\|"). - ;; (setq pattern (helm-ff-handle-backslash pattern)) - (let ((bn (helm-basename pattern)) - (bd (or (helm-basedir pattern) "")) - ;; Trigger tramp connection with file-directory-p. - (dir-p (file-directory-p pattern)) - (tramp-p (cl-loop for (m . f) in tramp-methods - thereis (string-match m pattern)))) - ;; Always regexp-quote base directory name to handle - ;; crap dirnames such e.g bookmark+ - (cond - ((or (and dir-p tramp-p (string-match ":\\'" pattern)) - (string= pattern "") - (and dir-p (<= (length bn) 2)) - ;; Fix Bug#541 when BD have a subdir similar - ;; to BN, don't switch to match plugin - ;; which will match both. - (and dir-p (string-match (regexp-quote bn) bd))) - ;; Use full PATTERN on e.g "/ssh:host:". - (regexp-quote pattern)) - ;; Prefixing BN with a space call multi-match completion. - ;; This allow showing all files/dirs matching BN (Bug#518). - ;; FIXME: some multi-match methods may not work here. - (dir-p (concat (regexp-quote bd) " " (regexp-quote bn))) - ((or (not (helm-ff--fuzzy-matching-p)) - (string-match "[ !]" bn)) ; Fall back to multi-match. - (concat (regexp-quote bd) " " bn)) - ((or (string-match "[*][.]?.*" bn) ; Allow entering wildcard. - (string-match "/\\'" pattern) ; Allow mkdir. - (string-match helm-ff-url-regexp pattern) - (and (string= helm-ff-default-directory "/") tramp-p)) - ;; Don't treat wildcards ("*") as regexp char. - ;; (e.g ./foo/*.el => ./foo/\\*\\.el) or ./foo/*.[ch] => - ;; ./foo/\\*\\.\\[ch] - (concat (regexp-quote bd) - ;; We were previously using - ;; (replace-regexp-in-string "[*]" "[*]" bn) but this - ;; doesn't handle wilcards like *.[ch], so regexp-quote - ;; bn as well. - (regexp-quote bn))) - (t (concat (regexp-quote bd) - ;; wait 2nd char before transforming to fuzzy. - (if (>= (length bn) 2) - (helm--mapconcat-pattern bn) - ;; Here BN length is 1, we were previously matching - ;; everything before BN i.e. (concat ".*" (regexp-quote bn)) - ;; but it is too slow on large directories. We could use - ;; previous clause for this but keep it here for clarity. - (regexp-quote bn))))))) - -(defalias 'helm-dir-is-dot 'helm-ff-dot-file-p) -(make-obsolete 'helm-dir-is-dot 'helm-ff-dot-file-p "3.8.8") - -(defun helm-ff-save-history () - "Store the last value of `helm-ff-default-directory' in `helm-ff-history'. -Note that only existing directories are saved here." - (when (and helm-ff-default-directory - (helm-file-completion-source-p) - (file-directory-p helm-ff-default-directory)) - (set-text-properties 0 (length helm-ff-default-directory) - nil helm-ff-default-directory) - (push helm-ff-default-directory helm-ff-history))) -(add-hook 'helm-cleanup-hook 'helm-ff-save-history) - -(defun helm-ff-valid-symlink-p (file &optional link) - "Returns the truename of FILE if it exists. -If we already know the truename of FILE we can pass it with LINK arg -to avoid an unnecessary call to `file-truename'." - (helm-aif (condition-case-unless-debug nil - ;; `file-truename' send error - ;; on cyclic symlinks (Bug#692). - (or link (file-truename file)) - (error nil)) - (and (file-exists-p it) it))) - -(defun helm-get-default-mode-for-file (filename) - "Return the default mode to open FILENAME." - (let ((mode (cl-loop for (r . m) in auto-mode-alist - thereis (and (string-match r filename) m)))) - (or (and (symbolp mode) mode) "Fundamental"))) - -(defun helm-ff-properties (candidate) - "Show file properties of CANDIDATE in a tooltip or message." - (require 'helm-external) ; For `helm-get-default-program-for-file'. - (helm-aif (helm-file-attributes candidate) - (let* ((dired-line (helm-file-attributes-dired-line it t t)) - (type (cl-getf it :type)) - (mode-type (cl-getf it :mode-type)) - (owner (cl-getf it :uid)) - (owner-right (cl-getf it :user t)) - (group (cl-getf it :gid)) - (group-right (cl-getf it :group)) - (other-right (cl-getf it :other)) - (octal (cl-getf it :octal)) - (trash (and (helm-ff-trash-file-p candidate) - (helm-ff--get-dest-file-from-trash - (helm-ff-trash-list) - (replace-regexp-in-string - "\\.trashinfo\\'" "" candidate)))) - (size (helm-file-human-size (cl-getf it :size))) - (modif (cl-getf it :modif-time)) - (access (cl-getf it :access-time)) - (ext (helm-get-default-program-for-file candidate)) - (tooltip-hide-delay (or helm-tooltip-hide-delay tooltip-hide-delay)) - (posn (with-helm-window - (posn-at-point (save-excursion (end-of-visual-line) (point))))) - (tooltip-frame-parameters (append tooltip-frame-parameters - `((left . ,(car (posn-x-y posn))) - (top . ,(cdr (posn-x-y posn))))))) - (if (and (display-graphic-p) tooltip-mode) - (tooltip-show - (concat - (helm-basename candidate) "\n" - dired-line "\n" - (format "Mode: %s\n" (helm-get-default-mode-for-file candidate)) - (format "Ext prog: %s\n" (or (and ext (replace-regexp-in-string - " %s" "" ext)) - "Not defined")) - (format "Type: %s: %s\n" type mode-type) - (when (string= type "symlink") - (format "True name: '%s'\n" - (cond ((string-match "^\\.#" (helm-basename candidate)) - "Autosave symlink") - ((helm-ff-valid-symlink-p candidate)) - (t "Invalid Symlink")))) - (format "Owner: %s: %s\n" owner owner-right) - (format "Group: %s: %s\n" group group-right) - (format "Others: %s\n" other-right) - (format "NumMode: %s\n" octal) - (format "Size: %s\n" size) - (when (string= type "directory") - (format "Size used in directory: %s\n" - (helm-directory-size - candidate current-prefix-arg t))) - (format "Modified: %s\n" modif) - (format "Accessed: %s\n" access) - (and (stringp trash) - (format "Trash: %s\n" - (abbreviate-file-name trash))))) - (message dired-line) (sit-for 5))) - (message "Permission denied, file not readable"))) - -(helm-make-persistent-command-from-action helm-ff-properties-persistent - "Show properties without quitting helm." - 'properties-action 'helm-ff-properties) - -(helm-make-persistent-command-from-action helm-ff-persistent-delete - "Delete current candidate without quitting." - 'quick-delete 'helm-ff-quick-delete) - -(defun helm-ff-kill-default-directory (_candidate) - (with-helm-window - (kill-new helm-ff-default-directory) - (message "`%s' copied to kill-ring" helm-ff-default-directory))) - -(helm-make-persistent-command-from-action helm-ff-run-kill-default-directory - "Kill `helm-ff-default-directory'." - 'kill-default-directory - 'helm-ff-kill-default-directory) - -(defun helm-ff-dot-file-p (file) - "Check if FILE is `.' or `..'." - (member (helm-basename file) '("." ".."))) - -(defun helm-ff-kill-buffer-fname (candidate) - (let* ((buf (get-file-buffer candidate)) - (buf-name (buffer-name buf))) - (cond ((and buf (eq buf (get-buffer helm-current-buffer))) - (user-error - "Can't kill `helm-current-buffer' without quitting session")) - (buf (kill-buffer buf) (message "Buffer `%s' killed" buf-name)) - (t (message "No buffer to kill"))))) - -(defun helm-ff-kill-or-find-buffer-fname (candidate) - "Find file CANDIDATE or kill its buffer if it is visible. -Never kill `helm-current-buffer'. -Never kill buffer modified. -This is called normally on third hit of \ -\\\\[helm-execute-persistent-action] -in `helm-find-files-persistent-action-if'." - (let* ((buf (get-file-buffer candidate)) - (buf-name (buffer-name buf)) - (win (get-buffer-window buf)) - (helm--reading-passwd-or-string t) - ;; Prevent tramp from asking yes-or-no-p for - ;; `tramp-allow-unsafe-temporary-files'. - auto-save-default) - (cond ((and buf win (eql buf (get-buffer helm-current-buffer))) - (user-error - "Can't kill `helm-current-buffer' without quitting session")) - ((and buf win (buffer-modified-p buf)) - (message "Can't kill modified buffer, please save it before")) - ((and buf win) - (kill-buffer buf) - (if (and helm-persistent-action-display-window - (window-dedicated-p (next-window win 1))) - (delete-window helm-persistent-action-display-window) - (set-window-buffer win helm-current-buffer)) - (message "Buffer `%s' killed" buf-name)) - (t (find-file candidate))))) - -(helm-make-persistent-command-from-action helm-ff-run-kill-buffer-persistent - "Execute `helm-ff-kill-buffer-fname' without quitting." - 'kill-buffer-fname 'helm-ff-kill-buffer-fname) - -;; Preview with external tool -(defun helm-ff-persistent-open-file-externally (file) - (require 'helm-external) - (if (helm-get-default-program-for-file file) - (helm-open-file-externally file) - (message "Please configure an external program for `*%s' file in `helm-external-programs-associations'" - (file-name-extension file t)))) - -(helm-make-persistent-command-from-action helm-ff-run-preview-file-externally - "Run open file externally without quitting helm." - 'open-file-externally 'helm-ff-persistent-open-file-externally) - -(defun helm-ff-prefix-filename (disp fname &optional new-file) - "Return DISP maybe prefixed with a string or an icon. - -Arg FNAME is the real filename whereas DISP is the display part of candidate. - -Icons are used when `helm-ff-icon-mode' is enabled. - -When NEW-FILE is non nil, returns a string prefixed with -[+] or [@] or a special icon, otherwise DISP is -returned prefixed with its icon or unchanged." - (let (prefix-new prefix-url) - (cond ((and new-file - (or (string-match helm-ff-url-regexp disp) - (and helm--url-regexp - (string-match helm--url-regexp disp)))) - (setq prefix-url - (if helm-ff-icon-mode - (helm-acase (match-string 1 disp) - ("mailto:" - (helm-x-icons-generic "mail")) - (t (helm-x-icons-generic "link-external"))) - (propertize - " " 'display - (propertize "[@]" 'face 'helm-ff-prefix)))) - (add-text-properties 0 1 '(helm-url t) prefix-url) - (concat prefix-url " " disp)) - (new-file - (setq prefix-new - (if helm-ff-icon-mode - (if (string-match "/\\'" disp) - (helm-x-icons-generic "create_new_folder") - (helm-x-icons-generic "note_add")) - (propertize - " " 'display - (propertize "[+]" 'face 'helm-ff-prefix)))) - (add-text-properties 0 1 '(helm-new-file t) prefix-new) - (concat prefix-new " " disp)) - (t (concat (helm-ff-get-icon disp fname) disp))))) - -(defun helm-ff-score-candidate-for-pattern (real disp pattern) - (cond ((member real '("." "..")) 900000) - ((and (string-match-p "\\`\\s-\\{2\\}" disp) - (string= real (substring-no-properties disp 2))) - ;; Incomplete filenames are prefixed with two spaces, the - ;; first one beeing propertized with a 'display prop - ;; i.e. "[+] foo". - 900001) - (t (helm-score-candidate-for-pattern real pattern)))) - -(defun helm-ff-sort-candidates-1 (candidates input) - "Sort function for `helm-source-find-files'. -Return candidates prefixed with basename of INPUT first." - (if (or (and (file-directory-p input) - (string-match "/\\'" input)) - (string-match "\\`\\$" input) - (null candidates)) - candidates - (let* ((memo-src (make-hash-table :test 'equal)) - (all (sort candidates - (lambda (s1 s2) - (let* ((score (lambda (disp real) - (helm-ff-score-candidate-for-pattern - disp real (helm-basename input)))) - ;; Reals - (r1 (helm-basename (if (consp s1) (cdr s1) s1))) - (r2 (helm-basename (if (consp s2) (cdr s2) s2))) - ;; Displays - (d1 (helm-basename (if (consp s1) (car s1) s1))) - (d2 (helm-basename (if (consp s2) (car s2) s2))) - (sc1 (or (gethash r1 memo-src) - (puthash r1 (funcall score r1 d1) memo-src))) - (sc2 (or (gethash r2 memo-src) - (puthash r2 (funcall score r2 d2) memo-src)))) - ;; The score fn may return a string (happens with "/adb:"). - (cond ((or (stringp sc1) (stringp sc2))) - ((= sc1 sc2) - (< (string-width r1) - (string-width r2))) - ((> sc1 sc2)))))))) - all))) - -(defun helm-ff-sort-candidates (candidates _source) - "Sort function for `helm-source-find-files'. -Return candidates prefixed with basename of `helm-input' first." - (helm-ff-sort-candidates-1 candidates helm-input)) - -(defun helm-ff-boring-file-p (file) - "Returns non nil when FILE is matching boring regexps." - ;; Prevent user doing silly thing like - ;; adding the dotted files to boring regexps (#924). - (and helm-ff-skip-boring-files - (not (string-match "\\.$" file)) - (string-match helm-ff--boring-regexp file))) - -(defvar helm-ff--git-found-p nil) -(defun helm-ff-git-ignored-p (file) - "Returns non nil when FILE is matched in \".gitignore\" file." - (and helm-ff-skip-git-ignored-files - (not (file-remote-p file)) - (or helm-ff--git-found-p - (setq helm-ff--git-found-p (executable-find "git"))) - (zerop (call-process "git" nil nil nil "check-ignore" "-q" file)))) - -(defun helm-ff-fct (candidates _source) - "Filter in charge of displaying basename or full path in HFF. -Because CANDIDATES are directly stored as (basename . full_path), when -`helm-ff-transformer-show-only-basename' is non nil do nothing and -return directly CANDIDATES." - (if (null helm-ff-transformer-show-only-basename) - (cl-loop for (_disp . real) in candidates - for fc = (helm-ff-filter-candidate-one-by-one real 'reverse) - when fc collect fc) - candidates)) - -(defun helm-ff-filter-candidate-one-by-one (file &optional reverse skip-boring-check) - "Transform file in a cons cell like (DISPLAY . REAL). -DISPLAY is shown as basename of FILE and REAL as full path of FILE. -If REVERSE is non nil DISPLAY is shown as full path. -If SKIP-BORING-CHECK is non nil don't filter boring files." - (let* ((basename (helm-basename file)) - (dot (helm-ff-dot-file-p file)) - (urlp (string-match-p helm-ff-url-regexp file)) - (tramp-invalid-fname (helm-ff--get-host-from-tramp-invalid-fname file)) - (disp (or tramp-invalid-fname - ;; Filename with cntrl chars e.g. foo^J - (replace-regexp-in-string - "[[:cntrl:]]" "?" - (if (or reverse urlp (and dot helm-ff-show-dot-file-path)) - file basename)))) - (len (length disp)) - (backup (backup-file-name-p disp))) - (when (string-match "/\\'" file) - (setq disp (concat disp "/") - len (1+ len))) - ;; We want to filter boring files only on the files coming - ;; from the output of helm-ff-directory-files not on single - ;; candidate (Bug#2330). - (unless (and (not skip-boring-check) - (or (helm-ff-boring-file-p basename) - (helm-ff-git-ignored-p file))) - ;; Highlight extensions. - (helm-aif (and (not backup) - (not urlp) - (helm-file-name-extension disp)) - (when (condition-case _err - (string-match (format "\\.\\(%s\\)\\'" it) disp) - (invalid-regexp nil)) - (add-face-text-property - (match-beginning 1) (match-end 1) - 'helm-ff-file-extension t disp))) - ;; Handle tramp files with minimal highlighting. - (if (and (or (string-match-p helm-tramp-file-name-regexp helm-pattern) - (helm-file-on-mounted-network-p helm-pattern))) - (helm-acond (;; Dot directories . and .. - dot - (cons (helm-ff-prefix-filename - (propertize disp 'face 'helm-ff-dotted-directory) - file) - file)) - ;; Directories. - ((get-text-property 1 'helm-ff-dir file) - (cons (helm-ff-prefix-filename - (propertize disp 'face 'helm-ff-directory) - file) - file)) - ;; Backup files. - (backup - (cons (helm-ff-prefix-filename - (propertize disp 'face 'helm-ff-backup-file) - file) - file)) - ;; Executable files. - ((get-text-property 1 'helm-ff-exe file) - (add-face-text-property 0 len 'helm-ff-executable t disp) - (cons (helm-ff-prefix-filename disp file) file)) - ;; Symlinks. - ((get-text-property 1 'helm-ff-sym file) - (add-face-text-property 0 len 'helm-ff-symlink t disp) - (if (stringp it) ; adb method. - (progn - (add-face-text-property 0 (length it) 'helm-ff-truename nil it) - (cons (propertize disp 'display (concat disp " ->" it)) file)) - (cons (helm-ff-prefix-filename disp file) file))) - ;; Regular files. - ((get-text-property 1 'helm-ff-file file) - (add-face-text-property 0 len 'helm-ff-file t disp) - (cons (helm-ff-prefix-filename disp file) file)) - ;; Tramp methods. - ((string-match helm-ff-tramp-method-regexp file) - (let ((method (match-string 1 file)) - (mh (helm-ff--tramp-multihops-p helm-pattern))) - (cons (propertize (concat (if mh "" "/") method) 'face 'helm-ff-file) - (if mh - (concat (match-string 1 helm-pattern) ":" method) - (concat "/:" method))))) - ;; non existing files. - (t - (add-face-text-property 0 len 'helm-ff-file t disp) - (when tramp-invalid-fname - (add-text-properties 0 len `(host ,tramp-invalid-fname) disp)) - (cons (helm-ff-prefix-filename - disp - file - (unless tramp-invalid-fname 'new-file)) - file))) - - ;; Highlight local files showing everything, symlinks, exe, - ;; dirs etc... - (let* ((attr (condition-case err - (file-attributes file) - (file-error - ;; Possible error not happening during listing - ;; but when calling file-attributes see error - ;; with sshfs bug#2405 - (message "%s:%s" (car err) (cdr err)) nil))) - (type (car attr)) - x-bit) - (cond (;; Not a file but the message error printed in - ;; helm-buffer. Such a message should not have a - ;; subdir so matching on bol should suffice, but to - ;; be sure use @@@@ as prefix in file-error message - ;; to be safe bug#2400. - (string-match "\\`@@@@file-error:" file) file) - (;; A dead symlink. - (and (stringp type) - (not (helm-ff-valid-symlink-p file)) - (not (string-match "^\\.#" basename))) - (add-face-text-property 0 len 'helm-ff-invalid-symlink t disp) - (cons (helm-ff-prefix-filename disp file) file)) - ;; A dotted directory symlinked. - ((and dot (stringp type)) - (cons (helm-ff-prefix-filename - (propertize disp 'face 'helm-ff-dotted-symlink-directory) - file) - file)) - ;; A dotted directory. - (dot - (cons (helm-ff-prefix-filename - (propertize disp 'face 'helm-ff-dotted-directory) - file) - file)) - ;; Backup files. - (backup - (cons (helm-ff-prefix-filename - (propertize disp 'face 'helm-ff-backup-file) - file) - file)) - ;; A symlink. - ((stringp type) - (let* ((abbrev (abbreviate-file-name type)) - (len-abbrev (length abbrev))) - (helm-aif (helm-file-name-extension abbrev) - (when (string-match (format "\\.\\(%s\\)\\'" it) abbrev) - (add-face-text-property - (match-beginning 1) (match-end 1) - 'helm-ff-file-extension t abbrev))) - (add-face-text-property 0 len-abbrev 'helm-ff-truename t abbrev) - ;; Colorize extension only on truename. - (add-face-text-property 0 len 'helm-ff-symlink nil disp) - (cons (concat (helm-ff-prefix-filename disp file) - ;; Displaying this in a space with display prop - ;; allows retrieving the candidate with - ;; `helm-ff-retrieve-last-expanded'. If we put - ;; the display prop on the whole candidate - ;; `helm-fuzzy-highlight-matches' don't match - ;; properly. - (propertize " " 'display (concat " -> " abbrev))) - file))) - ;; A directory. - ((eq t type) - (cons (helm-ff-prefix-filename - (propertize disp 'face 'helm-ff-directory) - file) - file)) - ;; A character device file. - ((and attr (string-match - "\\`[cp]" (setq x-bit (substring (nth 8 attr) 0 4)))) - (add-face-text-property 0 len 'helm-ff-pipe t disp) - (cons (helm-ff-prefix-filename disp file) file)) - ;; A socket file. - ((and attr (string-match "\\`[s]" x-bit)) - (add-face-text-property 0 len 'helm-ff-socket t disp) - (cons (helm-ff-prefix-filename disp file) file)) - ;; An executable file. - ((and attr (string-match "x\\'" x-bit)) - (add-face-text-property 0 len 'helm-ff-executable t disp) - (cons (helm-ff-prefix-filename disp file) file)) - ;; An executable file with suid - ((and attr (string-match "s\\'" x-bit)) - (add-face-text-property 0 len 'helm-ff-suid t disp) - (cons (helm-ff-prefix-filename disp file) file)) - ;; A file. - ((and attr (null type)) - (add-face-text-property 0 len 'helm-ff-file t disp) - (cons (helm-ff-prefix-filename disp file) file)) - ;; A tramp method - ;; At this point no need to handle multi hops syntax - ;; which is considered remote and handled in first - ;; cond before. - ((string-match helm-ff-tramp-method-regexp file) - (cons (propertize (concat "/" (match-string 1 file)) - 'face 'helm-ff-nofile) - (concat "/:" (match-string 1 file)))) - ;; A non--existing file. - (t - (add-face-text-property 0 len 'helm-ff-nofile t disp) - (cons (helm-ff-prefix-filename disp file 'new-file) - file)))))))) - -(defun helm-ff-get-icon (disp file) - "Get icon from `helm-x-icons-provider' for FILE. -Arg DISP is the display part of the candidate. -Arg FILE is the real part of candidate, a filename with no props." - (when helm-ff-icon-mode - (let ((icon (helm-acond (;; Non symlink directories. - (helm-ff--is-dir-from-disp disp) - (helm-aif (helm-x-icons-match-to-alist - (helm-basename file) - 'dir) - (apply (car it) (cdr it)) - (helm-x-icons-generic "file-directory"))) - (;; All files, symlinks may be symlink directories. - (helm-ff--is-file-from-disp disp) - ;; Detect symlink directories. We must call - ;; `file-directory-p' here but it is - ;; limited to symlinks, so it should not - ;; degrade too much performances. - (if (and (memq it '(helm-ff-symlink - helm-ff-dotted-symlink-directory)) - (file-directory-p file)) - (helm-x-icons-generic "file-symlink-directory") - (helm-x-icons-icon-for-file (helm-basename file))))))) - (when icon (concat icon " "))))) - -(defun helm-ff--is-dir-from-disp (disp) - "Return the face used for candidate when candidate is a directory." - (helm-aand (get-text-property 0 'face disp) - (memq it '(helm-ff-directory helm-ff-dotted-directory)) - (car it))) - -(defun helm-ff--is-file-from-disp (disp) - "Return the face used for file's candidate or dotted-symlink dirs." - (helm-aand (get-text-property 0 'face disp) - (memq it '(helm-ff-file - helm-ff-suid - helm-ff-executable - helm-ff-socket - helm-ff-pipe - helm-ff-symlink - helm-ff-dotted-symlink-directory - helm-ff-backup-file - helm-ls-git-untracked-face)) - (car it))) - -;;;###autoload -(define-minor-mode helm-ff-icon-mode - "Display icons from `helm-x-icons-provider' package in HFF when enabled." - :global t - :group 'helm-files - (when helm-ff-icon-mode - (unless (require helm-x-icons-provider nil t) - (setq helm-ff-icon-mode nil) - (message "No suitable Icons package found"))) - (clrhash helm-ff--list-directory-cache)) - -;;; Action transformer -;; -(defun helm-ff--in-backup-directory () - (when backup-directory-alist - (cl-loop for (_p . f) in backup-directory-alist - thereis (file-equal-p f helm-ff-default-directory)))) - -(defun helm-ff-restore-backups (_candidate) - (let ((mkd (helm-marked-candidates)) - (copied 0) - ovw) - (cl-dolist (file mkd) - (let (dest) - (when (string-match "\\(?:\\`\\([!]\\)[^!]*\\1.*\\)\\|\\(?:~\\'\\)" - (helm-basename file)) - (setq dest (helm-aand (replace-regexp-in-string - "\\.~[[:digit:]]*~?" - "" (helm-basename file)) - (helm-ff--normalize-backup-name it) - (if (string-match "\\`/" it) - it - ;; If basename doesn't contain now - ;; "/", that's mean it was a backup file - ;; stored in current directory, just - ;; expand it to this directory. - (expand-file-name it helm-ff-default-directory)))) - (if (and (file-exists-p dest) (null ovw)) - (helm-acase (helm-read-answer - (format "Overwrite `%s' (answer [y,n,!,q])? " dest) - '("y" "n" "!" "q")) - ("y" (cl-incf copied) (copy-file file dest t t t t)) - ("n" (ignore)) - ("!" (setq ovw t) (cl-incf copied) (copy-file file dest t t t t)) - ("q" (setq copied nil) (cl-return (message "Abort restoring files")))) - (cl-incf copied) - (copy-file file dest t t t t))))) - (when (numberp copied) - (message "(%s/%s) files copied" copied (length mkd))))) - -(defun helm-ff--normalize-backup-name (fname) - "Normalize backup FNAME to its original name." - ;; When Emacs build a backup filename for the backup directory it - ;; replace "/" by "!" in the basedir of file and double the "!" in - ;; the basename, this is done by `make-backup-file-name-1'. We want - ;; to replace only the "!" in the basedir part of FNAME. - (with-temp-buffer - (insert fname) - (goto-char (point-min)) - (save-excursion - (when (looking-at "!") (replace-match "/")) - (while (re-search-forward "[^!]\\([!]\\)[^!]" nil t) - (replace-match "/" nil nil nil 1))) - (let ((count 0) rep) - (while (re-search-forward "!" nil t) - (cl-incf count)) - (setq rep (make-string (/ count 2) ?!)) - (replace-regexp-in-string "[!]+" rep (buffer-string))))) - -(defun helm-ff-update-directory-autoloads (_candidate) - "Action to update or create autoloads file in current directory." - (let ((default-directory helm-ff-default-directory) - (file - (read-file-name "Write autoload definitions to file: " - helm-ff-default-directory - nil nil nil - (lambda (f) - (string-match "autoloads\\|loaddefs" f))))) - (if (fboundp 'loaddefs-generate) - (loaddefs-generate default-directory file nil nil nil t) - (let ((generated-autoload-file file)) - (update-directory-autoloads default-directory))))) - -(defun helm-find-files-action-transformer (actions candidate) - "Action transformer for `helm-source-find-files'." - (let ((str-at-point (with-helm-current-buffer - (buffer-substring-no-properties - (pos-bol) (pos-eol))))) - (when (file-regular-p candidate) - (setq actions (helm-append-at-nth - actions '(("Checksum File" . helm-ff-checksum)) 4))) - (when (file-exists-p (expand-file-name - (format "#%s#" (helm-basename candidate)) - (helm-basedir candidate))) - (setq actions (helm-append-at-nth - actions '(("Recover file" . recover-file)) 4))) - (cond ((and (file-exists-p candidate) - (string-match helm-ff--trash-directory-regexp - (helm-basedir (expand-file-name candidate))) - (not (member (helm-basename candidate) '("." "..")))) - (helm-append-at-nth - actions - '(("Restore file(s) from trash" . helm-restore-file-from-trash) - ("Delete file(s) from trash" . helm-ff-trash-rm)) - 1)) - ((and helm--url-regexp - (not (string-match-p helm--url-regexp str-at-point)) - (not (with-helm-current-buffer (eq major-mode 'dired-mode))) - (string-match-p ":\\([0-9]+:?\\)" str-at-point)) - (append '(("Find file to line number" . helm-ff-goto-linum)) - actions)) - ((string-match (image-file-name-regexp) candidate) - (helm-append-at-nth - actions - (helm-make-actions - "Rotate image right `M-r'" 'helm-ff-rotate-image-right - "Rotate image left `M-l'" 'helm-ff-rotate-image-left - "Start slideshow with marked" 'helm-ff-start-slideshow-on-marked - (lambda () - (and (fboundp 'image-dired-wallpaper-set) - (display-graphic-p) - "Change wall paper")) - 'image-dired-wallpaper-set) - 3)) - ((string-match "\\.el\\'" candidate) - (helm-append-at-nth - actions - `(("Byte compile lisp file(s) `M-B, C-u to load'" - . helm-find-files-byte-compile) - ("Byte compile file(s) async" - . ,(lambda (_candidate) - (cl-loop for file in (helm-marked-candidates) - do (async-byte-compile-file file)))) - ("Byte recompile directory async" - . ,(lambda (_) - (async-byte-recompile-directory - helm-ff-default-directory))) - ("Load File(s) `M-L'" . helm-find-files-load-files) - ("Update directory autoloads" . helm-ff-update-directory-autoloads)) - 2)) - ((string-match (concat (regexp-opt load-suffixes) "\\'") candidate) - (helm-append-at-nth - actions - '(("Load File(s) `M-L'" . helm-find-files-load-files)) - 2)) - ((and (string-match "\\.html?$" candidate) - (file-exists-p candidate)) - (helm-append-at-nth - actions '(("Browse url file" . browse-url-of-file)) 2)) - ((and (helm-ff--in-backup-directory) - (cl-loop for file in (helm-marked-candidates) - always (string-match "\\(?:\\`\\([!]\\)[^!]*\\1.*\\)\\|\\(?:~\\'\\)" - (helm-basename file)))) - (helm-append-at-nth - actions '(("Restore backup file(s)" . helm-ff-restore-backups)) 1)) - (t actions)))) - -;;; Trashing files -;; -(defun helm-ff-trash-action (fn names &rest args) - "Execute a trash action FN on marked files. - -Arg NAMES is a list of strings to pass to messages. -E.g. \\='(\"delete\" \"deleting\") - -ARGS are other arguments to be passed to FN." - (let ((mkd (helm-marked-candidates)) - errors aborted) - (with-helm-display-marked-candidates - helm-marked-buffer-name - (if (and args (string= (car names) "restore")) - (cl-loop for f in mkd - for bd = (helm-basename f) - for assoc = (assoc bd (car args)) - when assoc - collect (concat (truncate-string-to-width - (car assoc) 40 nil nil t) - " -> " - (truncate-string-to-width - (helm-basedir (cdr assoc)) 40 nil nil t))) - (helm-ff--count-and-collect-dups (mapcar 'helm-basename mkd))) - (if (y-or-n-p (format "%s %s files from trash? " - (capitalize (car names)) - (length mkd))) - (progn - (message "%s files from trash..." (capitalize (cadr names))) - (cl-loop for f in mkd do - (condition-case err - (apply fn f args) - (error (push (format "%s" (cadr err)) errors) - nil)))) - (message "%s files from trash aborted" (capitalize (cadr names))) - (setq aborted t))) - ;; Handle errors from outside the - ;; with-helm-display-marked-candidates block otherwise warning is - ;; never displayed. - (if errors - (progn - (display-warning 'helm - (with-temp-buffer - (insert (format-time-string "%Y-%m-%d %H:%M:%S\n" - (current-time))) - (insert (format - "Failed to %s %s/%s files from trash\n" - (car names) (length errors) (length mkd))) - (insert (mapconcat 'identity errors "\n") "\n ") - (buffer-string)) - :error - "*helm restore warnings*") - (message "%s files from trash aborted" (capitalize (cadr names)))) - (unless aborted - (message "%s %s files from trash done" - (capitalize (cadr names)) (length mkd)))))) - -(defun helm-ff-trash-rm (_candidate) - "Delete marked-files from a Trash directory. - -The Trash directory should be a directory compliant with - and each -file should have its \\='*.trashinfo' correspondent file in -Trash/info directory." - (helm-ff-trash-action 'helm-ff-trash-rm-1 '("delete" "deleting"))) - -(defun helm-ff-trash-rm-1 (file) - (let ((info-file (concat (helm-reduce-file-name file 2) - "info/" (helm-basename file "trashinfo") - ".trashinfo"))) - (cl-assert (file-exists-p file) - nil (format "No such file or directory `%s'" - file)) - (cl-assert (file-exists-p info-file) - nil (format "No such file or directory `%s'" - info-file)) - (if (file-directory-p file) - (delete-directory file t) - (delete-file file)) - (delete-file info-file))) - -(defun helm-restore-file-from-trash (_candidate) - "Restore marked-files from a Trash directory. - -The Trash directory should be a directory compliant with - and each -file should have its \\='*.trashinfo' corresponding file in -Trash/info directory." - (let* ((default-directory (file-name-as-directory - helm-ff-default-directory)) - (trashed-files (helm-ff-trash-list))) - (helm-ff-trash-action 'helm-restore-file-from-trash-1 - '("restore" "restoring") - trashed-files))) - -(defun helm-restore-file-from-trash-1 (file trashed-files) - "Restore FILE from a trash directory. -Arg TRASHED-FILES is an alist of (fname_in_trash . dest) obtained -with `helm-ff-trash-list'." - ;; Emacs trash duplicate files with a unique name + .trashinfo in - ;; the filename which is wrong, only files in info directory should - ;; end with .trashinfo, so fix the filename before looking for dest name. - (let* ((fname (replace-regexp-in-string "\\.trashinfo\\'" "" file)) - (info-file (concat (helm-reduce-file-name fname 2) - "info/" - (helm-basename fname) - ".trashinfo")) - (dest-file (helm-ff--get-dest-file-from-trash - trashed-files fname))) - (cl-assert (not (file-exists-p dest-file)) nil - (format "File `%s' already exists" dest-file)) - (cl-assert dest-file nil "No such file in trash") - (message "Restoring %s to %s..." (helm-basename file) (helm-basedir dest-file)) - (rename-file file dest-file) - (message "Restoring %s to %s done" (helm-basename file) (helm-basedir dest-file)) - (delete-file info-file))) - -(defun helm-ff-trash-file-p (file) - "Return t when FILE is a trashed file." - (and (file-exists-p file) - (string-match helm-ff--trash-directory-regexp (helm-basedir file)) - (not (member (helm-basename file) '("." ".."))))) - -(defun helm-ff--get-dest-file-from-trash (trashed-files file) - (assoc-default (helm-basename file) trashed-files)) - -(cl-defun helm-ff-trash-list (&optional (trash-dir nil strash-dir)) - "Return an alist of trashed files basename and dest name. -Assume the trash system in use is freedesktop compatible, see - -This function is intended to be used from a trash directory i.e. it -use `helm-ff-default-directory', but it may be used elsewhere by -specifying the trash directory with TRASH-DIR arg." - (unless (or (fboundp 'system-move-file-to-trash) - (and strash-dir (null trash-dir))) - ;; Files owned by root are trashed in /root/.local/share/Trash. - ;; Files owned by user and trashed by root are trashed in - ;; /home/.Trash. - ;; Files owned by user and trashed by user are trashed in - ;; ~/.local/share/Trash. - (cl-loop for f in (directory-files - (expand-file-name - ;; helm-ff-default-directory is currently the - ;; trash directory. - "info" (helm-basedir (directory-file-name - (or trash-dir helm-ff-default-directory)))) - t directory-files-no-dot-files-regexp) - collect (cons (helm-basename (replace-regexp-in-string "\\.trashinfo\\'" "" f)) - (with-temp-buffer - (save-excursion - (insert-file-contents f)) - (when (re-search-forward "^path=" nil t) - (let ((path (helm-url-unhex-string - (buffer-substring-no-properties - (point) (pos-eol))))) - (if (string-match "\\`/" path) - ;; path is absolute - path - ;; When path is relative, assume the - ;; trash directory is located at - ;; /home/.Trash and path is the - ;; relative name of file from /home. - (expand-file-name path "/home"))))))))) - -(defun helm-ff-goto-linum (candidate) - "Find file CANDIDATE and maybe jump to line number found in fname at point. -Line number should be added at end of fname preceded with \":\". -E.g. \"foo:12\"." - (let ((linum (with-helm-current-buffer - (let ((str (buffer-substring-no-properties - (pos-bol) (pos-eol)))) - (when (string-match ":\\([0-9]+:?\\)" str) - (match-string 1 str)))))) - (find-file candidate) - (and linum (not (string= linum "")) - (helm-goto-line (string-to-number linum) t)))) - -(defun helm-ff-mail-attach-files (_candidate) - "Run `mml-attach-file' on `helm-marked-candidates'." - (require 'mml) - (let ((flist (helm-marked-candidates :with-wildcard t)) - (dest-buf (and (derived-mode-p 'message-mode 'mail-mode) - (current-buffer))) - bufs) - (unless dest-buf - (setq bufs (cl-loop for b in (buffer-list) - when (with-current-buffer b - (derived-mode-p 'message-mode 'mail-mode)) - collect (buffer-name b))) - (if (and bufs (y-or-n-p "Attach files to existing mail composition buffer? ")) - (setq dest-buf - (if (cdr bufs) - (helm-comp-read "Attach to buffer: " bufs :nomark t) - (car bufs))) - (compose-mail) - (setq dest-buf (current-buffer)))) - (switch-to-buffer dest-buf) - (save-restriction - (widen) - (save-excursion - (goto-char (point-max)) - (cl-loop for f in flist - do (mml-attach-file f (or (mm-default-file-encoding f) - "application/octet-stream"))))))) - -(defvar image-dired-display-image-buffer) -(defun helm-ff-rotate-current-image-1 (file angle) - "Rotate current image at ANGLE degrees." - (cl-assert (and (file-exists-p file) - (string-match (image-file-name-regexp) file)) - nil "Can't rotate non image file") - (setq file (file-truename file)) ; For symlinked images. - (let ((default-directory (file-name-directory file)) - (basename (helm-basename file)) - ;; convert ANGLE to a suitable value for exiftran. - (num-arg (if (string= helm-ff-rotate-image-program "exiftran") - (cl-case angle - (90 "-9") ; 90 clockwise - (270 "-2")) ; 270 clockwise == -90 - (number-to-string angle))) - rotation-failed) - ;; Try to rotate image with exiftran even with helm-ff-display-image-native. - (if (and helm-ff-rotate-image-program - (executable-find helm-ff-rotate-image-program)) - (apply #'process-file helm-ff-rotate-image-program nil nil nil - (append helm-ff-rotate-image-switch - (list num-arg basename))) - (setq rotation-failed t)) - ;; Display image in image-mode. - (if (helm-ff-display-image-native-p) - (if rotation-failed - ;; When rotation fails fallback to `image-rotate' with no - ;; transformation of file. - (with-selected-window (helm-persistent-action-display-window) - (condition-case _err - (with-no-warnings (image-rotate angle)) - (wrong-number-of-arguments (image-rotate)))) - (helm-ff--display-image-native file)) - ;; Use image-dired to display image. - (when rotation-failed - (error "%s not found" (or helm-ff-rotate-image-program - "`helm-ff-rotate-image-program'"))) - (when (buffer-live-p image-dired-display-image-buffer) - (kill-buffer image-dired-display-image-buffer)) - (image-dired-display-image basename) - (message nil) - (display-buffer (get-buffer image-dired-display-image-buffer))))) - -(defun helm-ff-rotate-image-left (candidate) - "Rotate image file CANDIDATE left. -This affects directly file CANDIDATE." - (helm-ff-rotate-current-image-1 candidate 270)) - -(defun helm-ff-rotate-image-right (candidate) - "Rotate image file CANDIDATE right. -This affects directly file CANDIDATE." - (helm-ff-rotate-current-image-1 candidate 90)) - -(defun helm-ff-rotate-left-persistent () - "Rotate image left without quitting helm." - (interactive) - (with-helm-alive-p - (helm-set-attr 'image-action1 'helm-ff-rotate-image-left) - (helm-execute-persistent-action 'image-action1))) -(put 'helm-ff-rotate-left-persistent 'helm-only t) - -(defun helm-ff-rotate-right-persistent () - "Rotate image right without quitting helm." - (interactive) - (with-helm-alive-p - (helm-set-attr 'image-action2 'helm-ff-rotate-image-right) - (helm-execute-persistent-action 'image-action2))) -(put 'helm-ff-rotate-right-persistent 'helm-only t) - -(defun helm-ff-resize-image-1 (arg) - ;; `image-decrease-size' and `image-increase-size' are not usable - ;; because they run directly `image--change-size' in a timer without - ;; taking care of the selected-window. - (cl-assert (and (fboundp 'image--change-size) - (helm-ff-display-image-native-p)) - nil "Resizing image not available") - (if (> arg 0) - (helm-ff--image-change-size 1.2) - (helm-ff--image-change-size 0.8))) - -(defun helm-ff--image-change-size (factor) - (run-with-idle-timer - 0.3 nil - (lambda () - (with-selected-window (helm-persistent-action-display-window) - (image--change-size factor))))) - -(defun helm-ff-increase-image-size (_candidate) - (helm-ff-resize-image-1 1)) - -(defun helm-ff-decrease-image-size (_candidate) - (helm-ff-resize-image-1 -1)) - -(defun helm-ff-increase-image-size-persistent () - "Increase image size without quitting helm." - (interactive) - (with-helm-alive-p - (helm-set-attr 'image-action3 'helm-ff-increase-image-size) - (helm-execute-persistent-action 'image-action3))) -(put 'helm-ff-increase-image-size-persistent 'helm-only t) - -(defun helm-ff-decrease-image-size-persistent () - "Decrease image size without quitting helm." - (interactive) - (with-helm-alive-p - (helm-set-attr 'image-action4 'helm-ff-decrease-image-size) - (helm-execute-persistent-action 'image-action4))) -(put 'helm-ff-decrease-image-size-persistent 'helm-only t) - -(defun helm-ff-exif-data (candidate) - "Extract exif data from file CANDIDATE using `helm-ff-exif-data-program'." - (if (and helm-ff-exif-data-program - (executable-find helm-ff-exif-data-program)) - (shell-command-to-string (format "%s %s %s" - helm-ff-exif-data-program - helm-ff-exif-data-program-args - candidate)) - (format "No program %s found to extract exif" - helm-ff-exif-data-program))) - -(defvar helm-ff-image-native-buffer "*image-native-display*") - -(defvar helm-ff-sound-file-extensions '("wav" "au")) - -(defun helm-ff--maybe-follow (candidate) - (let ((file (if helm-ff-ignore-following-on-directory - (file-exists-p candidate) - (file-regular-p candidate))) - (image (string-match-p (image-file-name-regexp) candidate)) - (ext (file-name-extension candidate))) - (and file - (or image (not (member ext helm-ff-follow-blacklist-file-exts)))))) - -(cl-defun helm-find-files-persistent-action-if (candidate) - "Open subtree CANDIDATE without quitting helm. -If CANDIDATE is not a directory expand CANDIDATE filename. -If CANDIDATE is alone, open file CANDIDATE filename. -That means: -First hit on C-j expands CANDIDATE, second hit opens file. -If a prefix arg is given or `helm-follow-mode' is on, then open -file." - (let* ((follow (or (helm-follow-mode-p) - helm--temp-follow-flag)) - (image-cand (string-match-p (image-file-name-regexp) candidate)) - (sound-cand (member (file-name-extension candidate) - helm-ff-sound-file-extensions)) - (selection (helm-get-selection)) - (insert-in-minibuffer (lambda (fname) - (with-selected-window (or (active-minibuffer-window) - (minibuffer-window)) - (unless follow - (delete-minibuffer-contents) - (set-text-properties 0 (length fname) - nil fname) - ;; Backup files have "!" to replace "/" - ;; in their basenames. - (insert (replace-regexp-in-string - "/!" "/\\\\!" fname))))))) - (helm-set-attr 'candidate-number-limit helm-ff-candidate-number-limit) - (unless (helm-ff--maybe-follow candidate) - (when follow - (helm-follow-mode -1) (message nil) - (cl-return-from helm-find-files-persistent-action-if - (prog1 - #'ignore - (user-error "Can't follow this kind of file"))))) - (cond (;; Tramp methods completion. - (string-match helm-ff-tramp-method-regexp candidate) - (let ((method (match-string 1 candidate))) - (cons (lambda (candidate) - (funcall insert-in-minibuffer - (if (helm-ff--tramp-multihops-p candidate) - (concat (match-string 1 candidate) method ":") - (concat "/" method ":")))) - 'never-split))) - ((and (helm-ff--invalid-tramp-name-p) - (string-match helm-tramp-file-name-regexp candidate)) - (cons (lambda (_candidate) - ;; First hit insert hostname and - ;; second hit insert ":" and expand. - (if (string= candidate helm-pattern) - (funcall insert-in-minibuffer (concat candidate ":")) - (funcall insert-in-minibuffer candidate))) - 'never-split)) - (;; A symlink directory, expand it but not to its truename - ;; unless a prefix arg is given. - (and (file-directory-p candidate) (file-symlink-p candidate)) - (cons (lambda (_candidate) - (helm-ff-after-persistent-show-all) - (let ((new-dir (file-name-as-directory - (if current-prefix-arg - (file-truename (expand-file-name candidate)) - (expand-file-name candidate))))) - (setq helm-ff--show-thumbnails - (member new-dir helm-ff--thumbnailed-directories)) - (funcall insert-in-minibuffer new-dir))) - 'never-split)) - ;; A directory, open it. - ((file-directory-p candidate) - (cons (lambda (_candidate) - (helm-ff-after-persistent-show-all) - (when (string= (helm-basename candidate) "..") - (setq helm-ff-last-expanded helm-ff-default-directory)) - (let ((new-dir (file-name-as-directory - (expand-file-name candidate)))) - (setq helm-ff--show-thumbnails - (member new-dir helm-ff--thumbnailed-directories)) - (funcall insert-in-minibuffer new-dir)) - (with-helm-after-update-hook (helm-ff-retrieve-last-expanded))) - 'never-split)) - ;; A symlink file, expand to it's true name. (first hit) - ((and (file-symlink-p candidate) (not current-prefix-arg) (not follow)) - (cons (lambda (_candidate) - (funcall insert-in-minibuffer (file-truename candidate)) - (helm-check-minibuffer-input)) ; Force update. - 'never-split)) - ;; A regular file, expand it, (first hit) - ((and (not (file-equal-p selection helm-pattern)) - (not current-prefix-arg) (not follow)) - (cons (lambda (_candidate) - (funcall insert-in-minibuffer selection) - (helm-check-minibuffer-input)) ; Force update. - 'never-split)) - (sound-cand (lambda (candidate) (play-sound-file candidate))) - ;; An image file and it is the second hit on C-j, display it. - (image-cand - (if (helm-ff-display-image-native-p) - #'helm-ff--display-or-kill-image-native - (lambda (_candidate) - (require 'image-dired) - (let* ((win (get-buffer-window - image-dired-display-image-buffer 'visible)) - (fname (and win - (with-selected-window win - (get-text-property (point-min) - 'original-file-name)))) - (remove-buf-only (and win - fname - (with-helm-buffer - (file-equal-p candidate fname))))) - (when remove-buf-only - (with-helm-window - (if (and helm-persistent-action-display-window - (window-dedicated-p (next-window win 1))) - (delete-window helm-persistent-action-display-window) - (set-window-buffer win helm-current-buffer)))) - (when (buffer-live-p (get-buffer image-dired-display-image-buffer)) - (kill-buffer image-dired-display-image-buffer)) - (unless remove-buf-only - ;; Fix emacs bug never fixed upstream. - (unless (file-directory-p image-dired-dir) - (make-directory image-dired-dir)) - (switch-to-buffer image-dired-display-image-buffer) - (message "Resizing image...") - (cl-letf (((symbol-function 'message) #'ignore)) - (image-dired-display-image candidate)) - (message "Resizing image done") - (with-current-buffer image-dired-display-image-buffer - (let ((exif-data (helm-ff-exif-data candidate))) - (setq default-directory helm-ff-default-directory) - (image-dired-update-property 'help-echo exif-data)))))))) - ;; Allow browsing archive on avfs fs. - ;; Assume volume is already mounted with mountavfs. - ((helm-aand helm-ff-avfs-directory - (file-name-directory candidate) - (string-match - (regexp-quote (expand-file-name helm-ff-avfs-directory)) - it) - (helm-ff-file-compressed-p candidate)) - (cons (lambda (_candidate) - (funcall insert-in-minibuffer (concat candidate "#/"))) - 'never-split)) - ;; File is not existing and have no basedir, typically when - ;; user hit C-k (minibuffer is empty) and then write foo and - ;; hit C-j. This make clear that when no basedir, helm will - ;; create the file in default-directory. - ((and (not (file-exists-p candidate)) - (not (helm-basedir candidate))) - (cons (lambda (_candidate) - (funcall insert-in-minibuffer - (expand-file-name candidate default-directory))) - 'never-split)) - ;; On second hit we open file. - ;; On Third hit we kill it's buffer maybe. - (t - (lambda (candidate) - (funcall helm-ff-kill-or-find-buffer-fname-fn candidate)))))) - -;; Native image display (with image-mode). -;; -(defvar helm-ff--image-cache nil) - -(defun helm-ff-display-image-native-p () - "Use `helm-ff-display-image-native' when returns `t'." - (or helm-ff-display-image-native - ;; Image-dired in emacs-29 uses image-mode but - ;; display is no more working with our old - ;; image-dired code, so force usage of - ;; helm-ff-display-image-native. - (fboundp 'image-dired-display-image-mode))) - -(defun helm-ff--display-or-kill-image-native (candidate) - ;; Display images in same buffer - ;; `helm-ff-image-native-buffer'. - (if (and (buffer-live-p (get-buffer helm-ff-image-native-buffer)) - (file-equal-p (buffer-file-name - (get-buffer helm-ff-image-native-buffer)) - candidate) - ;; Allow redisplaying - ;; `helm-ff-image-native-buffer' when it - ;; already exists and display same image as candidate. - (get-buffer-window helm-ff-image-native-buffer 'visible)) - (progn - (set-window-buffer - helm-persistent-action-display-window helm-current-buffer) - (kill-buffer helm-ff-image-native-buffer)) - (helm-ff--display-image-native candidate))) - -(defun helm-ff-clean-image-cache () - (when helm-ff--image-cache - (cl-loop for img in helm-ff--image-cache - do (clear-image-cache img) - finally do (setq helm-ff--image-cache nil)))) - -(defun helm-ff--display-image-native (candidate) - (when (string-match-p (image-file-name-regexp) candidate) - (when (buffer-live-p (get-buffer helm-ff-image-native-buffer)) - (kill-buffer helm-ff-image-native-buffer)) - ;; Avoid hight memory consumption see - ;; https://lists.gnu.org/archive/html/bug-gnu-emacs/2021-11/msg00879.html. - (when (> (length helm-ff--image-cache) - (* helm-ff-image-cache-max-len 2)) - ;; Only keep the last `helm-ff-image-cache-max-len' images in cache. - (cl-loop for img in (butlast helm-ff--image-cache - (1+ helm-ff-image-cache-max-len)) - do (clear-image-cache img) - (setq helm-ff--image-cache - (delete img helm-ff--image-cache)))) - (cl-letf* (((symbol-function 'message) #'ignore) - (buf (find-file-noselect candidate t))) - ;; When going back reuse the cached images. - (unless (member candidate helm-ff--image-cache) - (setq helm-ff--image-cache - (append helm-ff--image-cache - (list (expand-file-name candidate))))) - (with-current-buffer buf - (rename-buffer helm-ff-image-native-buffer)) - (display-buffer buf)))) - -;;; Slideshow action -;; -(defvar helm-ff--slideshow-iterator nil) -(defvar helm-ff--slideshow-sequence nil) -(defvar helm-ff--slideshow-in-pause nil) -(defvar helm-ff-slideshow-helper - "Type `\\[helm-ff-slideshow-pause-or-restart]' to %s, \ -`\\[helm-ff-slideshow-next]' for next, `\\[helm-ff-slideshow-previous]' for previous, \ -`\\[helm-ff-slideshow-quit]' to quit") - -(defvar helm-slideshow-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map image-mode-map) - (define-key map (kbd "SPC") 'helm-ff-slideshow-pause-or-restart) - (define-key map (kbd "q") 'helm-ff-slideshow-quit) - (define-key map (kbd "n") 'helm-ff-slideshow-next) - (define-key map (kbd "p") 'helm-ff-slideshow-previous) - map)) - -(define-derived-mode helm-slideshow-mode - image-mode "helm-image-mode" - "Mode to display images from helm-find-files. - -Special commands: -\\{helm-slideshow-mode-map} -") -(put 'helm-slideshow-mode 'no-helm-mx t) - -(defun helm-ff-slideshow-help-string (counter-string state) - (concat counter-string - (substitute-command-keys - (format helm-ff-slideshow-helper state)))) - -(defun helm-ff-start-slideshow-on-marked (_candidate) - "Start a slideshow on marked files." - (let ((marked (helm-remove-if-not-match - (image-file-name-regexp) - (helm-marked-candidates :with-wildcard t)))) - (cl-assert (cdr marked) nil "Can't start a slideshow on a single file") - (setq helm-ff--slideshow-sequence marked) - (setq helm-ff--slideshow-iterator (helm-iter-circular marked)) - (helm-ff--display-image-native (helm-iter-next helm-ff--slideshow-iterator)) - (delete-other-windows (get-buffer-window helm-ff-image-native-buffer)) - (cl-letf (((symbol-function 'message) #'ignore)) - (helm-slideshow-mode)) - (setq mode-line-format (helm-ff-slideshow-help-string - (format "(1/%s) " (length marked)) "pause")) - (helm-ff-slideshow-loop helm-ff--slideshow-iterator))) - -(defun helm-ff-slideshow-state () - (format "(%s/%s) " - (1+ (helm-position - (buffer-file-name) helm-ff--slideshow-sequence - :test 'equal)) - (length helm-ff--slideshow-sequence))) - -(defun helm-ff-slideshow-sequence-from-current (&optional reverse) - (helm-reorganize-sequence-from-elm - helm-ff--slideshow-sequence (buffer-file-name) reverse)) - -(defun helm-ff-slideshow-loop (iterator &optional restart) - (while (sit-for helm-ff-slideshow-default-delay) - (helm-ff--display-image-native (helm-iter-next iterator)) - (delete-other-windows (get-buffer-window helm-ff-image-native-buffer)) - (cl-letf (((symbol-function 'message) #'ignore)) - (helm-slideshow-mode)) - (when restart - (message "Helm Slideshow started") - (sit-for 1) - (message nil) - (setq restart nil)) - (setq mode-line-format - (helm-ff-slideshow-help-string - (helm-ff-slideshow-state) "pause")))) - -(defun helm-ff-slideshow-pause-or-restart () - (interactive) - (setq helm-ff--slideshow-in-pause (not helm-ff--slideshow-in-pause)) - (if helm-ff--slideshow-in-pause - (setq mode-line-format (helm-ff-slideshow-help-string nil "restart")) - (message "Helm Slideshow restarting...") - (setq helm-ff--slideshow-iterator - (helm-iter-circular (helm-ff-slideshow-sequence-from-current))) - (helm-ff-slideshow-loop helm-ff--slideshow-iterator 'restart))) -(put 'helm-ff-slideshow-pause-or-restart 'no-helm-mx t) - -(defun helm-ff-slideshow-next () - (interactive) - (setq helm-ff--slideshow-in-pause t) - (setq helm-ff--slideshow-iterator nil) - (helm-ff--display-image-native - (car (helm-ff-slideshow-sequence-from-current))) - (delete-other-windows (get-buffer-window helm-ff-image-native-buffer)) - (cl-letf (((symbol-function 'message) #'ignore)) - (helm-slideshow-mode)) - (message (concat (helm-ff-slideshow-state) - (substitute-command-keys - (format helm-ff-slideshow-helper "restart"))))) -(put 'helm-ff-slideshow-next 'no-helm-mx t) - -(defun helm-ff-slideshow-previous () - (interactive) - (setq helm-ff--slideshow-in-pause t) - (setq helm-ff--slideshow-iterator nil) - (helm-ff--display-image-native - (car (helm-ff-slideshow-sequence-from-current 'reverse))) - (delete-other-windows (get-buffer-window helm-ff-image-native-buffer)) - (cl-letf (((symbol-function 'message) #'ignore)) - (helm-slideshow-mode)) - (message (concat (helm-ff-slideshow-state) - (substitute-command-keys - (format helm-ff-slideshow-helper "restart"))))) -(put 'helm-ff-slideshow-previous 'no-helm-mx t) - -(defun helm-ff-slideshow-quit () - (interactive) - (setq helm-ff--slideshow-iterator nil) - (setq helm-ff--slideshow-in-pause nil) - (helm-ff-clean-image-cache) - (quit-window)) -(put 'helm-ff-slideshow-quit 'no-helm-mx t) - -;;; Thumbnails view -;; -(defun helm-ff-maybe-show-thumbnails (candidates _source) - (require 'image-dired) - (if (and helm-ff--show-thumbnails - (null (file-remote-p helm-ff-default-directory))) - (prog1 - (cl-loop with scale = (image-compute-scaling-factor nil) - for (disp . img) in candidates - for type = (helm-acase (file-name-extension img) - ((guard* (and (member it '("png" "jpg" "jpeg")) - (memq image-dired-thumbnail-storage - '(standard standard-large)))) - 'png) - (("jpg" "jpeg") 'jpeg) - ("png" 'png)) - if type collect - (let ((thumbnail (plist-get - (cdr (helm-ff--image-dired-get-thumbnail-image - img type scale)) - :file))) - ;; When icons are displayed the leading space handling disp - ;; prop is already here, just replace icon with the thumbnail. - (unless helm-ff-icon-mode (setq disp (concat " " disp))) - (add-text-properties 0 1 `(display (image - :type ,type - :margin 5 - :file ,thumbnail) - rear-nonsticky '(display)) - disp) - (cons disp img)) - else collect (cons disp img)) - ;; Ensure this is done AFTER previous clause otherwise thumb files will - ;; never be created if they don't already exist. - (cl-pushnew helm-ff-default-directory - helm-ff--thumbnailed-directories :test 'equal)) - candidates)) - -;; Same as `image-dired-get-thumbnail-image' but use -;; `helm-ff--image-dired-thumb-name' which cache thumbnails for further use. -(defun helm-ff--image-dired-get-thumbnail-image (file &optional type scale) - "Return the image descriptor for a thumbnail of image file FILE." - (unless (string-match-p (image-file-name-regexp) file) - (error "%s is not a valid image file" file)) - (let* ((thumb-file (helm-ff--image-dired-thumb-name file)) - thumb-attr) - ;; Don't check status of files with `file-attributes' if it has already been - ;; done in this session. - (when (and (not (member helm-ff-default-directory - helm-ff--thumbnailed-directories)) - (or (not (setq thumb-attr (file-attributes thumb-file))) - (time-less-p (file-attribute-modification-time thumb-attr) - (file-attribute-modification-time - (file-attributes file))))) - (image-dired-create-thumb file thumb-file)) - (create-image thumb-file type nil :scale scale))) - -(defvar helm-ff-image-dired-thumbnails-cache (make-hash-table :test 'equal) - "Store associations of image_file/thumbnail_file.") -(defun helm-ff--image-dired-thumb-name (file) - (or (gethash file helm-ff-image-dired-thumbnails-cache) - (let ((thumb-name (image-dired-thumb-name file))) - (puthash file thumb-name helm-ff-image-dired-thumbnails-cache) - thumb-name))) - -(defun helm-ff-toggle-thumbnails () - (interactive) - (cl-assert (null (file-remote-p helm-ff-default-directory)) - nil "Thumbnails show not supported on remote files") - (setq helm-ff--show-thumbnails (not helm-ff--show-thumbnails)) - (when helm-ff--show-thumbnails - (message "Loading thumbnails...") - (with-helm-after-update-hook - (message "Loading thumbnails done"))) - (when (and (null helm-ff--show-thumbnails) - (member helm-ff-default-directory - helm-ff--thumbnailed-directories)) - (setq helm-ff--thumbnailed-directories - (delete helm-ff-default-directory helm-ff--thumbnailed-directories))) - (helm-force-update (regexp-quote (replace-regexp-in-string - "\\`[[:multibyte:] ]*" "" - (helm-get-selection nil t))))) -(put 'helm-ff-toggle-thumbnails 'no-helm-mx t) - -;;;###autoload -(defun helm-ff-clear-image-dired-thumbnails-cache () - "Clear `helm-ff-image-dired-thumbnails-cache'. -You may want to do this after customizing -`image-dired-thumbnail-storage' which may change the place where -thumbnail files are stored." - (interactive) - (clrhash helm-ff-image-dired-thumbnails-cache)) - -;;;###autoload -(defun helm-ff-cleanup-image-dired-dir-and-cache () - "Cleanup `image-dired-dir' directory. -Delete all thumb files that are no more associated with an existing -image file in `helm-ff-image-dired-thumbnails-cache'." - (interactive) - (cl-loop for key being the hash-keys in helm-ff-image-dired-thumbnails-cache - using (hash-value val) - unless (file-exists-p key) do - (progn - (message "Deleting %s" val) - (delete-file val) - (remhash key helm-ff-image-dired-thumbnails-cache)))) - -;;; Recursive dirs completion -;; -(defun helm-find-files-recursive-dirs (directory &optional input) - (when (string-match "\\([.]\\)\\{2\\}" input) - (setq input (replace-match "" nil t input))) - (message "Recursively searching %s from %s ..." - input (abbreviate-file-name directory)) - ;; Ensure to not create a new frame - (let (helm-actions-inherit-frame-settings) - (helm :sources - (helm-make-source - "Recursive directories" 'helm-locate-subdirs-source - :header-name - (lambda (name) - (format "%s from `%s'" - name - (abbreviate-file-name helm-ff-default-directory))) - :basedir (if (string-match-p - "\\`es" helm-locate-recursive-dirs-command) - directory - (shell-quote-argument directory)) - :subdir (shell-quote-argument input) - :candidate-transformer - `(,(lambda (candidates) - (cl-loop for c in candidates - when (and (file-directory-p c) - (null (helm-boring-directory-p - c helm-boring-file-regexp-list)) - (string-match-p (regexp-quote input) - (helm-basename c))) - collect (propertize c 'face 'helm-ff-dirs))) - helm-w32-pathname-transformer - ,(lambda (candidates) - (helm-ff-sort-candidates-1 candidates input))) - :persistent-action 'ignore - :action (lambda (c) - (helm-set-pattern - (file-name-as-directory (expand-file-name c))))) - :candidate-number-limit 999999 - :allow-nest t - :resume 'noresume - :ff-transformer-show-only-basename nil - :buffer "*helm recursive dirs*"))) - -(defun helm-ff-recursive-dirs (_candidate) - "Launch a recursive search in `helm-ff-default-directory'." - (with-helm-default-directory helm-ff-default-directory - (helm-find-files-recursive-dirs - default-directory - (helm-basename (helm-get-selection))))) - -(defun helm-ff-file-compressed-p (candidate) - "Whether CANDIDATE is a compressed file or not." - (member (file-name-extension candidate) - helm-ff-file-compressed-list)) - -(defun helm-ff--fname-at-point () - "Try to guess fname at point." - (let ((end (point)) - (limit (helm-aif (bounds-of-thing-at-point 'filename) - (car it) - (point)))) - (save-excursion - (while (re-search-backward "\\(~\\|/\\|[[:lower:][:upper:]]:/\\)" - limit t)) - (buffer-substring-no-properties (point) end)))) - -(defun helm-insert-file-name-completion-at-point (_candidate) - "Insert file name completion at point. - -When completing i.e. there is already something at point, insert -filename abbreviated, relative or full according to initial -input, whereas when inserting i.e. there is nothing at point, -insert filename full, abbreviated or relative according to prefix -arg, respectively no prefix arg, one prefix arg or two prefix -arg." - (with-helm-current-buffer - (if buffer-read-only - (error "Error: Buffer `%s' is read-only" (buffer-name)) - (let* ((mkds (helm-marked-candidates :with-wildcard t)) - (candidate (car mkds)) - (end (point)) - (tap (helm-ffap-guesser)) - (guess (and (stringp tap) - (substring-no-properties tap))) - (beg (helm-aif (and guess - (save-excursion - (when (re-search-backward - (regexp-quote guess) - (pos-bol) t) - (point)))) - it (point))) - (full-path-p (and (stringp guess) - (or (string-match-p - (concat "^" (getenv "HOME")) - guess) - (string-match-p - "\\`\\(/\\|[[:lower:][:upper:]]:/\\)" - guess)))) - (escape-fn (if (memq major-mode - helm-modes-using-escaped-strings) - #'shell-quote-argument #'identity))) - (when (and beg end) - (delete-region beg end)) - (insert - (funcall - escape-fn - (helm-ff--format-fname-to-insert - candidate beg end full-path-p guess - helm-current-prefix-arg)) - (if (cdr mkds) " " "") - (mapconcat escape-fn - (cl-loop for f in (cdr mkds) - collect (helm-ff--format-fname-to-insert - f nil nil nil nil - helm-current-prefix-arg)) - " ")))))) - -(defun helm-ff--format-fname-to-insert (candidate - &optional beg end full-path guess prefarg) - (set-text-properties 0 (length candidate) nil candidate) - (if (and beg end guess (not (string= guess "")) - (null prefarg) - (or (string-match - "^\\(~/\\|/\\|[[:lower:][:upper:]]:/\\)" - guess) - (file-exists-p candidate))) - (cond (full-path - (expand-file-name candidate)) - ((string= (match-string 1 guess) "~/") - (abbreviate-file-name candidate)) - (t (file-relative-name candidate))) - (helm-acase prefarg - ((4) (abbreviate-file-name candidate)) - ((16) (file-relative-name candidate)) - ((64) (helm-basename candidate)) - (t candidate)))) - -(cl-defun helm-find-files-history (arg &key (comp-read t)) - "The `helm-find-files' history. -Show the first `helm-ff-history-max-length' elements of -`helm-ff-history' in an `helm-comp-read'." - (interactive "p") - (let ((history (when helm-ff-history - (helm-fast-remove-dups helm-ff-history - :test 'equal)))) - (when history - (setq helm-ff-history - (if (>= (length history) helm-ff-history-max-length) - (helm-take history helm-ff-history-max-length) - history)) - (if comp-read - (let ((src (helm-build-sync-source "Helm Find Files History" - :candidates helm-ff-history - :fuzzy-match (helm-ff--fuzzy-matching-p) - :persistent-action 'ignore - :migemo t - :action (lambda (candidate) - (if arg - (helm-set-pattern - (expand-file-name candidate)) - (identity candidate)))))) - (helm :sources src - :resume 'noresume - :buffer helm-ff-history-buffer-name - :allow-nest t)) - helm-ff-history)))) -(put 'helm-find-files-history 'helm-only t) - -;; The `helm-drag-mouse-1-fn' for helm-find-files, it is bound to -;; in `helm--bind-mouse-for-selection'. -;; See https://freedesktop.org/wiki/Specifications/XDND/ -;; and (info "(elisp) Drag and Drop") for more infos. -(defun helm-ff-mouse-drag (event) - "Drag-and-drop marked files at EVENT. - -It is the drag-an-drop function of dired adapted for helm-find-files." - (interactive "e") - (when mark-active (deactivate-mark)) - (let ((action helm-ff-drag-mouse-1-default-action)) - (save-excursion - (with-selected-window (posn-window (event-end event)) - (goto-char (posn-point (event-end event)))) - (track-mouse - (let ((beginning-position (mouse-pixel-position)) - new-event) - (catch 'track-again - (setq new-event (read-event)) - (if (not (eq (event-basic-type new-event) 'mouse-movement)) - (when (eq (event-basic-type new-event) 'mouse-1) - (push new-event unread-command-events)) - (let ((current-position (mouse-pixel-position))) - ;; If the mouse didn't move far enough, don't - ;; inadvertently trigger a drag. - (when (and (eq (car current-position) (car beginning-position)) - (ignore-errors - (and (> 3 (abs (- (cadr beginning-position) - (cadr current-position)))) - (> 3 (abs (- (caddr beginning-position) - (caddr current-position))))))) - (throw 'track-again nil))) - ;; We can get an error if there's by some chance no file - ;; name at point. - (condition-case error - (let ((files (with-helm-window (helm-marked-candidates)))) - (dnd-begin-drag-files files nil action t)) - (error (when (eq (event-basic-type new-event) 'mouse-1) - (push new-event unread-command-events)) - ;; Errors from `dnd-begin-drag-files' should be - ;; treated as user errors, since they should - ;; only occur when the user performs an invalid - ;; action, such as trying to create a link to - ;; a remote file. - (user-error (cadr error))))))))))) -(put 'helm-ff-mouse-drag 'helm-only t) - -(defvar helm-dnd-protocol-alist - '(("^file:///" . helm-dnd-handle-local-file) - ("^file://" . helm-dnd-handle-file) - ("^file:" . helm-dnd-handle-local-file)) - "The functions to call when dropping to helm-buffer. -Prevent dropping to helm buffer when user starts a drag-and-drop action -and release the mouse in this same buffer.") - -(defun helm-dnd-handle-local-file (_uri _action) - "Prevent dropping files to helm buffer." - (user-error "Can't drop files in helm buffer")) -(defun helm-dnd-handle-file (_uri _action) - "Prevent dropping files to helm buffer." - (user-error "Can't drop files in helm buffer")) - -;; This is used to advice `x-dnd-handle-drag-n-drop-event'. -(defun helm-ff--restore-frame (&rest _args) - (let ((hframe (window-frame (helm-window)))) - (if (eql (selected-frame) hframe) - (select-window (active-minibuffer-window)) - (select-frame hframe)))) - -(defun helm-find-files-1 (fname &optional preselect) - "Find FNAME filename with PRESELECT filename preselected. - -Use it for non-interactive calls of `helm-find-files'." - (require 'tramp) - (require 'dnd) - ;; Resolve FNAME now outside of helm. - ;; [FIXME] When `helm-find-files-1' is used directly from lisp - ;; and FNAME is an abbreviated path, for some reasons - ;; `helm-update' is called many times before resolving - ;; the abbreviated path (Bug#1939) so be sure to pass a - ;; full path to helm-find-files-1. - (unless (string-match-p helm-ff-url-regexp fname) - (setq fname (expand-file-name (substitute-in-file-name fname)))) - (when (get-buffer helm-action-buffer) - (kill-buffer helm-action-buffer)) - (setq helm-find-files--toggle-bookmark nil) - (let* ( ;; Be sure we don't erase the precedent minibuffer if some. - (helm-ff-auto-update-initial-value - (and helm-ff-auto-update-initial-value - (not (minibuffer-window-active-p (minibuffer-window))))) - (tap (thing-at-point 'filename)) - (def (and tap (or (file-remote-p tap) - (expand-file-name tap)))) - ;; Ensure not being prompted for password each time we - ;; navigate to a directory. - (password-cache t)) - (helm-set-local-variable 'helm-follow-mode-persistent nil) - (when (fboundp 'dnd-begin-drag-files) - (helm-set-local-variable 'helm-drag-mouse-1-fn 'helm-ff-mouse-drag - 'dnd-protocol-alist - (append helm-dnd-protocol-alist dnd-protocol-alist)) - (advice-add 'x-dnd-handle-drag-n-drop-event :after #'helm-ff--restore-frame)) - (unless helm-source-find-files - (setq helm-source-find-files (helm-make-source - "Find Files" 'helm-source-ffiles))) - (when (helm-get-attr 'follow helm-source-find-files) - (helm-set-attr 'follow -1 helm-source-find-files)) - ;; If preselected candidate is further than `helm-ff-candidate-number-limit' - ;; in the directory file list, we have to increase `candidate-number-limit' - ;; attr to have this candidate visible for preselection. - (when (and preselect helm-ff-dynamic-candidate-number-limit) - (helm-set-attr 'candidate-number-limit - (helm-aif (gethash fname helm-ff--directory-files-length) - (max it helm-ff-candidate-number-limit) - 99999) - helm-source-find-files)) - (helm-ff-setup-update-hook) - (add-hook 'helm-resume-after-hook 'helm-ff--update-resume-after-hook) - (unwind-protect - (helm :sources '(helm-source-find-files helm-find-files-dummy-source) - :input fname - :case-fold-search helm-file-name-case-fold-search - :preselect preselect - :ff-transformer-show-only-basename - helm-ff-transformer-show-only-basename - :dim-prompt-on-update helm-ff-dim-prompt-on-update - :default def - :prompt "Find files or url: " - :buffer "*helm find files*") - (helm-ff--update-resume-after-hook nil t) - (setq helm-ff-default-directory nil) - (advice-remove 'x-dnd-handle-drag-n-drop-event 'helm-ff--restore-frame)))) - -(defvar helm-find-files-dummy-source - (helm-build-dummy-source "New file or directory" - :filtered-candidate-transformer - (lambda (_candidates _source) - ;; Unquote helm-pattern maybe quoted by PA. - (unless (file-exists-p (replace-regexp-in-string "\\s\\" "" helm-pattern)) - (list (helm-ff-filter-candidate-one-by-one helm-pattern nil t)))) - :all-marked t - :keymap 'helm-find-files-map - :action 'helm-find-files-actions - :action-transformer 'helm-find-files-dummy-action-transformer)) - -(defun helm-find-files-dummy-action-transformer (actions candidate) - "Action transformer for `helm-find-files-dummy-source'." - (let (cand-no-linum linum) - (cond ((and helm--url-regexp - (not (string-match-p helm--url-regexp candidate)) - (string-match "\\(:[[:digit:]]+:?\\)\\'" candidate) - (file-exists-p - (setq cand-no-linum (replace-match "" t t candidate 1)))) - (setq linum (replace-regexp-in-string - ":" "" (match-string 1 candidate))) - (helm-append-at-nth - actions - `(("Find file to line number" - . ,(lambda (_candidate) - (find-file cand-no-linum) - (helm-goto-line (string-to-number linum) t)))) - 1)) - (t actions)))) - -(defun helm-ff--update-resume-after-hook (sources &optional nohook) - "Meant to be used in `helm-resume-after-hook'. -When NOHOOK is non-nil run inconditionally, otherwise only when -source is `helm-source-find-files'." - ;; When using the action `helm-find-files-load-files' on helm-files.el, - ;; `helm-source-find-files' is reseted to nil hence error when calling - ;; `helm-set-attr' outside helm => "no buffer named *helm*". - (unless helm-source-find-files - (setq helm-source-find-files (helm-make-source - "Find Files" 'helm-source-ffiles))) - (when (or nohook (string= "Find Files" - (assoc-default 'name (car sources)))) - (helm-set-attr 'resume `(lambda () - (helm-ff-setup-update-hook) - (setq helm-ff-default-directory - ,helm-ff-default-directory - helm-ff-last-expanded - ,helm-ff-last-expanded)) - helm-source-find-files))) - -(defun helm-ff-clean-initial-input () - ;; When using hff in an external frame initial input is printed in - ;; the minibuffer of initial-frame, delete it. - (with-selected-frame helm-initial-frame - (helm-clean-up-minibuffer))) - -(defun helm-ff-setup-update-hook () - (dolist (hook '(helm-ff-clean-initial-input ; Add to be called first. - helm-ff-update-when-only-one-matched - helm-ff-auto-expand-to-home-or-root)) - (add-hook 'helm-after-update-hook hook))) - -(defun helm-find-files-cleanup () - (mapc (lambda (hook) - (remove-hook 'helm-after-update-hook hook)) - '(helm-ff-auto-expand-to-home-or-root - helm-ff-update-when-only-one-matched - helm-ff-clean-initial-input)) - (maphash (lambda (k _v) - (when (member k helm-ff--thumbnailed-directories) - (remhash k helm-ff--list-directory-cache))) - helm-ff--list-directory-cache) - (setq helm-ff--show-directories-only nil - helm-ff--show-files-only nil - helm-ff--show-thumbnails nil - helm-ff--thumbnailed-directories nil) - (helm-ff-clean-image-cache)) - -(defun helm-ff-bookmark () - (helm :sources 'helm-source-bookmark-helm-find-files - :buffer "*helm ff bookmarks*")) - -(defun helm-find-files-switch-to-bookmark () - "Switch to helm-bookmark for `helm-find-files' from `helm-find-files.'" - (interactive) - (require 'helm-bookmark) - (with-helm-alive-p - (helm-run-after-exit 'helm-ff-bookmark))) -(put 'helm-find-files-switch-to-bookmark 'helm-only t) - -(defun helm-ff-bookmark-insert-location () - "Insert helm-find-files bookmark in minibuffer." - (interactive) - (require 'helm-bookmark) - (with-helm-alive-p - (helm :sources (helm-bookmark-build-source - "bookmark insert location" - 'helm-bookmark-helm-find-files-setup-alist - 'helm-source-in-buffer - :filtered-candidate-transformer - '(helm-adaptive-sort - helm-highlight-bookmark) - :action (lambda (candidate) - (with-selected-window (minibuffer-window) - (delete-minibuffer-contents) - (bookmark-insert-location candidate)))) - :buffer "*helm bookmark insert*" - :allow-nest t))) -(put 'helm-ff-bookmark-insert-location 'helm-only t) - -(defun helm-find-files-initial-input (&optional input) - "Return INPUT if present, otherwise try to guess it." - (let ((guesser (helm-acase (helm-ffap-guesser) - ("" nil) - (t it)))) - (unless (eq major-mode 'image-mode) - (if input - (if (or (file-remote-p input) - (string-match helm-ff-url-regexp input)) - input - (expand-file-name input)) - (helm-find-files-input - (if (and helm-ff-allow-non-existing-file-at-point - guesser - (not (string-match ffap-url-regexp guesser))) - ;; Keep the ability of jumping to numbered lines even - ;; when allowing non existing filenames at point. - (helm-aand guesser - (thing-at-point 'filename) - (replace-regexp-in-string - ":[0-9]+\\'" "" it)) - guesser) - (thing-at-point 'filename)))))) - -(defun helm-ffap-guesser () - "Same as `ffap-guesser' but without gopher and machine support." - (require 'ffap) - ;; Avoid "Stack overflow in regexp matcher" error - ;; in evil `ffap-guesser' by removing crap `ffap-gopher-at-point' - ;; (bug fixed in emacs-26 http://debbugs.gnu.org/cgi/bugreport.cgi?bug=25391) . - ;; `ffap-machine-at-point' have been removed too as it was anyway - ;; disabled with `ffap-machine-p-known' bound to 'reject. - ;; `ffap-file-at-point' can be neutralized with - ;; `helm-ff-guess-ffap-filenames' and `ffap-url-at-point' with - ;; `helm-ff-guess-ffap-urls' - ;; Note also that `ffap-url-unwrap-remote' can override these - ;; variables. - (let ((ffap-alist (and helm-ff-guess-ffap-filenames ffap-alist)) - (ffap-url-regexp helm--url-regexp)) - (if (eq major-mode 'dired-mode) - (let ((beg (save-excursion (dired-move-to-filename))) - (end (save-excursion (dired-move-to-end-of-filename t)))) - (helm-aif (and beg end (member (buffer-substring beg end) - '("." ".."))) - (concat (file-name-as-directory - (expand-file-name dired-directory)) - (car it)) - (dired-get-filename 'no-dir t))) - (let* ((beg (and (use-region-p) (region-beginning))) - (end (and (use-region-p) (region-end))) - (str (and beg end (buffer-substring-no-properties beg end))) - (ffap (or (helm-aand helm-ff-guess-ffap-urls ffap-url-regexp - (ffap-url-at-point) - (ffap-fixup-url it) - (and (string-match ffap-url-regexp it) it)) - (and helm-ff-guess-ffap-urls ffap-url-regexp - (fboundp 'ffap-fixup-email) ; Emacs-30 - (ffap-fixup-email (thing-at-point 'email))) - (ffap-file-at-point)))) - ;; Workaround emacs bugs: - ;; When the region is active and a file is detected - ;; `ffap-string-at-point' returns the region prefixed with - ;; "/", e.g. at a beginning of a patch (first bug) and make - ;; `file-remote-p' returning an error (second bug), so in such - ;; case returns the region itself instead of the region - ;; corrupted by ffap. - (if (and str ffap) str ffap))))) - -(defun helm-find-files-input (file-at-pt thing-at-pt) - "Try to guess a default input for `helm-find-files'." - (let* ((non-essential t) - (remp (or (and file-at-pt (file-remote-p file-at-pt)) - (and thing-at-pt (file-remote-p thing-at-pt)))) - (def-dir (helm-current-directory)) - (urlp (and file-at-pt helm--url-regexp - (string-match helm--url-regexp file-at-pt))) - (lib (when helm-ff-search-library-in-sexp - (helm-find-library-at-point))) - (hlink (helm-ff-find-url-at-point)) - (file-p (and file-at-pt - (not (string= file-at-pt "")) - (not remp) - (or (file-exists-p file-at-pt) - helm-ff-allow-non-existing-file-at-point) - (not urlp) - thing-at-pt - (not (string= thing-at-pt "")) - (file-exists-p - (file-name-directory - (expand-file-name thing-at-pt def-dir)))))) - (cond (lib) ; e.g we are inside a require sexp. - (hlink) ; String at point is an hyperlink. - (file-p ; a regular file - (and file-at-pt (if (not (member (helm-basename file-at-pt) - '("." ".."))) - (expand-file-name file-at-pt) - file-at-pt))) - (urlp (helm-html-decode-entities-string file-at-pt)) ; possibly an url or email. - ((and file-at-pt - (not remp) - (or helm-ff-allow-non-existing-file-at-point - (file-exists-p file-at-pt))) - (expand-file-name file-at-pt))))) - -(defun helm-ff-find-url-at-point () - "Try to find link to an url in text-property at point." - (let* ((he (get-text-property (point) 'help-echo)) - (ov (overlays-at (point))) - (ov-he (and ov (overlay-get - (car (overlays-at (point))) 'help-echo))) - (w3m-l (get-text-property (point) 'w3m-href-anchor)) - (nt-prop (get-text-property (point) 'nt-link))) - ;; Org link. - (when (and (stringp he) (string-match "^LINK: " he)) - (setq he (replace-match "" t t he))) - (cl-loop for i in (list he ov-he w3m-l nt-prop) - thereis (and (stringp i) helm--url-regexp (string-match helm--url-regexp i) i)))) - -(defun helm-find-library-at-point () - "Try to find library path at point. -Find inside `require' and `declare-function' sexp." - (require 'find-func) - (let* ((beg-sexp (save-excursion (search-backward "(" (pos-bol) t))) - (end-sexp (save-excursion (ignore-errors (end-of-defun)) (point))) - (sexp (and beg-sexp end-sexp - (buffer-substring-no-properties - (1+ beg-sexp) (1- end-sexp))))) - (ignore-errors - (cond (;; Should work only when point is on the use-package line - ;; i.e. first line of sexp otherwise it prevents matching - ;; urls with helm-find-files (bug #2469). - (and sexp (string-match "use-package +\\([^ )\n]+\\)" sexp)) - (find-library-name (match-string 1 sexp))) - ((and sexp (string-match "require +[']\\([^ )]+\\)" sexp)) - ;; If require use third arg, ignore it, - ;; always use library path found in `load-path'. - (find-library-name (match-string 1 sexp))) - ;; Assume declare-function sexps are on one line. - ((and sexp (string-match "declare-function .+? \"\\(?:ext:\\)?\\([^ )]+\\)\"" sexp)) - (find-library-name (match-string 1 sexp))) - (t nil))))) - - -;;; Handle copy, rename, symlink, relsymlink and hardlink from helm. -;; -;; -(defun helm-ff--valid-default-directory () - (with-helm-current-buffer - (cl-loop for b in (buffer-list) - for cd = (with-current-buffer b default-directory) - when (eq (car (file-attributes cd)) t) - return cd))) - -(cl-defun helm-dired-action (destination - &key action follow (files (dired-get-marked-files))) - "Execute ACTION on FILES to DESTINATION. -Where ACTION is a symbol that can be one of: -\\='copy', \\='rename', \\='symlink', \\='relsymlink', \\='hardlink' or \\='backup'. -Argument FOLLOW when non-nil specifies to follow FILES to -DESTINATION for the actions copy and rename." - (require 'dired-async) - (require 'dired-x) ; For dired-keep-marker-relsymlink - (when (get-buffer dired-log-buffer) (kill-buffer dired-log-buffer)) - ;; When default-directory in current-buffer is an invalid directory, - ;; (e.g buffer-file directory have been renamed somewhere else) - ;; be sure to use a valid value to give to dired-create-file. - ;; i.e start-process is creating a process buffer based on default-directory. - (let ((default-directory (helm-ff--valid-default-directory)) - (fn (cl-case action - (copy 'dired-copy-file) - (rename 'dired-rename-file) - (symlink 'make-symbolic-link) - (relsymlink 'dired-make-relative-symlink) - (hardlink 'dired-hardlink) - (backup 'backup-file))) - (marker (cl-case action - ((copy rename backup) dired-keep-marker-copy) - (symlink dired-keep-marker-symlink) - (relsymlink dired-keep-marker-relsymlink) - (hardlink dired-keep-marker-hardlink))) - (dirflag (and (= (length files) 1) - (file-directory-p (car files)) - (not (file-directory-p destination)))) - (dired-async-state (if (and (boundp 'dired-async-mode) - dired-async-mode) - 1 -1))) - (and follow (fboundp 'dired-async-mode) (dired-async-mode -1)) - ;; When dired-create-destination-dirs is available (emacs-27.1+) such error - ;; is handled later in dired-create-files. - (when (and (null (boundp 'dired-create-destination-dirs)) - (cdr files) (not (file-directory-p destination))) - (error "%s: target `%s' is not a directory" action destination)) - (unwind-protect - (dired-create-files - fn (symbol-name action) files - (if (file-directory-p destination) - ;; When DESTINATION is a directory, build file-name in this directory. - ;; Else we use DESTINATION. - (lambda (from) - (expand-file-name (file-name-nondirectory from) destination)) - (lambda (_from) destination)) - marker) - (and (fboundp 'dired-async-mode) - (dired-async-mode dired-async-state))) - (push (file-name-as-directory - (if (file-directory-p destination) - (expand-file-name destination) - (file-name-directory destination))) - helm-ff-history) - ;; If follow is non--nil we should not be in async mode. - (when (and follow - (not (memq action '(symlink relsymlink hardlink))) - (not (get-buffer dired-log-buffer))) - (let ((target (directory-file-name destination)) - (cands-to-mark (helm-get-dest-fnames-from-list files destination dirflag))) - (with-helm-after-update-hook (helm-ff-maybe-mark-candidates cands-to-mark)) - ;; Wait for the notify callback ends before calling HFF. - (run-at-time - 0.1 nil - (lambda () - (if (and dirflag (eq action 'rename)) - (helm-find-files-1 (file-name-directory target) - (format helm-ff-last-expanded-candidate-regexp - (if helm-ff-transformer-show-only-basename - (helm-basename target) target))) - (helm-find-files-1 (if (file-directory-p destination) - (file-name-as-directory - (expand-file-name destination)) - (expand-file-name (helm-basedir destination))) - (format helm-ff-last-expanded-candidate-regexp - (if helm-ff-transformer-show-only-basename - (helm-basename (car files)) - (car files))))))))))) - -(defun helm-get-dest-fnames-from-list (flist dest-cand rename-dir-flag) - "Transform filenames of FLIST to abs of DEST-CAND. -If RENAME-DIR-FLAG is non-nil collect the `directory-file-name' -of transformed members of FLIST." - ;; At this point files have been renamed/copied at destination. - ;; That's mean DEST-CAND exists. - (cl-loop - with dest = (expand-file-name dest-cand) - for src in flist - for basename-src = (helm-basename src) - for fname = (cond (rename-dir-flag (directory-file-name dest)) - ((file-directory-p dest) - (concat (file-name-as-directory dest) basename-src)) - (t dest)) - when (file-exists-p fname) - collect fname into tmp-list - finally return (sort tmp-list 'string<))) - -(defun helm-ff-maybe-mark-candidates (seq) - "Add visible mark to all candidates in SEQ. -This is used when copying/renaming/symlinking etc. and following -files to destination." - (when (and (string= (assoc-default 'name (helm-get-current-source)) - (assoc-default 'name helm-source-find-files)) - seq) - (with-helm-window - (while seq - (if (string= (car seq) (helm-get-selection)) - (progn - (helm-make-visible-mark) - (helm-next-line) - (setq seq (cdr seq))) - (helm-next-line))) - (unless (helm-this-visible-mark) - (helm-prev-visible-mark))))) - - -;;; Compress/uncompress files -;; -;; -(define-minor-mode helm-ff--compress-async-modeline-mode - "Notify mode-line that an async process run." - :group 'dired-async - :global t - :lighter (:eval (propertize (format " [%s async job (Un)compressing file(s)]" - (length (dired-async-processes - 'helm-async-compress))) - 'face 'helm-delete-async-message)) - (unless helm-ff--compress-async-modeline-mode - (let ((visible-bell t)) (ding)))) - -(defun helm-do-compress-to (ifiles ofile) - "Compress IFILES files/directories to the OFILE archive. -Choose the archiving command based on the OFILE extension -and `dired-compress-files-alist'." - (let ((cmd (cl-loop for (r . c) in dired-compress-files-alist - when (string-match r ofile) return c)) - (error-file (expand-file-name - "dired-shell-command-output" temporary-file-directory))) - (cl-assert - cmd nil - "No compression rule found for %s, see `dired-compress-files-alist'" ofile) - (when (and (file-exists-p ofile) - (not (y-or-n-p - (format "%s exists, overwrite?" - (abbreviate-file-name ofile))))) - (message "Compression aborted")) - (message "Compressing %d file(s) to `%s'..." - (length ifiles) (helm-basename ofile)) - (process-put - (async-start - `(lambda () - (require 'cl-lib) - (require 'dired-aux) - (let* ((default-directory - (cl-loop with base = (car ',ifiles) - for file in ',ifiles - do (setq base (fill-common-string-prefix base file)) - finally return (file-name-directory base))) - (local-name (shell-quote-argument (file-local-name ,ofile))) - (input (mapconcat - (lambda (in-file) - (shell-quote-argument (file-relative-name in-file))) - ',ifiles " ")) - process-status) - (when (not (zerop - (setq process-status - (dired-shell-command - (format-spec ,cmd `((?o . ,local-name) (?i . ,input))))))) - (let ((error-output (with-current-buffer " *dired-check-process output*" - (buffer-string)))) - (with-temp-file ,error-file - (insert error-output)))) - process-status)) - (lambda (result) - (unless (dired-async-processes 'helm-async-compress) - (helm-ff--compress-async-modeline-mode -1)) - (if (zerop result) ; dired-shell-command succeed. - (progn - (message "Compressed %d file(s) to `%s' done" - (length ifiles) - (file-name-nondirectory ofile)) - (run-with-timer - 0.1 nil - (lambda (flist dest) - (dired-async-mode-line-message - "%s %d file(s) to %s done" - 'helm-delete-async-message - "Compressing" - (length flist) (helm-basename dest))) - ifiles ofile)) - (when (file-exists-p error-file) - (pop-to-buffer (find-file-noselect error-file)))))) - 'helm-async-compress t) - (helm-ff--compress-async-modeline-mode 1))) - -(defun helm-ff--dired-compress-file (file) - ;; `dired-compress-file' doesn't take care of binding `default-directory' when - ;; uncompressing FILE, as a result FILE is uncompressed in the directory where - ;; helm was started i.e. the current value of `default-directory'. - (with-helm-default-directory helm-ff-default-directory - (dired-compress-file file))) - -(defun helm-ff-quick-compress (_candidate) - "Compress or uncompress marked files without quitting." - (with-helm-window - (let (cfile) - (unwind-protect - (helm-read-answer-dolist-with-action - "Compress or uncompress file `%s'? " - (helm-marked-candidates) - (lambda (c) - (setq cfile (save-selected-window - (helm-ff--dired-compress-file c))) - (message nil) - (helm--remove-marked-and-update-mode-line c)) - #'abbreviate-file-name) - (setq helm-marked-candidates nil - helm-visible-mark-overlays nil) - (helm-force-update - (let ((presel (helm-get-selection))) - ;; FIXME: Probably this would never happen, I see no cases here where - ;; helm-get-selection doesn't exist. - (unless (file-exists-p presel) - (setq presel cfile)) - (when presel - (format helm-ff-last-expanded-candidate-regexp - (regexp-quote - (if (and helm-ff-transformer-show-only-basename - (not (helm-ff-dot-file-p presel))) - (helm-basename presel) presel)))))))))) - -(helm-make-persistent-command-from-action helm-ff-persistent-compress - "Compress or uncompress marked candidates without quitting." - 'quick-compress 'helm-ff-quick-compress) - -;;; Delete and trash files -;; -;; -(defun helm-file-buffers (filename) - "Return a list of buffer names corresponding to FILENAME." - (cl-loop with name = (expand-file-name filename) - for buf in (buffer-list) - for bfn = (buffer-file-name buf) - when (and bfn (string= name bfn)) - collect (buffer-name buf))) - -(defun helm-ff--delete-by-moving-to-trash (file) - "Decide to trash or delete FILE. -Return non-nil when FILE needs to be trashed." - (let ((remote (file-remote-p file))) - (or - (and delete-by-moving-to-trash - (null helm-current-prefix-arg) - (null current-prefix-arg) - (or (and remote helm-trash-remote-files) - (null remote))) - (and (null delete-by-moving-to-trash) - (or helm-current-prefix-arg - current-prefix-arg) - (or (and remote helm-trash-remote-files) - (null remote)))))) - -(defun helm-trash-directory () - "Try to find a trash directory. -Return the \"files\" subdirectory of trash directory. -When `helm-trash-default-directory' is set use it as trash directory." - (let* ((xdg-data-dir - (or helm-trash-default-directory - (directory-file-name - (expand-file-name "Trash" - (or (getenv "XDG_DATA_HOME") - "~/.local/share"))))) - (trash-files-dir (expand-file-name "files" xdg-data-dir))) - ;; Just return nil if the Trash directory is not yet created. It will be - ;; created later by `delete-directory'. - (and (file-exists-p trash-files-dir) trash-files-dir))) - -(cl-defun helm-ff-file-already-trashed (file &optional (trash-alist nil strash-alist)) - "Return FILE when it is already in trash. - -Optional arg TRASH-ALIST should be an alist as what -`helm-ff-trash-list' returns." - (unless (or (fboundp 'system-move-file-to-trash) - (and strash-alist (null trash-alist))) - (let ((trash-files-dir (helm-trash-directory))) - (cl-loop for (_bn . fn) in (or trash-alist - (helm-ff-trash-list trash-files-dir)) - thereis (and (file-equal-p file fn) file))))) - -(defun helm-ff-quick-delete (_candidate) - "Delete file CANDIDATE without quitting. - -When a prefix arg is given, meaning of -`delete-by-moving-to-trash' is the opposite." - (with-helm-window - (let* ((marked (helm-marked-candidates)) - (trash (helm-ff--delete-by-moving-to-trash (car marked))) - (helm-ff--trashed-files - (and trash (helm-ff-trash-list (helm-trash-directory)))) - (old--allow-recursive-deletes helm-ff-allow-recursive-deletes) - (buffers (cl-loop for f in marked - append (helm-file-buffers f)))) - (unwind-protect - (progn - (helm-read-answer-dolist-with-action - "Really %s file `%s'" - marked - (lambda (file) (helm-ff--quick-delete-action file trash)) - (list (if trash "Trash" "Delete") #'abbreviate-file-name)) - (when buffers - (helm-read-answer-dolist-with-action - "Kill buffer `%s', too? " - buffers #'kill-buffer))) - (setq helm-marked-candidates nil - helm-visible-mark-overlays nil) - (helm-force-update - (let ((presel (helm-get-selection))) - (when presel - (format helm-ff-last-expanded-candidate-regexp - (regexp-quote (if (and helm-ff-transformer-show-only-basename - (not (helm-ff-dot-file-p presel))) - (helm-basename presel) presel)))))) - (setq helm-ff-allow-recursive-deletes old--allow-recursive-deletes))))) - -(defun helm-ff--quick-delete-action (candidate trash) - "Delete or trash CANDIDATE and remove it from display." - (helm-preselect - (format helm-ff-last-expanded-candidate-regexp - (regexp-quote - (if (and helm-ff-transformer-show-only-basename - (not (helm-ff-dot-file-p candidate))) - (helm-basename candidate) candidate)))) - (helm-acase (helm-delete-file - candidate helm-ff-signal-error-on-dot-files - trash) - (skip - ;; This happens only when trying to - ;; trash a file already trashed. - (helm-delete-visible-mark (helm-this-visible-mark)) - (if (helm-end-of-source-p) - (helm-previous-line) - (helm-next-line))) - (t (helm-delete-current-selection))) - (message nil) - (helm--remove-marked-and-update-mode-line candidate)) - -(defun helm-delete-file (file &optional error-if-dot-file-p trash) - "Delete FILE after querying the user. - -When a prefix arg is given, meaning of -`delete-by-moving-to-trash' is the opposite. - -Return error when ERROR-IF-DOT-FILE-P is non-nil and user tries -to delete a dotted file i.e. \".\" or \"..\". - -Ask user when directory are not empty to allow recursive deletion -unless `helm-ff-allow-recursive-deletes' is non nil. -When user is asked and reply with \"!\" don't ask for remaining -directories. - -Ask to kill buffers associated with that file, too. - -When TRASH is non nil, trash FILE even if `delete-by-moving-to-trash' -is nil." - (require 'dired) - (cl-block nil - (when (and error-if-dot-file-p - (helm-ff-dot-file-p file)) - (error "Error: Cannot operate on `.' or `..'")) - (let ((helm--reading-passwd-or-string t) - (file-attrs (file-attributes file)) - (trash (or trash (helm-ff--delete-by-moving-to-trash file))) - (delete-by-moving-to-trash trash)) - (cond ((and (eq (nth 0 file-attrs) t) ; a not empty directory. - (directory-files file t directory-files-no-dot-files-regexp)) - (if (or helm-ff-allow-recursive-deletes trash) - (delete-directory file 'recursive trash) - (helm-acase (helm-read-answer - (format "Recursive delete of `%s'? [y,n,!,q,h]" - (abbreviate-file-name file)) - '("y" "n" "!" "q") - #'helm-read-answer-default-help-fn) - ("y" (delete-directory file 'recursive trash)) - ("!" (setq helm-ff-allow-recursive-deletes t) - (delete-directory file 'recursive trash)) - ("n" (cl-return 'skip)) - ("q" (throw 'helm-abort-delete-file - (progn - (message "Abort file deletion") (sleep-for 1))))))) - ((eq (nth 0 file-attrs) t) ; a directory. - (delete-directory file nil trash)) - (t (delete-file file trash)))))) - -(defun helm-delete-marked-files (_ignore) - "Delete marked files with `helm-delete-file'. - -When a prefix arg is given, meaning of -`delete-by-moving-to-trash' is the opposite." - (let* ((files (helm-marked-candidates :with-wildcard t)) - (len 0) - (trash (helm-ff--delete-by-moving-to-trash (car files))) - (helm-ff--trashed-files - (and trash (helm-ff-trash-list (helm-trash-directory)))) - (prmt (if trash "Trash" "Delete")) - (old--allow-recursive-deletes helm-ff-allow-recursive-deletes) - (buffers (cl-loop for f in files - append (helm-file-buffers f)))) - (with-helm-display-marked-candidates - helm-marked-buffer-name - (helm-ff--count-and-collect-dups files) - (if (not (y-or-n-p (format "%s *%s File(s)" prmt (length files)))) - (message "(No deletions performed)") - (catch 'helm-abort-delete-file - (unwind-protect - (progn - (dolist (i files) - (set-text-properties 0 (length i) nil i) - (let ((res (helm-delete-file - i helm-ff-signal-error-on-dot-files trash))) - (if (eq res 'skip) - (progn (message "Directory is not empty, skipping") - (sleep-for 1)) - (cl-incf len)))) - (when buffers - (helm-read-answer-dolist-with-action - "Kill buffer `%s', too? " - buffers #'kill-buffer))) - (setq helm-ff-allow-recursive-deletes old--allow-recursive-deletes))) - (message "%s File(s) %s" len (if trash "trashed" "deleted")))))) - -;;; Delete files async -;; -;; -(defvar helm-ff-delete-log-file - (locate-user-emacs-file "helm-delete-file.log") - "The file use to communicate with Emacs child when deleting files async.") - -(defvar helm-ff--trash-flag nil) - -(define-minor-mode helm-ff--delete-async-modeline-mode - "Notify mode-line that an async process run." - :group 'dired-async - :global t - :lighter (:eval (propertize (format " %s file(s) async [%s job]..." - (if helm-ff--trash-flag - "Trashing" "Deleting") - (length (dired-async-processes - 'helm-delete-async))) - 'face 'helm-delete-async-message)) - (unless helm-ff--delete-async-modeline-mode - (let ((visible-bell t)) (ding)) - (setq helm-ff--trash-flag nil))) - -(defalias 'helm-delete-async-mode-line-message 'dired-async-mode-line-message) -(make-obsolete 'helm-delete-async-mode-line-message - 'dired-async-mode-line-message "3.9.8") - -(defun helm-delete-async-kill-process () - "Kill async process created by helm delete files async." - (interactive) - (let* ((processes (dired-async-processes)) - (proc (car (last processes)))) - (and proc (delete-process proc)) - (unless (> (length processes) 1) - (helm-ff--delete-async-modeline-mode -1)))) - -(defun helm-delete-marked-files-async (_ignore) - "Same as `helm-delete-marked-files' but async. - -When a prefix arg is given, meaning of -`delete-by-moving-to-trash' is the opposite. - -This function is not using `helm-delete-file' and BTW not asking -user for recursive deletion of directory, be warned that -directories are always deleted with no warnings." - (let* ((files (helm-marked-candidates :with-wildcard t)) - (trash (helm-ff--delete-by-moving-to-trash (car files))) - (prmt (if trash "Trash" "Delete")) - buffers callback - ;; Workaround emacs-26 bug with tramp see - ;; https://github.com/jwiegley/emacs-async/issues/80. - (async-quiet-switch "-q")) - (cl-loop for f in files - for buf = (helm-file-buffers f) - for dot-file-p = (helm-ff-dot-file-p f) - when (and helm-ff-signal-error-on-dot-files - dot-file-p) - do (cl-return (error "Error: Cannot operate on `.' or `..'")) - when buf - do (setq buffers (nconc buf buffers))) - (setq callback (lambda (result) - (unless (dired-async-processes 'helm-delete-async) - (helm-ff--delete-async-modeline-mode -1)) - (when (file-exists-p helm-ff-delete-log-file) - (display-warning 'helm - (with-temp-buffer - (insert-file-contents - helm-ff-delete-log-file) - (buffer-string)) - :error - "*helm delete files*") - (fit-window-to-buffer (get-buffer-window - "*helm delete files*")) - (delete-file helm-ff-delete-log-file)) - (when buffers - (helm-read-answer-dolist-with-action - "Kill buffer `%s', too? " - buffers #'kill-buffer)) - (run-with-timer - 0.1 nil - (lambda () - (dired-async-mode-line-message - "%s (%s/%s) file(s) async done" - 'helm-delete-async-message - (if trash "Trashing" "Deleting") - result (length files)))))) - (setq helm-ff--trash-flag trash) - (with-helm-display-marked-candidates - helm-marked-buffer-name - (helm-ff--count-and-collect-dups files) - (if (not (y-or-n-p (format "%s *%s File(s)" prmt (length files)))) - (message "(No deletions performed)") - (process-put - (async-start - `(lambda () - (require 'cl-lib) - ;; `delete-by-moving-to-trash' have to be set globally, - ;; using the TRASH argument of delete-file or - ;; delete-directory is not enough. - (setq delete-by-moving-to-trash ,trash) - (let ((result 0)) - (dolist (file ',files result) - (condition-case err - (cond ((eq (nth 0 (file-attributes file)) t) - (delete-directory file 'recursive ,trash) - (setq result (1+ result))) - (t (delete-file file ,trash) - (setq result (1+ result)))) - (error (with-temp-file ,helm-ff-delete-log-file - (insert (format-time-string "%x:%H:%M:%S\n")) - (insert (format "%S\n " err)))))))) - callback) - 'helm-delete-async t) - (helm-ff--delete-async-modeline-mode 1))))) - -(defun helm-find-file-or-marked (candidate) - "Open file CANDIDATE or open helm marked files in separate windows. -Called with one prefix arg open files in separate windows in a -vertical split. -Called with two prefix arg open files in background without -selecting them." - (let ((marked (helm-marked-candidates :with-wildcard t)) - (url-p (and helm--url-regexp ; we should have only one candidate. - (string-match helm--url-regexp candidate))) - (ffap-newfile-prompt helm-ff-newfile-prompt-p) - (find-file-wildcards nil) - (helm--reading-passwd-or-string t)) - (if (cdr marked) - (if (equal helm-current-prefix-arg '(16)) - (mapc 'find-file-noselect marked) - ;; If helm-current-prefix-arg is detected split is done - ;; vertically. - (helm-window-show-buffers (mapcar 'find-file-noselect marked))) - (let ((dir (and (not url-p) (helm-basedir candidate)))) - (cond ((and dir (file-directory-p dir)) - (find-file (substitute-in-file-name candidate))) - (url-p (find-file-at-point candidate)) - ;; A a non--existing filename ending with / - ;; Create a directory and jump to it. - ((and (not (file-exists-p candidate)) - (string-match "/$" candidate)) - (helm-ff--mkdir candidate 'helm-ff)) - ;; A non--existing filename NOT ending with / or - ;; an existing filename, create or jump to it. - ;; If the basedir of candidate doesn't exists, - ;; ask for creating it. - (dir - (helm-ff--mkdir dir) - (find-file candidate)) - ;; Find file at `default-directory' when basedir is - ;; unspecified e.g user hit C-k foo RET. - (t (find-file candidate))))))) - -(defun helm-ff-find-file-other-tab (_candidate) - "Display marked files in a new tab. -See `helm-buffers-switch-buffers-in-tab-1' for more infos." - (helm-buffers-switch-buffers-in-tab-1 - (mapcar 'find-file-noselect (helm-marked-candidates)))) - -(helm-make-command-from-action helm-ff-run-find-file-other-tab - "Run find file in other tab action from `helm-find-files'." - 'helm-ff-find-file-other-tab - (cl-assert (fboundp 'tab-bar-mode) nil "Tab-bar-mode not available")) - -(defun helm-ff--new-dirs-to-update (path) - "Collect directories to update when creating new directory PATH." - (let ((result (list path))) - (helm-awhile (helm-reduce-file-name path 1) - (if (not (file-directory-p it)) - (progn (push it result) (setq path it)) - (push it result) - (cl-return))) - result)) - -(defun helm-ff--mkdir (dir &optional helm-ff) - (when (or (not confirm-nonexistent-file-or-buffer) - (y-or-n-p (format "Create directory `%s'? " - (abbreviate-file-name - (expand-file-name dir))))) - (let ((dirfname (directory-file-name dir)) - (to-update (and helm-ff (helm-ff--new-dirs-to-update dir)))) - (if (file-exists-p dirfname) - (error - "Mkdir: Unable to create directory `%s': file exists." - (helm-basename dirfname)) - (make-directory dir 'parent)) - (when helm-ff - ;; Refresh cache. - (mapc (lambda (x) (helm-ff-directory-files x t)) to-update) - ;; Allow having this new dir in history - ;; to be able to retrieve it immediately - ;; if we want to e.g copy a file from somewhere in it. - (setq helm-ff-default-directory - (file-name-as-directory (expand-file-name dir))) - (push helm-ff-default-directory helm-ff-history)) - (or (and helm-ff (helm-find-files-1 dir)) t)))) - -(defun helm-transform-file-load-el (actions candidate) - "Add action to load the file CANDIDATE if it is an Emacs Lisp -file. Else return ACTIONS unmodified." - (if (member (file-name-extension candidate) '("el" "elc")) - (append actions '(("Load Emacs Lisp File" . load-file))) - actions)) - -(defun helm-transform-file-browse-url (actions candidate) - "Add an action to browse the file CANDIDATE if it is a HTML file or URL. -Else return ACTIONS unmodified." - (let ((browse-action '("Browse with Browser" . browse-url))) - (cond ((string-match "^http\\|^ftp" candidate) - (cons browse-action actions)) - ((string-match "\\.html?$" candidate) - (append actions (list browse-action))) - (t actions)))) - -(defun helm-file-on-mounted-network-p (file) - "Return non-nil when FILE is part of a mounted remote directory. - -This function is checking `helm-mounted-network-directories' -list." - (when helm-mounted-network-directories - (cl-loop for dir in helm-mounted-network-directories - thereis (file-in-directory-p file dir)))) - -;; helm-find-files bindings for filecache -(defvar file-cache-alist) - -(defun helm-ff-cache-add-file (_candidate) - (require 'filecache) - (let ((mkd (helm-marked-candidates :with-wildcard t))) - (mapc 'file-cache-add-file mkd))) - -(defun helm-ff-file-cache-remove-file-1 (file) - "Remove FILE from `file-cache-alist'." - (let ((entry (assoc (helm-basename file) file-cache-alist)) - (dir (helm-basedir file)) - new-entry) - (setq new-entry (remove dir entry)) - (when (= (length entry) 1) - (setq new-entry nil)) - (setq file-cache-alist - (cons new-entry (remove entry file-cache-alist))))) - -(defun helm-ff-file-cache-remove-file (_file) - "Remove marked files from `file-cache-alist.'" - (let ((mkd (helm-marked-candidates))) - (mapc 'helm-ff-file-cache-remove-file-1 mkd))) - -;;; Find files in file -;; -;; -(defclass helm-find-files-in-file-class (helm-source-in-file helm-type-file) ()) -(cl-defmethod helm--setup-source ((source helm-find-files-in-file-class)) - (helm-aif (slot-value source 'candidate-transformer) - (setf (slot-value source 'candidate-transformer) - (append (helm-mklist it) - `(,(lambda (candidates) - (cl-loop for c in candidates - when (and (not (string= c "")) - (file-exists-p c)) - collect c))))))) - -(defun helm-find-files-in-file-build-source (file) - (helm-make-source - (format "Find files in `%s'" (helm-basename file)) - 'helm-find-files-in-file-class - :candidates-file file)) - -(defun helm-find-files-in-file (_file) - "Helm action for listing filenames listed in marked files." - (require 'helm-for-files) - (let ((sources (cl-loop for f in (helm-marked-candidates) - collect (helm-find-files-in-file-build-source f)))) - (helm :sources sources - :quit-if-no-candidate (lambda () - (message "No files found in file(s)")) - :buffer "*helm find files in files*"))) - -(cl-defun helm-ff-mcp (_candidate) - "Copy the car of marked candidates to the remaining marked candidates. - -The car of marked should be a regular file and the rest of marked (cdr) should -be existing directories." - (let* ((mkd (helm-marked-candidates)) - (file (car mkd)) - (targets (cdr mkd)) - (skipped 0) - operations) - (cl-assert (file-regular-p file) nil (format "ERROR: Not a regular file `%s'" file)) - (cl-assert targets nil (format "ERROR: No destination specified for file `%s'" file)) - (cl-assert (cl-loop for f in targets always (file-directory-p f)) nil - "ERROR: Destinations must be existing directories") - (when targets - (cl-loop with yes-for-all - for dest in targets - for dest-file = (expand-file-name (helm-basename file) dest) - for dir-ok = (file-accessible-directory-p dest) - for exists = (and dir-ok - (file-exists-p - (expand-file-name - (helm-basename file) dest))) - for overwrite = (or (null exists) - yes-for-all - (helm-acase (helm-read-answer - (format - "File `%s' already-exists, overwrite (y,n,!,q) ? " - dest-file) - '("y" "n" "!" "q")) - ("y" t) - ("n" nil) - ("!" (prog1 t - (setq yes-for-all t))) - ("q" (cl-return-from helm-ff-mcp - (message "Operation aborted"))))) - if dir-ok - do (if overwrite - (push (list file (file-name-as-directory dest) overwrite) operations) - (cl-incf skipped)) - else do (cl-incf skipped)) - (when operations - (with-helm-display-marked-candidates - helm-marked-buffer-name - (mapcar #'abbreviate-file-name targets) - (if (y-or-n-p (format "Copy `%s' to directories?" (helm-basename file))) - (progn - (process-put - (async-start - `(lambda () - (require 'cl-lib) - (cl-loop with copies = 0 - with skipped = ,skipped - for (file dest overwrite) in ',operations - do (condition-case _err - (progn - (copy-file file dest overwrite) - (cl-incf copies)) - (file-error (cl-incf skipped))) - finally return (list file copies skipped))) - (lambda (result) - (let ((copied (nth 1 result))) - (unless (dired-async-processes) - (dired-async--modeline-mode -1)) - (run-with-idle-timer - 0.1 nil - (lambda () - (dired-async-mode-line-message - "Mcp done, %s %s of %s done, %s files skipped" - 'dired-async-message - copied - (if (> copied 1) - "copies" "copy") - (helm-basename (nth 0 result)) - (nth 2 result))))))) - 'dired-async-process t) - (dired-async--modeline-mode 1)) - (message "Operation aborted"))))))) - -(helm-make-command-from-action helm-ff-run-mcp - "Copy the car of marked candidates to the remaining marked candidates." - 'helm-ff-mcp) - -;;; File name history -;; -;; -(defvar helm-source-file-name-history - (helm-build-sync-source "File Name History" - :candidates 'file-name-history - :persistent-action #'ignore - ;; See comments in `helm-recentf-source' about bug#2709. - ;; This is probably not needed as long as we use - ;; `helm-file-name-history-transformer' which uses only propertize. - :coerce 'substring-no-properties - :match-on-real t - :candidate-transformer #'helm-file-name-history-transformer - :action 'helm-type-file-actions)) - -(defvar helm-file-name-history-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-map) - (define-key map (kbd "C-x C-f") 'helm-ff-file-name-history-run-ff) - map)) - -(defun helm-file-name-history-transformer (candidates) - (cl-loop with lgst = helm-file-name-history-max-length - for elm in candidates - for c = (truncate-string-to-width - elm helm-file-name-history-max-length nil nil t) - for disp = (cond ((or (file-remote-p elm) - (and (fboundp 'tramp-archive-file-name-p) - (tramp-archive-file-name-p c))) - (propertize c 'face 'helm-history-remote)) - ((file-exists-p elm) - (let ((last-access (format-time-string "%d/%m/%Y %X" - (nth 4 (file-attributes elm))))) - (concat (propertize c 'face 'helm-ff-file) - (make-string (1+ (- lgst (length c))) ? ) - last-access))) - ;; Should not happen as long as we use recentf. - (t (propertize c 'face 'helm-history-deleted))) - when disp - collect (cons (if helm-ff-icon-mode - (concat (helm-x-icons-icon-for-file - (helm-basename elm)) - " " disp) - disp) - elm))) - -(defun helm-ff-file-name-history-ff (candidate) - (helm-set-pattern - (expand-file-name candidate))) - -(helm-make-command-from-action helm-ff-file-name-history-run-ff - "Switch back to current HFF session with selection as preselect." - 'helm-ff-file-name-history-ff) - -(defun helm-ff-file-name-history () - "Switch to `recentf' without quitting `helm-find-files'." - (interactive) - (when helm-turn-on-recentf (recentf-mode 1)) - (let ((src (helm-build-sync-source "File name history" - :candidate-number-limit - (helm-aand - (or - (and (boundp 'recentf-max-saved-items) - recentf-max-saved-items) - (get 'file-name-history 'history-length) - history-length) - (and (numberp it) it)) - :candidates (lambda () recentf-list) - :help-message 'helm-file-name-history-help-message - :fuzzy-match t - :match-on-real t - :persistent-action 'ignore - :migemo t - :candidate-transformer 'helm-file-name-history-transformer - :action (helm-make-actions - "Find file" (lambda (candidate) - (helm-set-pattern - (expand-file-name candidate)) - (with-helm-after-update-hook (helm-exit-minibuffer))) - "Find file in helm" 'helm-ff-file-name-history-ff) - :keymap helm-file-name-history-map))) - (with-helm-alive-p - (helm :sources src - :buffer "*helm-file-name-history*" - :allow-nest t - :resume 'noresume)))) -(put 'helm-ff-file-name-history 'helm-only t) - -;;; Browse project -;; Need dependencies: -;; -;; -;; Only hg and git are supported for now. -(defvar helm--browse-project-cache (make-hash-table :test 'equal)) -(defvar helm-buffers-in-project-p) - -(defvar helm-browse-project-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-generic-files-map) - (define-key map (kbd "M-g a") 'helm-browse-project-run-ag) - map)) - -(defun helm-browse-project-get-buffers (root-directory) - (cl-loop for b in (helm-buffer-list) - ;; FIXME: Why default-directory is root-directory - ;; for current-buffer when coming from helm-quit-and-find-file. - for cd = (with-current-buffer b default-directory) - for bn = (buffer-file-name (get-buffer b)) - if (or (and bn (file-in-directory-p bn root-directory)) - (and (null bn) - (not (file-remote-p cd)) - (file-in-directory-p cd root-directory))) - collect b)) - -(defun helm-browse-project-build-buffers-source (directory) - (helm-make-source "Buffers in project" 'helm-source-buffers - :header-name (lambda (name) - (format - "%s (%s)" - name (abbreviate-file-name directory))) - :buffer-list (lambda () (helm-browse-project-get-buffers directory)))) - -(defun helm-browse-project-walk-directory (directory) - "Default function for `helm-browse-project-default-find-files-fn'." - (helm-walk-directory - directory - :directories nil :path 'full :skip-subdirs t)) - -(defun helm-browse-project-find-files-1 (directory program) - "List files in DIRECTORY recursively with external PROGRAM." - (require 'helm-fd) - (let* ((fd-exe (or helm-fd-executable - (executable-find "fdfind") - (executable-find "fd"))) - (cmd (cl-ecase program - (ag "ag --hidden -g '.*' %s") - (rg "rg --files --hidden -g '*' %s") - (fd (concat fd-exe " --hidden --type f --glob '*' %s"))))) - (with-temp-buffer - (call-process-shell-command - (format cmd directory) - nil t nil) - (mapcar (lambda (f) (expand-file-name f directory)) - (split-string (buffer-string) "\n"))))) - -(defun helm-browse-project-ag-find-files (directory) - "A suitable function for `helm-browse-project-default-find-files-fn'. -Use AG as backend." - (helm-browse-project-find-files-1 directory 'ag)) - -(defun helm-browse-project-rg-find-files (directory) - "A suitable function for `helm-browse-project-default-find-files-fn'. -Use RG as backend." - (helm-browse-project-find-files-1 directory 'rg)) - -(defun helm-browse-project-fd-find-files (directory) - "A suitable function for `helm-browse-project-default-find-files-fn'. -Use FD as backend." - (helm-browse-project-find-files-1 directory 'fd)) - -(defun helm-browse-project-ag (_candidate) - "A `helm-grep' AG action for `helm-browse-project'." - (let ((dir (with-helm-buffer (helm-get-attr 'root-dir)))) - (helm-grep-ag dir helm-current-prefix-arg))) - -(helm-make-command-from-action helm-browse-project-run-ag - "Run `helm-grep' AG from `helm-browse-project'." - 'helm-browse-project-ag) - -(defclass helm-browse-project-source (helm-source-in-buffer helm-type-file) - ((root-dir :initarg :root-dir - :initform nil - :custom 'file) - (match-part :initform - (lambda (c) - (if (with-helm-buffer - helm-ff-transformer-show-only-basename) - (helm-basename c) c))) - (filter-one-by-one :initform - (lambda (c) - (if (with-helm-buffer - helm-ff-transformer-show-only-basename) - (cons (propertize (helm-basename c) - 'face 'helm-ff-file) - c) - (propertize c 'face 'helm-ff-file))))) - "Class to define a source in `helm-browse-project' handling non -VC handled directories.") - -(cl-defmethod helm--setup-source :after ((source helm-browse-project-source)) - (let ((actions (slot-value source 'action))) - (setf (slot-value source 'action) - (helm-append-at-nth - (symbol-value actions) - '(("Grep project with AG `M-g a, C-u select type'" . helm-browse-project-ag)) - 7)) - (setf (slot-value source 'keymap) helm-browse-project-map))) - -(defun helm-browse-project-find-files (directory &optional refresh) - "Browse non VC handled directory DIRECTORY." - (when refresh (remhash directory helm--browse-project-cache)) - (unless (gethash directory helm--browse-project-cache) - (puthash directory (funcall helm-browse-project-default-find-files-fn - directory) - helm--browse-project-cache)) - (helm :sources `(,(helm-browse-project-build-buffers-source directory) - ,(helm-make-source "Browse project" - 'helm-browse-project-source - :root-dir directory - :data (gethash directory helm--browse-project-cache) - :header-name - (lambda (name) - (format - "%s (%s)" - name (abbreviate-file-name directory))))) - :ff-transformer-show-only-basename nil - :buffer "*helm browse project*")) - -(defvar helm-browse-project-history nil) - -;;;###autoload -(defun helm-projects-history (&optional arg) - "Jump to project already visisted with `helm-browse-project'. -Prefix arg allows browsing files recursively under a project not handled -by git or hg, otherwise it has no effect." - (interactive "P") - (setq helm-browse-project-history - (cl-loop for p in helm-browse-project-history - when (and (stringp p) (file-directory-p p)) - collect p)) - (helm :sources - (helm-build-sync-source "Project history" - :candidates helm-browse-project-history - :filtered-candidate-transformer 'helm-adaptive-sort - :action (helm-make-actions - "Browse project" - (lambda (candidate) - (with-helm-default-directory candidate - (helm-browse-project - (or arg helm-current-prefix-arg)))) - "Remove project(s)" - (lambda (_candidate) - (let ((mkd (helm-marked-candidates))) - (cl-loop for c in mkd do - (setq helm-browse-project-history - (delete c helm-browse-project-history))) - (message "%s projects removed" (length mkd)))))) - :buffer "*helm browse project history*")) - -;;;###autoload -(defun helm-browse-project (arg) - "Preconfigured helm to browse projects. -Browse files and see status of project with its VCS. -GIT, HG and SVN are supported for now, but only git is fully featured with -`helm-ls-git' package. -Fall back to `helm-browse-project-find-files' if current -directory is not under control or one of those VCS. -With a prefix ARG browse files recursively, with two prefix ARG -rebuild the cache. -If the current directory is found in the cache, start -`helm-browse-project-find-files' even with no prefix ARG. -NOTE: The prefix ARG have no effect on the VCS controlled -directories. - -Needed dependencies for VCS (not mandatory, pickup what you need): - - -." - (interactive "P") - (require 'helm-x-files) - (require 'vc) - (let* ((helm-type-buffer-actions - (remove (assoc "Browse project from buffer" - helm-type-buffer-actions) - helm-type-buffer-actions)) - (helm-buffers-in-project-p t) - (git-project (and (require 'helm-ls-git nil t) - (fboundp 'helm-ls-git-root-dir) - (helm-ls-git-root-dir))) - (hg-project (and (require 'helm-ls-hg nil t) - (fboundp 'helm-hg-root) - (helm-hg-root))) - (svn-project (and (require 'helm-ls-svn nil t) - (fboundp 'helm-ls-svn-root-dir) - (helm-ls-svn-root-dir))) - ;; handle nested projects (Hg inside Git or vice versa) issue#2723. - (project-type (vc-deduce-backend))) - (cl-flet ((push-to-hist (root) - (setq helm-browse-project-history - (cons root (delete root helm-browse-project-history))))) - (helm-acond ((and (equal project-type 'Git) git-project) - (push-to-hist it) - (helm-ls-git)) - ((and (equal project-type 'Hg) hg-project) - (push-to-hist it) - (helm-hg-find-files-in-project)) - ((and (equal project-type 'Svn) svn-project) - (push-to-hist it) - (helm-ls-svn-ls)) - ((helm-browse-project-get--root-dir (helm-current-directory)) - (if (or arg (gethash it helm--browse-project-cache)) - (progn - (push-to-hist (abbreviate-file-name it)) - (helm-browse-project-find-files it (equal arg '(16)))) - (helm :sources (helm-browse-project-build-buffers-source it) - :buffer "*helm browse project*"))))))) - -(defun helm-browse-project-get--root-dir (directory) - (cl-loop with dname = (file-name-as-directory directory) - while (and dname (not (gethash dname helm--browse-project-cache))) - if (file-remote-p dname) - do (setq dname nil) else - do (setq dname (helm-basedir (substring dname 0 (1- (length dname))))) - finally return (or dname (file-name-as-directory directory)))) - -(defun helm-ff-browse-project (_candidate) - "Browse project in current directory. -See `helm-browse-project'." - (with-helm-default-directory helm-ff-default-directory - (helm-browse-project helm-current-prefix-arg))) - -(helm-make-command-from-action helm-ff-run-browse-project - "Run browse project." - 'helm-ff-browse-project) - -;;; Actions calling helm and main interactive functions. -;; -;; -(defun helm-ff-gid (_candidate) - (with-helm-default-directory helm-ff-default-directory - (helm-gid))) - -(helm-make-command-from-action helm-ff-run-gid - "Run gid from HFF." - 'helm-ff-gid) - -;; helm-find bindings for helm-find-files. -(defun helm-ff-find-sh-command (_candidate) - "Run `helm-find' from `helm-find-files'." - (require 'helm-find) - (helm-find-1 helm-ff-default-directory)) - -(helm-make-command-from-action helm-ff-run-find-sh-command - "Run find shell command action with key from `helm-find-files'." - 'helm-ff-find-sh-command) - -;; helm-hd bindings for hff -(defun helm-ff-fd (_candidate) - "Run fd shell command from `helm-find-files'." - (require 'helm-fd) - (helm-fd-1 helm-ff-default-directory)) - -(helm-make-command-from-action helm-ff-run-fd - "Run fd shell command action with key from `helm-find-files'." - 'helm-ff-fd) - -;;;###autoload -(defun helm-find-files (arg) - "Preconfigured `helm' for helm implementation of `find-file'. -Called with a prefix arg show history if some. -Don't call it from programs, use `helm-find-files-1' instead. -This is the starting point for nearly all actions you can do on -files." - (interactive "P") - (let* (tramp-archive-enabled ; Disable tramp-archive which is - ; kicking in unexpectedly. - (hist (and arg helm-ff-history (helm-find-files-history nil))) - (smart-input (or hist (helm-find-files-initial-input))) - (default-input (expand-file-name (helm-current-directory))) - (input (cond ((and (null hist) - helm-find-files-ignore-thing-at-point) - default-input) - ((and (eq major-mode 'org-agenda-mode) - org-directory - (not smart-input)) - (file-name-as-directory - (expand-file-name org-directory))) - ((and (eq major-mode 'dired-mode) smart-input) - (file-name-directory smart-input)) - ((and (not (string= smart-input "")) - smart-input)) - (t default-input))) - (input-as-presel (null (file-directory-p input))) - (presel (helm-aif (or hist - (and input-as-presel input) - (buffer-file-name (current-buffer)) - (and (eq major-mode 'dired-mode) - smart-input) - (and (eq major-mode 'Info-mode) - Info-current-file)) - (if (and helm-ff-transformer-show-only-basename - (null hist) - (not (string-match-p "[.]\\{1,2\\}\\'" it))) - (helm-basename it) - it)))) - ;; Continue using the same display function as history which used - ;; probably itself the same display function as inner HFF call, - ;; i.e. if history was using frame use a frame otherwise use a window. - (when (and hist (buffer-live-p (get-buffer helm-ff-history-buffer-name))) - (helm-set-local-variable 'helm-display-function - (with-current-buffer helm-ff-history-buffer-name - helm-display-function) - 'helm--last-frame-parameters - (with-current-buffer helm-ff-history-buffer-name - helm--last-frame-parameters))) - (set-text-properties 0 (length input) nil input) - (setq current-prefix-arg nil) - ;; Allow next helm session to reuse helm--last-frame-parameters as - ;; resume would do. - (let ((helm--executing-helm-action (not (null hist)))) - (helm-find-files-1 input (and presel (null helm-ff-no-preselect) - (format helm-ff-last-expanded-candidate-regexp - (regexp-quote presel))))))) - - - -(provide 'helm-files) - -;;; helm-files.el ends here diff --git a/elpa/helm-20251212.555/helm-find.el b/elpa/helm-20251212.555/helm-find.el deleted file mode 100644 index dc81c262..00000000 --- a/elpa/helm-20251212.555/helm-find.el +++ /dev/null @@ -1,182 +0,0 @@ -;;; helm-find.el --- helm interface for find command. -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2025 Thierry Volpiatto - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Code: - -(require 'helm-files) -(require 'helm-external) - -(defcustom helm-findutils-skip-boring-files t - "Ignore boring files in find command results." - :group 'helm-files - :type 'boolean) - -(defcustom helm-findutils-search-full-path nil - "Search in full path with shell command find when non-nil. -I.e. use the -path/ipath arguments of find instead of --name/iname." - :group 'helm-files - :type 'boolean) - -(defcustom helm-find-noerrors nil - "Prevent showing error messages in helm buffer when non nil." - :group 'helm-files - :type 'boolean) - -(defcustom helm-find-show-full-path-fn #'identity - "Function used in transformer to show the full path of candidate. -You may want to show the relative path or the abbreviated path instead of the -full path. The basename is accessible with -\\\\[helm-ff-run-toggle-basename], so no need to use a function -that display the basename of candidate here." - :group 'helm-files - :type '(choice - (const :tag "Display absolute path" identity) - (const :tag "Display relative path" file-relative-name) - (const :tag "Display abbreviated path" abbreviate-file-name))) - -(defvar helm-find-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-generic-files-map) - (define-key map (kbd "DEL") 'helm-delete-backward-no-update) - map)) - -(defvar helm-source-findutils - (helm-build-async-source "Find" - :header-name (lambda (name) - (concat name " in [" (helm-default-directory) "]")) - :candidates-process 'helm-find-shell-command-fn - :filtered-candidate-transformer 'helm-findutils-transformer - :action-transformer 'helm-transform-file-load-el - :persistent-action 'helm-ff-kill-or-find-buffer-fname - :action 'helm-type-file-actions - :help-message 'helm-generic-file-help-message - :keymap helm-find-map - :candidate-number-limit 9999 - :requires-pattern 3)) - -(defun helm-findutils-transformer (candidates _source) - (let (non-essential - (default-directory (helm-default-directory))) - (cl-loop for i in candidates - for abs = (expand-file-name - (helm-aif (file-remote-p default-directory) - (concat it i) i)) - for type = (car (file-attributes abs)) - for fname = (if (and helm-ff-transformer-show-only-basename - (not (string-match "[.]\\{1,2\\}$" i))) - (helm-basename abs) - (funcall helm-find-show-full-path-fn abs)) - for disp = (helm-acase type - ('t (propertize fname 'face 'helm-ff-directory)) - ((guard* (stringp it)) - (propertize fname 'face 'helm-ff-symlink)) - (otherwise (propertize fname 'face 'helm-ff-file))) - collect (cons (helm-ff-prefix-filename disp abs) abs)))) - -(defun helm-find--build-cmd-line () - (require 'find-cmd) - (let* ((default-directory (or (file-remote-p default-directory 'localname) - default-directory)) - (patterns+options (split-string helm-pattern "\\(\\`\\| +\\)\\* +")) - (fold-case (helm-set-case-fold-search (car patterns+options))) - (patterns (split-string (car patterns+options))) - (additional-options (and (cdr patterns+options) - (list (concat (cadr patterns+options) " ")))) - (ignored-dirs ()) - (ignored-files (when helm-findutils-skip-boring-files - (cl-loop for f in completion-ignored-extensions - if (string-match "/$" f) - do (push (replace-match "" nil t f) - ignored-dirs) - else collect (concat "*" f)))) - (path-or-name (if helm-findutils-search-full-path - '(ipath path) '(iname name))) - (name-or-iname (if fold-case - (car path-or-name) (cadr path-or-name)))) - (find-cmd (and ignored-dirs - `(prune (name ,@ignored-dirs))) - (and ignored-files - `(not (name ,@ignored-files))) - `(and ,@(mapcar - (lambda (pattern) - `(,name-or-iname ,(concat "*" pattern "*"))) - patterns) - ,@additional-options)))) - -(defun helm-find-shell-command-fn () - "Asynchronously fetch candidates for `helm-find'. -Additional find options can be specified after a \"*\" -separator." - (let* (process-connection-type - non-essential - (cmd (concat (helm-find--build-cmd-line) - (if helm-find-noerrors "2> /dev/null" ""))) - (proc (start-file-process-shell-command "hfind" helm-buffer cmd))) - (helm-log "helm-find-shell-command-fn" "Find command:\n%s" cmd) - (prog1 proc - (set-process-sentinel - proc - (lambda (process event) - (helm-process-deferred-sentinel-hook - process event (helm-default-directory)) - (if (or (string= event "finished\n") - (process-get process 'reach-limit)) - (helm-locate-update-mode-line "Find") - (helm-log "helm-find-shell-command-fn sentinel" "Error: Find %s" - (replace-regexp-in-string "\n" "" event)))))))) - -(defun helm-find-1 (dir) - (let ((default-directory (file-name-as-directory dir))) - (helm :sources 'helm-source-findutils - :buffer "*helm find*" - :ff-transformer-show-only-basename nil - :case-fold-search helm-file-name-case-fold-search))) - - -;;; Preconfigured commands -;; -;; -;;;###autoload -(defun helm-find (arg) - "Preconfigured `helm' for the find shell command. - -Recursively find files whose names are matched by all specified -globbing PATTERNs under the current directory using the external -program specified in `find-program' (usually \"find\"). Every -input PATTERN is silently wrapped into two stars: *PATTERN*. - -With prefix argument, prompt for a directory to search. - -When user option `helm-findutils-search-full-path' is non-nil, -match against complete paths, otherwise, against file names -without directory part. - -The (possibly empty) list of globbing PATTERNs can be followed by -the separator \"*\" plus any number of additional arguments that -are passed to \"find\" literally." - (interactive "P") - (let ((directory - (if arg - (file-name-as-directory - (read-directory-name "DefaultDirectory: ")) - default-directory))) - (helm-find-1 directory))) - -(provide 'helm-find) - -;;; helm-find.el ends here diff --git a/elpa/helm-20251212.555/helm-font.el b/elpa/helm-20251212.555/helm-font.el deleted file mode 100644 index 92875d24..00000000 --- a/elpa/helm-20251212.555/helm-font.el +++ /dev/null @@ -1,344 +0,0 @@ -;;; helm-font --- Font and ucs selection for Helm -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2025 Thierry Volpiatto - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Code: - -(require 'cl-lib) -(require 'helm) -(require 'helm-help) - -;; No warnings in Emacs built --without-x -(declare-function x-list-fonts "xfaces.c") - -(declare-function helm-generic-sort-fn "helm-utils") - -(defgroup helm-font nil - "Related applications to display fonts in Helm." - :group 'helm) - -(defcustom helm-ucs-recent-size 10 - "Number of recent chars to keep." - :type 'integer - :group 'helm-font) - -(defcustom helm-ucs-actions - '(("Insert character" . helm-ucs-insert-char) - ("Insert character name" . helm-ucs-insert-name) - ("Insert character code in hex" . helm-ucs-insert-code) - ("Kill marked characters" . helm-ucs-kill-char) - ("Kill name" . helm-ucs-kill-name) - ("Kill code" . helm-ucs-kill-code) - ("Describe char" . helm-ucs-describe-char)) - "Actions for `helm-source-ucs'." - :group 'helm-font - :type '(alist :key-type string :value-type function)) - -(defvar helm-ucs-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-map) - (define-key map (kbd "") 'helm-ucs-persistent-delete) - (define-key map (kbd "") 'helm-ucs-persistent-backward) - (define-key map (kbd "") 'helm-ucs-persistent-forward) - (define-key map (kbd "C-c SPC") 'helm-ucs-persistent-insert-space) - map) - "Keymap for `helm-ucs'.") - -(defface helm-ucs-char - `((((class color) (background dark)) - ,@(and (>= emacs-major-version 27) '(:extend t)) - :foreground "gold")) - "Face used to display ucs characters." - :group 'helm-font) - -;;; Xfont selection -;; -;; -(defvar helm-xfonts-cache nil) -(defvar helm-previous-font nil) -(defvar helm-source-xfonts - (helm-build-sync-source "X Fonts" - :init (lambda () - (unless helm-xfonts-cache - (setq helm-xfonts-cache - (x-list-fonts "*"))) - ;; Save current font so it can be restored in cleanup - (setq helm-previous-font (cdr (assq 'font (frame-parameters))))) - :candidates 'helm-xfonts-cache - :action `(("Copy font to kill ring" . ,(lambda (elm) - (kill-new elm))) - ("Set font" . ,(lambda (elm) - (kill-new elm) - (set-frame-font elm 'keep-size) - (message "Font copied to kill ring")))) - :cleanup (lambda () - ;; Restore previous font - (set-frame-font helm-previous-font 'keep-size)) - :persistent-action (lambda (new-font) - (set-frame-font new-font 'keep-size) - (kill-new new-font)) - :persistent-help "Preview font and copy to kill-ring")) - - -;;; 𝕌𝕔𝕤 𝕊𝕪𝕞𝕓𝕠𝕝 𝕔𝕠𝕞𝕡𝕝𝕖𝕥𝕚𝕠𝕟 -;; -;; -(defvar helm-ucs--max-len nil) -(defvar helm-ucs--names nil) -(defvar helm-ucs-history nil) -(defvar helm-ucs-recent nil - "Ring of recent `helm-ucs' selections.") - -(defun helm-calculate-ucs-alist-max-len (names) - "Calculate the length of the longest NAMES list candidate." - (cl-loop for (_n . v) in names - maximize (length (format "#x%x:" v)) into code - maximize (max 1 (string-width (format "%c" v))) into char - finally return (cons code char))) - -(defun helm-calculate-ucs-hash-table-max-len (names) - "Calculate the length of the longest NAMES hash table candidate." - (cl-loop for _n being the hash-keys of names - using (hash-values v) - maximize (length (format "#x%x:" v)) into code - maximize (max 1 (string-width (format "%c" v))) into char - finally return (cons code char))) - -(defun helm-calculate-ucs-max-len () - "Calculate the length of the longest `ucs-names' candidate." - (let ((ucs-struct (ucs-names))) - (if (hash-table-p ucs-struct) - (helm-calculate-ucs-hash-table-max-len ucs-struct) - (helm-calculate-ucs-alist-max-len ucs-struct)))) - -(defun helm-ucs-collect-symbols-alist (names) - "Collect ucs symbols from the NAMES list." - (cl-loop with pr = (make-progress-reporter - "collecting ucs names" - 0 (length names)) - for (n . v) in names - for count from 1 - for xcode = (format "#x%x:" v) - for len = (length xcode) - for diff = (- (car helm-ucs--max-len) len) - for code = (format "(#x%x): " v) - for char = (propertize (format "%c" v) - 'face 'helm-ucs-char) - unless (or (string= "" n) - ;; `char-displayable-p' return a font object or - ;; t for some char that are displayable but have - ;; no special font (e.g 10) so filter out char - ;; with no font. - (not (fontp (char-displayable-p (read xcode))))) - collect - (concat code (make-string diff ? ) - char " " n) - and do (progress-reporter-update pr count))) - -(defun helm-ucs-collect-symbols-hash-table (names) - "Collect ucs symbols from the NAMES hash-table." - (cl-loop with pr = (make-progress-reporter - "collecting ucs names" - 0 (hash-table-count names)) - for n being the hash-keys of names - using (hash-values v) - for count from 1 - for xcode = (format "#x%x:" v) - for len = (length xcode) - for diff = (- (car helm-ucs--max-len) len) - for code = (format "(#x%x): " v) - for char = (propertize (format "%c" v) - 'face 'helm-ucs-char) - unless (or (string= "" n) - (not (fontp (char-displayable-p (read xcode))))) - collect - (concat code (make-string diff ? ) - char " " n) - and do (progress-reporter-update pr count))) - -(defun helm-ucs-collect-symbols (ucs-struct) - "Collect ucs symbols from UCS-STRUCT. - -Depending on the Emacs version, the variable `ucs-names' can -either be an alist or a hash-table." - (if (hash-table-p ucs-struct) - (helm-ucs-collect-symbols-hash-table ucs-struct) - (helm-ucs-collect-symbols-alist ucs-struct))) - -(defun helm-ucs-init () - "Initialize a Helm buffer with ucs symbols. -Only math* symbols are collected." - (unless helm-ucs--max-len - (setq helm-ucs--max-len - (helm-calculate-ucs-max-len))) - (or helm-ucs--names - (setq helm-ucs--names - (helm-ucs-collect-symbols (ucs-names))))) - -;; Actions (insertion) - -(defun helm-ucs-match (candidate n) - "Return the N part of an ucs CANDIDATE. -Where N=1 is the ucs code, N=2 the ucs char and N=3 the ucs -name." - (when (string-match - "^(\\(#x[a-f0-9]+\\)): *\\(.\\) *\\([^:]+\\)+" - candidate) - (match-string n candidate))) - -(defun helm-ucs-save-recentest (candidate) - (let ((lst (cons candidate (delete candidate helm-ucs-recent)))) - (setq helm-ucs-recent - (if (> (length lst) helm-ucs-recent-size) - (nbutlast lst 1) - lst)))) - -(defun helm-ucs-insert (candidate n) - "Insert the N part of CANDIDATE." - (with-helm-current-buffer - (helm-ucs-save-recentest candidate) - (insert (helm-ucs-match candidate n)))) - -(defun helm-ucs-insert-char (candidate) - "Insert ucs char part of CANDIDATE at point." - (helm-ucs-insert candidate 2)) - -(defun helm-ucs-insert-code (candidate) - "Insert ucs code part of CANDIDATE at point." - (helm-ucs-insert candidate 1)) - -(defun helm-ucs-insert-name (candidate) - "Insert ucs name part of CANDIDATE at point." - (helm-ucs-insert candidate 3)) - -;; Kill actions -(defun helm-ucs-kill-char (_candidate) - "Action that concatenate ucs marked chars." - (let ((marked (helm-marked-candidates))) - (cl-loop for candidate in marked - do (helm-ucs-save-recentest candidate)) - (kill-new (mapconcat (lambda (x) - (helm-ucs-match x 2)) - marked "")))) - -(defun helm-ucs-kill-code (candidate) - (helm-ucs-save-recentest candidate) - (kill-new (helm-ucs-match candidate 1))) - -(defun helm-ucs-kill-name (candidate) - (helm-ucs-save-recentest candidate) - (kill-new (helm-ucs-match candidate 3))) - -;; Describe char -(defun helm-ucs-describe-char (candidate) - "Describe char CANDIDATE." - (with-temp-buffer - (insert (helm-ucs-match candidate 2)) - (describe-char (point-min)))) - -;; Navigation in current-buffer (persistent) - -(defun helm-ucs-forward-char (_candidate) - (with-helm-current-buffer - (forward-char 1))) - -(defun helm-ucs-backward-char (_candidate) - (with-helm-current-buffer - (forward-char -1))) - -(defun helm-ucs-delete-backward (_candidate) - (with-helm-current-buffer - (delete-char -1))) - -(defun helm-ucs-insert-space (_candidate) - (with-helm-current-buffer - (insert " "))) - -(defun helm-ucs-persistent-forward () - (interactive) - (with-helm-alive-p - (helm-set-attr 'action-forward 'helm-ucs-forward-char) - (helm-execute-persistent-action 'action-forward))) -(put 'helm-ucs-persistent-forward 'helm-only t) - -(defun helm-ucs-persistent-backward () - (interactive) - (with-helm-alive-p - (helm-set-attr 'action-back 'helm-ucs-backward-char) - (helm-execute-persistent-action 'action-back))) -(put 'helm-ucs-persistent-backward 'helm-only t) - -(defun helm-ucs-persistent-delete () - (interactive) - (with-helm-alive-p - (helm-set-attr 'action-delete 'helm-ucs-delete-backward) - (helm-execute-persistent-action 'action-delete))) -(put 'helm-ucs-persistent-delete 'helm-only t) - -(defun helm-ucs-persistent-insert-space () - (interactive) - (with-helm-alive-p - (helm-set-attr 'action-insert-space 'helm-ucs-insert-space) - (helm-execute-persistent-action 'action-insert-space))) - -(defvar helm-source-ucs-recent - (helm-build-sync-source "Recent UCS" - :action 'helm-ucs-actions - :candidates (lambda () helm-ucs-recent) - :help-message helm-ucs-help-message - :keymap helm-ucs-map - :volatile t)) - -(defvar helm-source-ucs - (helm-build-in-buffer-source "UCS names" - :data #'helm-ucs-init - :get-line #'buffer-substring - :help-message 'helm-ucs-help-message - :filtered-candidate-transformer - (lambda (candidates _source) (sort candidates #'helm-generic-sort-fn)) - :action 'helm-ucs-actions - :persistent-action (lambda (candidate) - (helm-ucs-insert-char candidate) - (helm-force-update)) - :keymap helm-ucs-map) - "Source for collecting `ucs-names' math symbols.") - -;;;###autoload -(defun helm-select-xfont () - "Preconfigured `helm' to select Xfont." - (interactive) - (helm :sources 'helm-source-xfonts - :buffer "*helm select xfont*")) - -;;;###autoload -(defun helm-ucs (arg) - "Preconfigured `helm' for `ucs-names'. - -Called with a prefix arg force reloading cache." - (interactive "P") - (when arg - (setq helm-ucs--names nil - helm-ucs--max-len nil - ucs-names nil)) - (let ((char (helm-aif (char-after) (string it)))) - (helm :sources (list helm-source-ucs-recent helm-source-ucs) - :history 'helm-ucs-history - :input (and char (multibyte-string-p char) char) - :buffer "*helm ucs*"))) - -(provide 'helm-font) - -;;; helm-font.el ends here diff --git a/elpa/helm-20251212.555/helm-for-files.el b/elpa/helm-20251212.555/helm-for-files.el deleted file mode 100644 index 4868f6cd..00000000 --- a/elpa/helm-20251212.555/helm-for-files.el +++ /dev/null @@ -1,359 +0,0 @@ -;;; helm-for-files.el --- helm-for-files and related. -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2025 Thierry Volpiatto - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Code: - -(require 'helm-files) -(require 'helm-external) -(require 'helm-bookmark) - -(defvar recentf-list) - -(defcustom helm-multi-files-toggle-locate-binding "C-c p" - "Default binding to switch back and forth locate in `helm-multi-files'." - :group 'helm-files - :type 'string) - -(defcustom helm-for-files-preferred-list - '(helm-source-buffers-list - helm-source-recentf - helm-source-bookmarks - helm-source-file-cache - helm-source-files-in-current-dir - helm-source-locate) - "Your preferred sources for `helm-for-files' and `helm-multi-files'. - -When adding a source here it is up to you to ensure the library -of this source is accessible and properly loaded." - :type '(repeat (choice symbol)) - :group 'helm-files) - -(defcustom helm-for-files-tramp-not-fancy t - "Colorize remote files when non nil. - -Be aware that a nil value will make tramp display very slow." - :group 'helm-files - :type 'boolean) - -;;; File Cache -;; -;; -(defvar file-cache-alist) - -(defclass helm-file-cache (helm-source-in-buffer helm-type-file) - ((init :initform (lambda () (require 'filecache))))) - -(defun helm-file-cache-get-candidates () - (cl-loop for item in file-cache-alist append - (cl-destructuring-bind (base &rest dirs) item - (cl-loop for dir in dirs collect - (concat dir base))))) - -(defvar helm-source-file-cache nil) - -(defcustom helm-file-cache-fuzzy-match nil - "Enable fuzzy matching in `helm-source-file-cache' when non--nil." - :group 'helm-files - :type 'boolean - :set (lambda (var val) - (set var val) - (setq helm-source-file-cache - (helm-make-source "File Cache" 'helm-file-cache - :fuzzy-match helm-file-cache-fuzzy-match - :data 'helm-file-cache-get-candidates)))) - -(cl-defun helm-file-cache-add-directory-recursively - (dir &optional match (ignore-dirs t)) - (require 'filecache) - (cl-loop for f in (helm-walk-directory - dir - :path 'full - :directories nil - :match match - :skip-subdirs ignore-dirs) - do (file-cache-add-file f))) - -(defun helm-transform-file-cache (actions _candidate) - (let ((source (helm-get-current-source))) - (if (string= (assoc-default 'name source) "File Cache") - (append actions - '(("Remove marked files from file-cache" - . helm-ff-file-cache-remove-file))) - actions))) - -;;; Recentf files -;; -;; -(defvar helm-recentf--basename-flag nil) - -(defun helm-recentf-pattern-transformer (pattern) - (let ((pattern-no-flag (replace-regexp-in-string " -b" "" pattern))) - (cond ((and (string-match " " pattern-no-flag) - (string-match " -b\\'" pattern)) - (setq helm-recentf--basename-flag t) - pattern-no-flag) - ((string-match "\\([^ ]*\\) -b\\'" pattern) - (prog1 (match-string 1 pattern) - (setq helm-recentf--basename-flag t))) - (t (setq helm-recentf--basename-flag nil) - pattern)))) - -(defclass helm-recentf-source (helm-source-sync helm-type-file) - ((init :initform (lambda () - (require 'recentf) - (when helm-turn-on-recentf (recentf-mode 1)))) - (candidates :initform 'recentf-list) - (pattern-transformer :initform 'helm-recentf-pattern-transformer) - (match-part :initform (lambda (candidate) - (if (or helm-ff-transformer-show-only-basename - helm-recentf--basename-flag) - (helm-basename candidate) candidate))) - ;; When real candidate is equal to display it gets corrupted with the text - ;; properties added by the transformer, so ensure to strip out properties - ;; before passing the candidate to action otherwise recentf will save the - ;; candidate passed to find-file with the properties and corrupt - ;; recentf-list. This happen when abbreviate-file-name is passed to a - ;; candidate with no leading "~" e.g. "/foo" bug#2709. - (coerce :initform 'substring-no-properties) - (migemo :initform t) - (persistent-action :initform 'helm-ff-kill-or-find-buffer-fname))) - -(cl-defmethod helm--setup-source :after ((source helm-recentf-source)) - (setf (slot-value source 'action) - (append (symbol-value (helm-actions-from-type-file)) - '(("Delete file(s) from recentf" . - (lambda (_candidate) - (cl-loop for file in (helm-marked-candidates) - do (setq recentf-list (delete file recentf-list))))))))) - -(defvar helm-source-recentf nil - "See (info \"(emacs)File Conveniences\"). -Set `recentf-max-saved-items' to a bigger value if default is too -small.") - -(defcustom helm-recentf-fuzzy-match nil - "Enable fuzzy matching in `helm-source-recentf' when non-nil." - :group 'helm-files - :type 'boolean - :set (lambda (var val) - (set var val) - (let ((helm-fuzzy-sort-fn 'helm-fuzzy-matching-sort-fn-preserve-ties-order)) - (setq helm-source-recentf - (helm-make-source "Recentf" 'helm-recentf-source - :fuzzy-match val))))) - - -;;; Transformer for helm-type-file -;; -;; -(defvar helm-sources-for-files-no-basename '("Recentf" "File Cache")) - -;; Function `helm-highlight-files' is used in type `helm-type-file'. Ensure that -;; the definition is available for clients, should they need it. -;; See https://github.com/bbatsov/helm-projectile/issues/184. -;;;###autoload -(defun helm-highlight-files (files source) - "A basic transformer for helm files sources. -Colorize only symlinks, directories and files." - (cl-loop with mp-fn = (or (assoc-default - 'match-part (helm-get-current-source)) - 'identity) - with sname = (helm-get-attr 'name source) - for i in files - ;; As long as we use this transformer on file lists like recentf that - ;; are printed and saved to a file we make a copy of the display - ;; string and add text props to it, this to not corrupt the elemnts - ;; of the original list (Bug#2709). - for disp = (copy-sequence - (if (or (and (not helm-ff-show-dot-file-path) - (helm-ff-dot-file-p i)) - (and helm-ff-transformer-show-only-basename - (not (member sname - helm-sources-for-files-no-basename)) - (not (helm-ff-dot-file-p i)) - (not (and helm--url-regexp - (string-match helm--url-regexp i))) - (not (string-match helm-ff-url-regexp i)))) - (helm-basename i) (abbreviate-file-name i))) - for isremote = (or (file-remote-p i) - (helm-file-on-mounted-network-p i)) - ;; file-attributes is too slow on remote files, - ;; so call it only if: - ;; - file is not remote - ;; - helm-for-files--tramp-not-fancy is nil and file is remote AND - ;; connected. (Bug#1679) - for type = (and (or (null isremote) - (and (null helm-for-files-tramp-not-fancy) - (file-remote-p i nil t))) - (car (file-attributes i))) - collect - (cond (;; No fancy display on remote files with basic predicates. - (and (null type) isremote) (cons disp i)) - (;; Symlinks - (stringp type) - (add-text-properties 0 (length disp) `(face helm-ff-symlink - match-part ,(funcall mp-fn disp) - help-echo ,(expand-file-name i)) - disp) - (cons (helm-ff-prefix-filename disp i) i)) - (;; Dotted dirs - (and (eq type t) (helm-ff-dot-file-p i)) - (add-text-properties 0 (length disp) `(face helm-ff-dotted-directory - match-part ,(funcall mp-fn disp) - help-echo ,(expand-file-name i)) - disp) - (cons (helm-ff-prefix-filename disp i) i)) - (;; Dirs - (eq type t) - (add-text-properties 0 (length disp) `(face helm-ff-directory - match-part ,(funcall mp-fn disp) - help-echo ,(expand-file-name i)) - disp) - (cons (helm-ff-prefix-filename disp i) i)) - (t ;; Files. - (add-text-properties 0 (length disp) `(face helm-ff-file - match-part ,(funcall mp-fn disp) - help-echo ,(expand-file-name i)) - disp) - (helm-aif (helm-file-name-extension disp) - (when (condition-case _err - (string-match (format "\\.\\(%s\\)\\'" it) disp) - (invalid-regexp nil)) - (add-face-text-property - (match-beginning 1) (match-end 1) - 'helm-ff-file-extension nil disp))) - (cons (helm-ff-prefix-filename disp i) i))))) - - -;;; Files in current dir -;; -;; -(defclass helm-files-in-current-dir-source (helm-source-sync helm-type-file) - ((candidates :initform (lambda () - (with-helm-current-buffer - (let ((dir (helm-current-directory))) - (when (file-accessible-directory-p dir) - (directory-files dir t)))))) - (pattern-transformer :initform 'helm-recentf-pattern-transformer) - (match-part :initform (lambda (candidate) - (if (or helm-ff-transformer-show-only-basename - helm-recentf--basename-flag) - (helm-basename candidate) candidate))) - (fuzzy-match :initform t) - (popup-info :initform (lambda (candidate) - (unless (helm-ff-dot-file-p candidate) - (helm-file-attributes - candidate - :dired t :human-size t :octal nil)))) - (migemo :initform t))) - -(cl-defmethod helm--setup-source :after ((source helm-files-in-current-dir-source)) - (helm-aif (slot-value source 'filtered-candidate-transformer) - (setf (slot-value source 'filtered-candidate-transformer) - (append '(helm-ff-sort-candidates) (helm-mklist it))))) - -(defvar helm-source-files-in-current-dir - (helm-make-source "Files from Current Directory" - 'helm-files-in-current-dir-source - :header-name (lambda (_name) - (format "Files from `%s'" - (abbreviate-file-name (helm-default-directory)))))) - -;;;###autoload -(defun helm-for-files () - "Preconfigured `helm' for opening files. -Run all sources defined in `helm-for-files-preferred-list'." - (interactive) - (require 'helm-x-files) - (unless helm-source-buffers-list - (setq helm-source-buffers-list - (helm-make-source "Buffers" 'helm-source-buffers))) - (helm :sources helm-for-files-preferred-list - :ff-transformer-show-only-basename nil - :buffer "*helm for files*" - :truncate-lines helm-buffers-truncate-lines)) - -(defun helm-multi-files-toggle-to-locate () - (interactive) - (with-helm-alive-p - (with-helm-buffer - (if (setq helm-multi-files--toggle-locate - (not helm-multi-files--toggle-locate)) - (progn - (helm-set-sources (unless (memq 'helm-source-locate - helm-sources) - (cons 'helm-source-locate helm-sources))) - (helm-set-source-filter '(helm-source-locate))) - (helm-kill-async-processes) - (helm-set-sources (remove 'helm-source-locate - helm-for-files-preferred-list)) - (helm-set-source-filter nil))))) -(put 'helm-multi-files-toggle-to-locate 'helm-only t) - -;;;###autoload -(defun helm-multi-files () - "Preconfigured helm like `helm-for-files' but running locate only on demand. - -Allow toggling back and forth from locate to others sources with -`helm-multi-files-toggle-locate-binding' key. -This avoids launching locate needlessly when what you are -searching for is already found." - (interactive) - (require 'helm-x-files) - (unless helm-source-buffers-list - (setq helm-source-buffers-list - (helm-make-source "Buffers" 'helm-source-buffers))) - (setq helm-multi-files--toggle-locate nil) - (helm-locate-set-command) - (helm-set-local-variable 'helm-async-outer-limit-hook - (list (lambda () - (when (and helm-locate-fuzzy-match - (not (string-match-p - "\\s-" helm-pattern))) - (helm-redisplay-buffer)))) - 'helm-ff-transformer-show-only-basename nil) - (let ((sources (remove 'helm-source-locate helm-for-files-preferred-list)) - (helm-locate-command - (if helm-locate-fuzzy-match - (unless (string-match-p "\\`locate -b" helm-locate-command) - (replace-regexp-in-string - "\\`locate" "locate -b" helm-locate-command)) - helm-locate-command)) - (old-key (lookup-key - helm-map - (read-kbd-macro helm-multi-files-toggle-locate-binding)))) - (with-helm-temp-hook 'helm-after-initialize-hook - (define-key helm-map (kbd helm-multi-files-toggle-locate-binding) - 'helm-multi-files-toggle-to-locate)) - (unwind-protect - (helm :sources sources - :buffer "*helm multi files*" - :truncate-lines helm-buffers-truncate-lines) - (define-key helm-map (kbd helm-multi-files-toggle-locate-binding) - old-key)))) - -;;;###autoload -(defun helm-recentf () - "Preconfigured `helm' for `recentf'." - (interactive) - (helm :sources 'helm-source-recentf - :ff-transformer-show-only-basename nil - :buffer "*helm recentf*")) - -(provide 'helm-for-files) - -;;; helm-for-files.el ends here diff --git a/elpa/helm-20251212.555/helm-global-bindings.el b/elpa/helm-20251212.555/helm-global-bindings.el deleted file mode 100644 index f24dc7b6..00000000 --- a/elpa/helm-20251212.555/helm-global-bindings.el +++ /dev/null @@ -1,106 +0,0 @@ -;;; helm-global-bindings.el --- Bind global helm commands -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2025 Thierry Volpiatto - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Code: - -(require 'helm-lib) ; For helm-aif (bug #2520). - - -;;; Command Keymap -;; -;; -(defgroup helm-global-bindings nil - "Global bindings for Helm." - :group 'helm) - -(defcustom helm-command-prefix-key - (helm-aif (car (where-is-internal 'Control-X-prefix (list global-map))) - (concat it [?c])) - "The prefix key used to call Helm commands from the `global-map'. - -Its default value is `C-x c'. -This key is bound to the function `helm-command-prefix' in the global map. -The definition of `helm-command-prefix' is the keymap `helm-command-map'. -Using `setq' to modify this variable will have no effect." - :type '(choice (string :tag "Key") (const :tag "no binding")) - :set - (lambda (var key) - (helm-aif (and (boundp var) (symbol-value var)) - (global-unset-key (read-kbd-macro it))) - (when key - (global-set-key (read-kbd-macro key) 'helm-command-prefix)) - (set var key))) - -(defvar helm-command-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "a") 'helm-apropos) - (define-key map (kbd "e") 'helm-etags-select) - (define-key map (kbd "l") 'helm-locate) - (define-key map (kbd "L") 'helm-locate-library) - (define-key map (kbd "s") 'helm-surfraw) - (define-key map (kbd "r") 'helm-regexp) - (define-key map (kbd "m") 'helm-man-woman) - (define-key map (kbd "t") 'helm-top) - (define-key map (kbd "o") 'helm-outline) - (define-key map (kbd "/") 'helm-find) - (define-key map (kbd "i") 'helm-imenu) - (define-key map (kbd "I") 'helm-imenu-in-all-buffers) - (define-key map (kbd "") 'helm-lisp-completion-at-point) - (define-key map (kbd "p") 'helm-list-emacs-process) - (define-key map (kbd "C-x r b") 'helm-filtered-bookmarks) - (define-key map (kbd "M-y") 'helm-show-kill-ring) - (define-key map (kbd "C-c ") 'helm-all-mark-rings) - (define-key map (kbd "C-x C-f") 'helm-find-files) - (define-key map (kbd "f") 'helm-multi-files) - (define-key map (kbd "C-:") 'helm-eval-expression-with-eldoc) - (define-key map (kbd "C-,") 'helm-calcul-expression) - (define-key map (kbd "M-x") 'helm-M-x) - (define-key map (kbd "M-s o") 'helm-occur) - (define-key map (kbd "M-g a") 'helm-do-grep-ag) - (define-key map (kbd "c") 'helm-colors) - (define-key map (kbd "F") 'helm-select-xfont) - (define-key map (kbd "8") 'helm-ucs) - (define-key map (kbd "C-c f") 'helm-recentf) - (define-key map (kbd "C-c g") 'helm-google-suggest) - (define-key map (kbd "h i") 'helm-info-at-point) - (define-key map (kbd "h r") 'helm-info-emacs) - (define-key map (kbd "h g") 'helm-info-gnus) - (define-key map (kbd "h h") 'helm-documentation) - (define-key map (kbd "C-x C-b") 'helm-buffers-list) - (define-key map (kbd "C-x r i") 'helm-register) - (define-key map (kbd "C-c C-x") 'helm-run-external-command) - (define-key map (kbd "b") 'helm-resume) - (define-key map (kbd "M-g i") 'helm-gid) - (define-key map (kbd "@") 'helm-packages) - (define-key map (kbd "h p") 'helm-finder) - map) - "Default keymap for \\[helm-command-prefix] commands. -The normal global definition of the character \\[helm-command-prefix] indirects to this keymap.") - -(fset 'helm-command-prefix helm-command-map) - - -;;; Menu - -(require 'helm-easymenu) - - -;;; Provide - -(provide 'helm-global-bindings) - -;;; helm-global-bindings.el ends here diff --git a/elpa/helm-20251212.555/helm-grep.el b/elpa/helm-20251212.555/helm-grep.el deleted file mode 100644 index 41841b69..00000000 --- a/elpa/helm-20251212.555/helm-grep.el +++ /dev/null @@ -1,1884 +0,0 @@ -;;; helm-grep.el --- Helm Incremental Grep. -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2025 Thierry Volpiatto - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Code: -(require 'ansi-color) -(require 'cl-lib) -(require 'format-spec) -(require 'helm) -(require 'helm-help) -(require 'helm-regexp) -(require 'project) - -;;; load wgrep proxy if it's available -(require 'wgrep-helm nil t) - -(declare-function helm-buffer-list "helm-buffers") -(declare-function View-quit "view") -(declare-function doc-view-goto-page "doc-view" (page)) -(declare-function pdf-view-goto-page "pdf-view" (page &optional window)) -(declare-function helm-mm-split-pattern "helm-multi-match") -(declare-function helm-comp-read "helm-mode") -(declare-function helm-occur "helm-occur") - -(defvar helm--ansi-color-regexp) -(defvar helm-ff-default-directory) -(defvar helm-tramp-verbose) -(defvar helm-grep-ack-types-cache) -(defvar helm-grep-git-grep-command) -(defvar helm-source-grep-git) -(defvar tramp-verbose) -(defvar helm-current-error) - -;;; Internals vars -;; -;; -(defvar helm-rzgrep-cache (make-hash-table :test 'equal)) -(defvar helm-grep-default-function 'helm-grep-init) -(defvar helm-zgrep-recurse-flag nil) -(defvar helm-grep-history nil) -(defvar helm-grep-ag-history nil) -(defvar helm-grep-last-targets nil) -(defvar helm-grep-include-files nil) -(defvar helm-grep-in-recurse nil) -(defvar helm-grep-use-zgrep nil) -(defvar helm-grep-default-directory-fn nil - "A function that should return a directory to expand candidate to. -It is intended to use as a let-bound variable, DON'T set this globaly.") -(defvar helm-pdfgrep-targets nil) -(defvar helm-grep-last-cmd-line nil) -(defvar helm-grep-split-line-regexp "^\\([[:lower:][:upper:]]?:?.*?\\):\\([0-9]+\\):\\(.*\\)") - - -;;; Keymaps -;; -;; -(defvar helm-grep-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-map) - (define-key map (kbd "M-") 'helm-goto-next-file) - (define-key map (kbd "M-") 'helm-goto-precedent-file) - (define-key map (kbd "C-c o") 'helm-grep-run-other-window-action) - (define-key map (kbd "C-c C-o") 'helm-grep-run-other-frame-action) - (define-key map (kbd "C-x C-s") 'helm-grep-run-save-buffer) - (define-key map (kbd "DEL") 'helm-delete-backward-no-update) - map) - "Keymap used in Grep sources.") - -(defvar helm-pdfgrep-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-map) - (define-key map (kbd "M-") 'helm-goto-next-file) - (define-key map (kbd "M-") 'helm-goto-precedent-file) - (define-key map (kbd "DEL") 'helm-delete-backward-no-update) - map) - "Keymap used in pdfgrep.") - -(defvar helm-grep-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "RET") 'helm-grep-mode-jump) - (define-key map (kbd "C-o") 'helm-grep-mode-jump-other-window) - (define-key map (kbd "") 'helm-grep-mode-jump-other-window-forward) - (define-key map (kbd "") 'helm-grep-mode-jump-other-window-backward) - (define-key map (kbd "") 'helm-gm-next-file) - (define-key map (kbd "") 'helm-gm-precedent-file) - (define-key map (kbd "M-n") 'helm-grep-mode-jump-other-window-forward) - (define-key map (kbd "M-p") 'helm-grep-mode-jump-other-window-backward) - (define-key map (kbd "M-N") 'helm-gm-next-file) - (define-key map (kbd "M-P") 'helm-gm-precedent-file) - map)) - - -(defgroup helm-grep nil - "Grep related Applications and libraries for Helm." - :group 'helm) - -(defcustom helm-grep-default-command - "grep --color=always -a -d skip %e -n%cH -e %p %f" - "Default grep format command for `helm-do-grep-1'. -Where: -'%e' format spec is for --exclude or --include grep options or - ack-grep --type option. (Not mandatory) - -'%c' format spec is for case-fold-search, - whether to use the -i option of grep. (Not mandatory) - When you specify this spec, helm grep will use smartcase - that is when a upcase character is found in pattern case will - be respected and no \\='-i' option will be used, otherwise, when - no upcase character is found in pattern always use \\='-i'. - If you don't want this behavior, don't use this spec and - specify or not the \\='-i' option. - Note that with ack-grep this is not needed, just specify - the \\='--smart-case' option. - -'%p' format spec is for pattern. (Mandatory) - -'%f' format spec is for filenames. (Mandatory) - -If your grep version doesn't support the --exclude/include args -don't specify the \\='%e' format spec. - -Helm also support ack-grep and git-grep. The following is a -default command example for ack-grep: - -\(setq helm-grep-default-command - \"ack-grep -Hn --color --smart-case --no-group %e -- %p %f\" - helm-grep-default-recurse-command - \"ack-grep -H --color --smart-case --no-group %e -- %p %f\") - -You can ommit the %e spec if you don't want to be prompted for -types. - -NOTE: Helm for ack-grep support ANSI sequences, so you can remove -the \"--no-color\" option safely (recommended). -However you should specify --color to enable multi matches highlighting -because ack disable it when output is piped. - -Same for grep you can use safely the option \"--color=always\" (default). -You can customize the color of matches using GREP_COLORS env var. -e.g: (setenv \"GREP_COLORS\" - \"ms=30;43:mc=30;43:sl=01;37:cx=:fn=35:ln=32:bn=32:se=36\") - -To enable ANSI color in git-grep just add \"--color=always\". -To customize the ANSI color in git-grep, GREP_COLORS have no effect, -you will have to setup this in your .gitconfig: - - [color \"grep\"] - match = black yellow - -Where \"black\" is the foreground and \"yellow\" the background. -See the git documentation for more infos. - -`helm-grep-default-command' and -`helm-grep-default-recurse-command' are independent, so you can -enable `helm-grep-default-command' with ack-grep and -`helm-grep-default-recurse-command' with grep if you want to be -faster on recursive grep. - -NOTE: Remote grepping is not available with ack-grep, and badly - supported with grep because tramp handles badly repeated - remote processes in a short delay (< to 5s)." - :type 'string) - -(defcustom helm-grep-default-recurse-command - "grep --color=always -a -d recurse %e -n%cH -e %p %f" - "Default recursive grep format command for `helm-do-grep-1'. -See `helm-grep-default-command' for format specs and infos about -ack-grep." - :type 'string) - -(defcustom helm-default-zgrep-command - "zgrep --color=always -a -n%cH -e %p %f" - "Default command for Zgrep. -See `helm-grep-default-command' for infos on format specs. -Option --color=always is supported and can be used safely to -replace the Helm internal match highlighting. See -`helm-grep-default-command' for more infos." - :type 'string) - -(defcustom helm-pdfgrep-default-command - "pdfgrep --color always -niH %s %s" - "Default command for pdfgrep. -Option \"--color always\" is supported starting Helm version -1.7.8. When used matches will be highlighted according to -GREP_COLORS env var." - :type 'string) - -(defcustom helm-pdfgrep-default-recurse-command - "pdfgrep --color always -rniH %s %s" - "Default recurse command for pdfgrep. -Option \"--color always\" is supported starting Helm version -1.7.8. When used matches will be highlighted according to -GREP_COLORS env var." - :type 'string) - -(defcustom helm-pdfgrep-default-read-command nil - "Default command to read pdf files from pdfgrep. -Where \\='%f' format spec is filename and \\='%p' is page number. -E.g. In Ubuntu you can set it to: - - \"evince --page-label=%p \\='%f'\" - -If set to nil either `doc-view-mode' or `pdf-view-mode' will be -used instead of an external command." - :type 'string) - -(defcustom helm-grep-max-length-history 100 - "Max number of elements to save in `helm-grep-history'." - :type 'integer) - -(defcustom helm-zgrep-file-extension-regexp - ".*\\(\\.gz\\|\\.bz\\|\\.xz\\|\\.lzma\\)$" - "Default file extensions zgrep will search in." - :type 'string) - -(defcustom helm-grep-preferred-ext nil - "This file extension will be preselected for grep." - :type 'string) - -(defcustom helm-grep-save-buffer-name-no-confirm nil - "When *hgrep* already exists, auto append suffix." - :type 'boolean) - -(defcustom helm-grep-ignored-files - (cons ".#*" (delq nil (mapcar (lambda (s) - (unless (string-match-p "/\\'" s) - (concat "*" s))) - completion-ignored-extensions))) - "List of file names which `helm-grep' shall exclude." - :type '(repeat string)) - -(defcustom helm-grep-ignored-directories - helm-walk-ignore-directories - "List of names of sub-directories which `helm-grep' shall not recurse into." - :type '(repeat string)) - -(defcustom helm-grep-truncate-lines t - "When nil the grep line that appears will not be truncated." - :type 'boolean) - -(defcustom helm-grep-file-path-style 'basename - "File path display style when grep results are displayed. -Possible value are: - basename: displays only the filename, none of the directory path - absolute: displays absolute path - relative: displays relative path from root grep directory." - :type '(choice (const :tag "Basename" basename) - (const :tag "Absolute" absolute) - (const :tag "Relative" relative))) - -(defcustom helm-grep-actions - (helm-make-actions - "Find File" 'helm-grep-action - "Find file other frame" 'helm-grep-other-frame - "Save results in grep buffer" 'helm-grep-save-results - "Find file other window (C-u vertically)" 'helm-grep-other-window) - "Actions for helm grep." - :type '(alist :key-type string :value-type function)) - -(defcustom helm-grep-pipe-cmd-switches nil - "A list of additional parameters to pass to grep pipe command. -This will be used to pipe command for multiple pattern matching -for grep, zgrep ack-grep and git-grep backends. -If you add extra args for ack-grep, use ack-grep options, for -others (grep, zgrep and git-grep) use grep options. -Here are the commands where you may want to add switches: - - grep --color=always - ack-grep --smart-case --color - -You probably don't need to use this unless you know what you are -doing." - :type '(repeat string)) - -(defcustom helm-grep-ag-pipe-cmd-switches nil - "A list of additional parameters to pass to grep-ag pipe command. -Use parameters compatibles with the backend you are using -\(i.e. AG for AG, PT for PT or RG for RG) -Here are the commands where you may want to add switches: - - ag -S --color - rg -N -S --color=? - -For RG the value of --color= is computed according to the --color= -value used in `helm-grep-ag-command'. - -Note also that by default the \"--\" option is always used, you don't -need to add it here. - -You probably don't need to use this unless you know what you are -doing." - :type '(repeat string)) - -(defcustom helm-grep-input-idle-delay 0.1 - "Idle time before updating, specified in seconds. -A lower value (default) means Helm will display the results -faster. Increasing it to a higher value (e.g. 0.6) prevents the -buffer from flickering when updating." - :type 'float) - -(defcustom helm-grep-use-ioccur-style-keys t - "Use Arrow keys to jump to occurences. -Note that if you define this variable with `setq' your change -will have no effect, use customize instead." - :type 'boolean - :set (lambda (var val) - (set var val) - (if val - (progn - (define-key helm-grep-map (kbd "") 'helm-execute-persistent-action) - (define-key helm-grep-map (kbd "") 'helm-grep-run-default-action)) - (define-key helm-grep-map (kbd "") nil) - (define-key helm-grep-map (kbd "") nil)))) - -(defcustom helm-grep-ag-command - (cond ((executable-find "rg") - "rg --color=always --smart-case --search-zip --no-heading --line-number %s -- %s %s") - ((executable-find "ag") - "ag --line-numbers -S --color --nogroup %s -- %s %s")) - "The default command for RG or AG. - -Prefer RG by default if available. - -Update: PT is still mentionned in this documentation but it seems it -doesn't exists anymore, or at least it is no more maintained. - -Takes three format specs, the first for type(s), the second for -pattern and the third for directory. - -You can use safely \"--color\" (used by default) with AG RG and -PT. - -NOTE: Usage of \"--color=never\" is discouraged as it uses Elisp -to colorize matched items which is slower than using the native -colorization of backend, however it is still supported. - -For ripgrep here is the command line to use: - - rg --color=always --smart-case --no-heading --line-number %s -- %s %s - -And to customize colors (always for ripgrep) use something like this: - - rg --color=always --colors \\='match:bg:yellow' --colors \\='match:fg:black' -\--smart-case --no-heading --line-number %s -- %s %s - -This will change color for matched items from foreground red (the -default) to a yellow background with a black foreground. Note -that your color settings for RG will not work properly with -multiples pattern if you have configured colors in rg config file -instead of command line. For more enhanced settings of ansi -colors see https://github.com/emacs-helm/helm/issues/2313 - -You must use an output format that fit with helm grep, that is: - - \"filename:line-number:string\" - -The option \"--nogroup\" allow this. -The option \"--line-numbers\" is also mandatory except with -PT (not supported). -For RG the options \"--no-heading\" and \"--line-number\" are the -ones to use. - -When modifying the default colors of matches with e.g. -\"--color-match\" option of AG or \"--colors\" option of ripgrep -you may want to modify as well `helm-grep-ag-pipe-cmd-switches' -to have all matches colorized with the same color in multi -match. - -Of course you can use several other options, see the man page of the -backend you are using." - :type 'string) - -(defcustom helm-grep-git-grep-command - "git --no-pager grep -n%cH --color=always --full-name -e %p -- %f" - "The git grep default command line. -The option \"--color=always\" can be used safely. -The color of matched items can be customized in your .gitconfig -See `helm-grep-default-command' for more infos. - -The \"--exclude-standard\" and \"--no-index\" switches allow -skipping unwanted files specified in ~/.gitignore_global and -searching files not already staged (not enabled by default). - -You have also to enable this in global \".gitconfig\" with - \"git config --global core.excludesfile ~/.gitignore_global\"." - :type 'string) - - -;;; Faces -;; -;; -(defgroup helm-grep-faces nil - "Customize the appearance of helm-grep." - :prefix "helm-" - :group 'helm-grep - :group 'helm-faces) - -(defface helm-grep-match - `((((background light)) - ,@(and (>= emacs-major-version 27) '(:extend t)) - :foreground "#b00000") - (((background dark)) - ,@(and (>= emacs-major-version 27) '(:extend t)) - :foreground "gold1")) - "Face used to highlight grep matches. -Have no effect when grep backend use \"--color=\"." - :group 'helm-grep-faces) - -(defface helm-grep-file - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :foreground "BlueViolet" - :underline t)) - "Face used to highlight grep results filenames." - :group 'helm-grep-faces) - -(defface helm-grep-lineno - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :foreground "DarkOrange1")) - "Face used to highlight grep number lines." - :group 'helm-grep-faces) - -(defface helm-grep-finish - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :foreground "green")) - "Face used in mode line when grep is finish." - :group 'helm-grep-faces) - -(defface helm-grep-cmd-line - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :inherit font-lock-type-face)) - "Face used to highlight grep command line when no results." - :group 'helm-grep-faces) - - -;;; Init -;; -;; -(defun helm-grep-prepare-candidates (candidates in-directory) - "Prepare filenames and directories CANDIDATES for grep command line." - ;; If one or more candidate is a directory, search in all files - ;; of this candidate (e.g /home/user/directory/*). - ;; If r option is enabled search also in subdidrectories. - ;; We need here to expand wildcards to support crap windows filenames - ;; as grep doesn't accept quoted wildcards (e.g "dir/*.el"). - (if helm-zgrep-recurse-flag - (mapconcat 'shell-quote-argument candidates " ") - ;; When candidate is a directory, search in all its files. - ;; NOTE that `file-expand-wildcards' will return also - ;; directories, they will be ignored by grep but not - ;; by ack-grep that will grep all files of this directory - ;; without recursing in their subdirs though, see that as a one - ;; level recursion with ack-grep. - ;; So I leave it as it is, considering it is a feature. [1] - (cl-loop for i in candidates append - (cond ((string-match "^git" helm-grep-default-command) - (list i)) - ;; Candidate is a directory and we use recursion or ack. - ((and (file-directory-p i) - (or helm-grep-in-recurse - ;; ack-grep accept directory [1]. - (helm-grep-use-ack-p))) - (list (expand-file-name i))) - ;; Grep doesn't support directory only when not in recurse. - ((file-directory-p i) - (file-expand-wildcards - (concat (file-name-as-directory (expand-file-name i)) "*") t)) - ;; Candidate is a file or wildcard and we use recursion, use the - ;; current directory instead of candidate. - ((and (or (file-exists-p i) (string-match "[*]" i)) - helm-grep-in-recurse) - (list (expand-file-name - (directory-file-name ; Needed for windoze. - (file-name-directory (directory-file-name i)))))) - ;; Else should be one or more file/directory - ;; possibly marked. - ;; When real is a normal filename without wildcard - ;; file-expand-wildcards returns a list of one file. - ;; wildcards should have been already handled by - ;; helm-read-file-name or helm-find-files but do it from - ;; here too in case we are called from elsewhere. - (t (file-expand-wildcards i t))) into all-files ; [1] - finally return - (let ((files (if (file-remote-p in-directory) - ;; Grep don't understand tramp filenames - ;; use the local name. - (mapcar (lambda (x) - (file-remote-p x 'localname)) - all-files) - all-files))) - ;; When user mark files and use recursion with grep - ;; backend enabled, the loop collect on each marked - ;; candidate its `file-name-directory' and we endup with - ;; duplicates (Bug#1714). FIXME: For now as a quick fix - ;; I just remove dups here but I should handle this inside - ;; the cond above. - (setq files (helm-fast-remove-dups files :test 'equal)) - (if (string-match "^git" helm-grep-default-command) - (mapconcat 'identity files " ") - (mapconcat 'shell-quote-argument files " ")))))) - -(defun helm-grep-command (&optional recursive grep) - (let* ((com (if recursive - helm-grep-default-recurse-command - helm-grep-default-command)) - (exe (if grep - (symbol-name grep) - (and com (car (split-string com " ")))))) - (if (and exe (string= exe "git")) "git-grep" exe))) - -(cl-defun helm-grep-use-ack-p (&key where) - (let* ((rec-com (helm-grep-command t)) - (norm-com (helm-grep-command)) - (norm-com-ack-p (string-match "\\`ack" norm-com)) - (rec-com-ack-p (and rec-com (string-match "\\`ack" rec-com)))) - (cl-case where - (default (and norm-com norm-com-ack-p)) - (recursive (and rec-com rec-com-ack-p)) - (strict (and norm-com rec-com rec-com-ack-p norm-com-ack-p)) - (t (and (not (and norm-com (string= norm-com "git-grep"))) - (or (and norm-com norm-com-ack-p) - (and rec-com rec-com-ack-p))))))) - -(defun helm-grep--pipe-command-for-grep-command (smartcase pipe-switches &optional grep-cmd) - (helm-acase (or grep-cmd (helm-grep-command)) - ;; Use grep for GNU regexp based tools. - (("grep" "zgrep" "git-grep") - (format "grep --color=always%s %s" - (if smartcase " -i" "") - pipe-switches)) - ;; Use ack-grep for PCRE based tools. - ;; Sometimes ack-grep cmd is ack only so compare by matching ack. - ((guard* (string-match-p "ack" it)) - (format "%s --smart-case --color %s" it pipe-switches)))) - -(defun helm-grep--prepare-cmd-line (only-files &optional include zgrep) - (let* ((default-directory (or helm-ff-default-directory - (helm-default-directory) - default-directory)) - (fnargs (helm-grep-prepare-candidates - only-files default-directory)) - (ignored-files (unless (helm-grep-use-ack-p) - (mapconcat - (lambda (x) - (concat "--exclude=" - (shell-quote-argument x))) - helm-grep-ignored-files " "))) - (ignored-dirs (unless (helm-grep-use-ack-p) - (mapconcat - ;; Need grep version >=2.5.4 - ;; of Gnuwin32 on windoze. - (lambda (x) - (concat "--exclude-dir=" - (shell-quote-argument x))) - helm-grep-ignored-directories " "))) - (exclude (unless (helm-grep-use-ack-p) - (let ((inc (and include - (concat include " "))) - (igfiles (and ignored-files - (concat ignored-files " "))) - (igdirs (and helm-grep-in-recurse - ignored-dirs))) - (concat inc igfiles igdirs)))) - (types (and (helm-grep-use-ack-p) - ;; When %e format spec is not specified - ;; in `helm-grep-default-command' - ;; we need to pass an empty string - ;; to types to avoid error. - (or include ""))) - (smartcase (if (helm-grep-use-ack-p) - "" - (unless (let ((case-fold-search nil)) - (string-match-p - "[[:upper:]]" helm-pattern)) - "i"))) - (helm-grep-default-command - (concat helm-grep-default-command " %m")) ; `%m' like multi. - (patterns (helm-mm-split-pattern helm-pattern t)) - (pipe-switches (mapconcat 'identity helm-grep-pipe-cmd-switches " ")) - (pipes - (helm-aif (cdr patterns) - (cl-loop with pipcom = (helm-grep--pipe-command-for-grep-command - smartcase pipe-switches) - for p in it concat - (format " | %s %s" pipcom (shell-quote-argument p))) - ""))) - (format-spec - helm-grep-default-command - (delq nil - (list (unless zgrep - (if types - (cons ?e types) - (cons ?e exclude))) - (cons ?c (or smartcase "")) - (cons ?p (shell-quote-argument (car patterns))) - (cons ?f fnargs) - (cons ?m pipes)))))) - -(defun helm-grep-init (cmd-line) - "Start an asynchronous grep process with CMD-LINE using ZGREP if non-nil." - (let* ((default-directory (or helm-ff-default-directory - (helm-default-directory) - default-directory)) - (zgrep (string-match "\\`zgrep" cmd-line)) - ;; Use pipe only with grep, zgrep or git-grep. - (process-connection-type (and (not zgrep) (helm-grep-use-ack-p))) - (tramp-verbose helm-tramp-verbose) - (start-time (float-time)) - (proc-name (if helm-grep-use-zgrep - "Zgrep" - (capitalize - (if helm-grep-in-recurse - (helm-grep-command t) - (helm-grep-command))))) - non-essential) - ;; Start grep process. - (helm-log "helm-grep-init" "Starting Grep process in directory `%s'" default-directory) - (helm-log "helm-grep-init" "Command line used was:\n\n%s" - (concat ">>> " (propertize cmd-line 'face 'helm-grep-cmd-line) "\n\n")) - (prog1 ; This function should return the process first. - (start-file-process-shell-command - proc-name helm-buffer cmd-line) - ;; Init sentinel. - (set-process-sentinel - (get-buffer-process helm-buffer) - (lambda (process event) - (let* ((err (process-exit-status process)) - (noresult (= err 1))) - (unless (and err (> err 0)) - (helm-process-deferred-sentinel-hook - process event (helm-default-directory))) - (cond ((and noresult - ;; This is a workaround for zgrep - ;; that exit with code 1 - ;; after a certain amount of results. - (with-helm-buffer (helm-empty-buffer-p))) - (with-helm-buffer - (insert (concat "* Exit with code 1, no result found," - " command line was:\n\n " - (propertize helm-grep-last-cmd-line - 'face 'helm-grep-cmd-line))) - (setq mode-line-format - `(" " mode-line-buffer-identification " " - (:eval (format "L%s" (helm-candidate-number-at-point))) " " - (:eval (propertize - (format - "[%s process finished - (no results)] " - ,proc-name) - 'face 'helm-grep-finish)))))) - ((or (string= event "finished\n") - (process-get process 'reach-limit) - (and noresult - ;; This is a workaround for zgrep - ;; that exit with code 1 - ;; after a certain amount of results. - (with-helm-buffer (not (helm-empty-buffer-p))))) - (helm-log "helm-grep-init" "%s process finished with %s results in %fs" - proc-name - (helm-get-candidate-number) - (- (float-time) start-time)) - (helm-maybe-show-popup-tip-info) - (with-helm-window - (setq mode-line-format - `(" " mode-line-buffer-identification " " - (:eval (format "L%s" (helm-candidate-number-at-point))) " " - (:eval (propertize - (format - "[%s process finished in %.2fs - (%s results)] " - ,proc-name - ,(- (float-time) start-time) - (helm-get-candidate-number)) - 'face 'helm-grep-finish)))) - (force-mode-line-update) - (when (and helm-allow-mouse helm-selection-point) - (helm--bind-mouse-for-selection helm-selection-point)))) - ;; Catch error output in log. - (t (helm-log - "helm-grep-init" - "Error: %s %s" - proc-name - (replace-regexp-in-string "\n" "" event)))))))))) - -(defun helm-grep-collect-candidates () - (let ((cmd-line (helm-grep--prepare-cmd-line - helm-grep-last-targets - helm-grep-include-files - helm-grep-use-zgrep))) - (set (make-local-variable 'helm-grep-last-cmd-line) cmd-line) - (funcall helm-grep-default-function cmd-line))) - - -;;; Actions -;; -;; -(defun helm-grep-action (candidate &optional where) - "Define a default action for `helm-do-grep-1' on CANDIDATE. -WHERE can be `other-window' or `other-frame'." - (let* ((split (helm-grep-split-line candidate)) - (split-pat (helm-mm-split-pattern helm-input)) - (lineno (string-to-number (nth 1 split))) - (loc-fname (or (with-current-buffer - (if (eq major-mode 'helm-grep-mode) - (current-buffer) - helm-buffer) - (get-text-property (pos-bol) - 'helm-grep-fname)) - (car split))) - (tramp-fname (file-remote-p (or helm-ff-default-directory - default-directory))) - (fname (if tramp-fname - (concat tramp-fname loc-fname) - loc-fname))) - (helm-log "helm-grep-action" "helm-grep-action fname: %s" fname ) - (cl-case where - (other-window (helm-window-show-buffers - (list (find-file-noselect fname)) t)) - (other-frame (find-file-other-frame fname)) - (grep (helm-grep-save-results-1)) - (pdf (if helm-pdfgrep-default-read-command - (helm-pdfgrep-action-1 split lineno (car split)) - (find-file (car split)) - (if (derived-mode-p 'pdf-view-mode) - (pdf-view-goto-page lineno) - (doc-view-goto-page lineno)))) - (t (find-file fname))) - (unless (or (eq where 'grep) (eq where 'pdf)) - (helm-goto-line lineno) - ;; Move point to the nearest matching regexp from bol. - (cl-loop for reg in split-pat - when (save-excursion - (condition-case _err - (if helm-migemo-mode - (helm-mm-migemo-forward reg (pos-eol) t) - (re-search-forward reg (pos-eol) t)) - (invalid-regexp nil))) - collect (match-beginning 0) into pos-ls - finally (when pos-ls (goto-char (apply #'min pos-ls)))) - ;; Save history - (unless (or helm-in-persistent-action - (eq major-mode 'helm-grep-mode) - (string= helm-pattern "")) - (setq helm-grep-history - (cons helm-pattern - (delete helm-pattern helm-grep-history))) - (when (> (length helm-grep-history) - helm-grep-max-length-history) - (setq helm-grep-history - (delete (car (last helm-grep-history)) - helm-grep-history))))))) - -(defun helm-grep-persistent-action (candidate) - "Persistent action for `helm-do-grep-1'. -With a prefix arg record CANDIDATE in `mark-ring'." - (helm-grep-action candidate) - (helm-highlight-current-line)) - -(defun helm-grep-other-window (candidate) - "Jump to result in other window from helm grep." - (helm-grep-action candidate 'other-window)) - -(defun helm-grep-other-frame (candidate) - "Jump to result in other frame from helm grep." - (helm-grep-action candidate 'other-frame)) - -(defun helm-goto-next-or-prec-file (n) - "Go to next or precedent candidate file in helm grep/etags buffers. -If N is positive go forward otherwise go backward." - (let* ((allow-mode (or (eq major-mode 'helm-grep-mode) - (eq major-mode 'helm-moccur-mode) - (eq major-mode 'helm-occur-mode))) - (sel (if allow-mode - (buffer-substring (pos-bol) (pos-eol)) - (helm-get-selection nil t))) - (current-line-list (helm-grep-split-line sel)) - (current-fname (nth 0 current-line-list)) - (bob-or-eof (if (eq n 1) 'eobp 'bobp)) - (mark-maybe (lambda () - (if allow-mode - (ignore) - (helm-mark-current-line))))) - (catch 'break - (while (not (funcall bob-or-eof)) - (forward-line n) ; Go forward or backward depending of n value. - ;; Exit when current-fname is not matched or in `helm-grep-mode' - ;; the line is not a grep line i.e 'fname:num:tag'. - (setq sel (buffer-substring (pos-bol) (pos-eol))) - (when helm-allow-mouse - (helm--mouse-reset-selection-help-echo)) - (unless (or (string= current-fname - (car (helm-grep-split-line sel))) - (and (eq major-mode 'helm-grep-mode) - (not (get-text-property (pos-bol) 'helm-grep-fname)))) - (funcall mark-maybe) - (throw 'break nil)))) - (cond ((and (> n 0) (eobp)) - (re-search-backward ".") - (forward-line 0) - (funcall mark-maybe)) - ((and (< n 0) (bobp)) - (helm-aif (next-single-property-change (pos-bol) 'helm-grep-fname) - (goto-char it) - (forward-line 1)) - (funcall mark-maybe))) - (unless allow-mode - (helm-follow-execute-persistent-action-maybe) - (helm-log-run-hook "helm-goto-next-or-prec-file" 'helm-move-selection-after-hook)))) - -;;;###autoload -(defun helm-goto-precedent-file () - "Go to previous file in Helm grep/etags buffers." - (interactive) - (with-helm-alive-p - (with-helm-window - (helm-goto-next-or-prec-file -1)))) -(put 'helm-goto-precedent-file 'helm-only t) - -;;;###autoload -(defun helm-goto-next-file () - "Go to previous file in Helm grep/etags buffers." - (interactive) - (with-helm-window - (helm-goto-next-or-prec-file 1))) -(put 'helm-goto-next-file 'helm-only t) - -(helm-make-command-from-action helm-grep-run-default-action - "Run grep default action from `helm-do-grep-1'." - 'helm-grep-action) - -(helm-make-command-from-action helm-grep-run-other-window-action - "Run grep goto other window action from `helm-do-grep-1'." - 'helm-grep-other-window) - -(helm-make-command-from-action helm-grep-run-other-frame-action - "Run grep goto other frame action from `helm-do-grep-1'." - 'helm-grep-other-frame) - -(helm-make-command-from-action helm-grep-run-save-buffer - "Run grep save results action from `helm-do-grep-1'." - 'helm-grep-save-results) - -(defun helm-grep-quit-an-find-file-fn (source) - (let* ((sel (helm-get-selection nil nil source)) - (grep-line (and (stringp sel) - (helm-grep-split-line sel)))) - (if (and grep-line (file-exists-p (car grep-line))) - (expand-file-name (car grep-line)) - default-directory))) - -;;; helm-grep-mode -;; -;; -(defun helm-grep-save-results (candidate) - (helm-grep-action candidate 'grep)) - -(defvar helm-grep-mode-use-pcre nil) -(defun helm-grep-save-results-1 () - "Save Helm grep result in a `helm-grep-mode' buffer." - (let* ((buf "*hgrep*") - new-buf - (pattern (with-helm-buffer helm-input-local)) - (src (helm-get-current-source)) - (src-name (assoc-default 'name src))) - (when (get-buffer buf) - (if helm-grep-save-buffer-name-no-confirm - (setq new-buf (format "*hgrep|%s|-%s" pattern - (format-time-string "%H-%M-%S*"))) - (setq new-buf (helm-read-string "GrepBufferName: " buf)) - (cl-loop for b in (helm-buffer-list) - when (and (string= new-buf b) - (not (y-or-n-p - (format "Buffer `%s' already exists overwrite? " - new-buf)))) - do (setq new-buf (helm-read-string "GrepBufferName: " "*hgrep ")))) - (setq buf new-buf)) - (with-current-buffer (get-buffer-create buf) - (setq default-directory (or helm-ff-default-directory - (helm-default-directory) - default-directory)) - (setq-local helm-grep-mode-use-pcre (helm-get-attr 'pcre src)) - (setq buffer-read-only t) - (let ((inhibit-read-only t) - (map (make-sparse-keymap))) - (erase-buffer) - (insert "-*- mode: helm-grep -*-\n\n" - (format "%s Results for `%s':\n\n" src-name pattern)) - (save-excursion - (insert (with-current-buffer helm-buffer - (goto-char (point-min)) (forward-line 1) - (buffer-substring (point) (point-max))))) - (save-excursion - (while (not (eobp)) - (add-text-properties (pos-bol) (pos-eol) - `(keymap ,map - help-echo ,(concat - (get-text-property - (point) 'helm-grep-fname) - "\nmouse-1: set point\nmouse-2: jump to selection") - mouse-face highlight)) - (define-key map [mouse-1] 'mouse-set-point) - (define-key map [mouse-2] 'helm-grep-mode-mouse-jump) - (define-key map [mouse-3] 'ignore) - (forward-line 1)))) - (helm-grep-mode)) - (pop-to-buffer buf) - (setq next-error-last-buffer (get-buffer buf)) - (message "Helm %s Results saved in `%s' buffer" src-name buf))) - -(defun helm-grep-mode-mouse-jump (event) - (interactive "e") - (let* ((window (posn-window (event-end event))) - (pos (posn-point (event-end event)))) - (with-selected-window window - (when (eq major-mode 'helm-grep-mode) - (goto-char pos) - (helm-grep-mode-jump))))) -(put 'helm-grep-mode-mouse-jump 'helm-only t) - -(defun helm-grep-next-error (&optional argp reset) - "Goto ARGP position from a `helm-grep-mode' buffer. -RESET non-nil means rewind to the first match. -This is the `next-error-function' for `helm-grep-mode'." - (interactive "p") - (goto-char (cond (reset (point-min)) - ((and (< argp 0) helm-current-error) - (line-beginning-position)) - ((and (> argp 0) helm-current-error) - (line-end-position)) - ((point)))) - (let ((fun (if (> argp 0) - #'next-single-property-change - #'previous-single-property-change))) - (helm-aif (funcall fun (point) 'helm-grep-fname) - (progn - (goto-char it) - ;; `helm-current-error' is set in - ;; `helm-grep-mode-jump'. - (helm-grep-mode-jump)) - (user-error "No more matches")))) -(put 'helm-grep-next-error 'helm-only t) - -;;;###autoload -(defun helm-revert-next-error-last-buffer () - "Revert last `next-error' buffer from `current-buffer'. - -Accept to revert only `helm-grep-mode' or `helm-occur-mode' buffers. -Use this when you want to revert the `next-error' buffer after -modifications in `current-buffer'." - (interactive) - (let ((buffer (next-error-find-buffer)) - (linum (line-number-at-pos)) - (bufname (buffer-name))) - (if buffer - (with-current-buffer buffer - (helm-aif (memq major-mode '(helm-grep-mode helm-occur-mode)) - (progn (revert-buffer) - ;; helm-occur-mode revert fn is synchronous so - ;; reajust from here (it is done with - ;; helm-grep-mode in its sentinel). - (when (eq (car it) 'helm-occur-mode) - (helm-grep-goto-closest-from-linum linum bufname))) - (error "No suitable buffer to revert found"))) - (error "No suitable buffer to revert found")))) - -(define-derived-mode helm-grep-mode - special-mode "helm-grep" - "Major mode to provide actions in helm grep saved buffer. - -Special commands: -\\{helm-grep-mode-map}" - (set (make-local-variable 'helm-grep-last-cmd-line) - (with-helm-buffer helm-grep-last-cmd-line)) - (set (make-local-variable 'revert-buffer-function) - #'helm-grep-mode--revert-buffer-function) - (set (make-local-variable 'next-error-function) - #'helm-grep-next-error) - (set (make-local-variable 'helm-current-error) nil)) -(put 'helm-grep-mode 'helm-only t) - -(defun helm-grep-mode--revert-buffer-function (&optional _ignore-auto _noconfirm) - (goto-char (point-min)) - (when (re-search-forward helm-grep-split-line-regexp nil t) (forward-line 0)) - (let ((inhibit-read-only t)) - (delete-region (point) (point-max))) - (message "Reverting buffer...") - (let ((process-connection-type - ;; Git needs a nil value otherwise it tries to use a pager. - (null (string-match-p "\\`git" helm-grep-last-cmd-line)))) - (set-process-sentinel - (start-file-process-shell-command - "hgrep" (generate-new-buffer "*hgrep revert*") helm-grep-last-cmd-line) - 'helm-grep-mode--sentinel))) - -(defun helm-grep-mode--sentinel (process event) - (when (string= event "finished\n") - (with-current-buffer (if (eq major-mode 'helm-grep-mode) - (current-buffer) - (next-error-find-buffer)) - (let ((inhibit-read-only t)) - (save-excursion - (cl-loop for l in (with-current-buffer (process-buffer process) - (prog1 (split-string (buffer-string) "\n") - (kill-buffer))) - for line = (if (string-match-p helm--ansi-color-regexp l) - (ansi-color-apply l) l) - when (string-match helm-grep-split-line-regexp line) - do (insert (propertize - (car (helm-grep-filter-one-by-one - line helm-grep-mode-use-pcre)) - ;; needed for wgrep. - 'helm-realvalue line) - "\n")))) - (when (fboundp 'wgrep-cleanup-overlays) - (wgrep-cleanup-overlays (point-min) (point-max)))) - (unless (eq major-mode 'helm-grep-mode) - (let ((bufname (buffer-name)) - (linum (line-number-at-pos))) - (with-current-buffer (next-error-find-buffer) - (helm-grep-goto-closest-from-linum linum bufname)))) - (message "Reverting buffer done") - (when executing-kbd-macro (sit-for 1)))) - -(defun helm-grep-goto-closest-from-linum (linum bufname) - (goto-char (point-min)) - (catch 'break - (while (re-search-forward (format "^%s:\\([0-9]+\\):" (regexp-quote bufname)) nil t) - (let ((numline (string-to-number (match-string 1)))) - (when (< (- linum numline) 0) - (forward-line -1) - (throw 'break nil)))))) - -(defun helm-gm-next-file () - (interactive) - (helm-goto-next-or-prec-file 1)) -(put 'helm-gm-next-file 'helm-only t) - -(defun helm-gm-precedent-file () - (interactive) - (helm-goto-next-or-prec-file -1)) -(put 'helm-gm-precedent-file 'helm-only t) - -(defun helm-grep-mode-jump () - (interactive) - (setq next-error-last-buffer (current-buffer)) - (setq-local helm-current-error (point-marker)) - (helm-grep-action - (buffer-substring (pos-bol) (pos-eol))) - (helm-match-line-cleanup-pulse)) - -(defun helm-grep-mode-jump-other-window-1 (arg) - (condition-case nil - (progn - (when (or (eq last-command 'helm-grep-mode-jump-other-window-forward) - (eq last-command 'helm-grep-mode-jump-other-window-backward)) - (forward-line arg)) - (save-selected-window - (helm-grep-action (buffer-substring (pos-bol) (pos-eol)) - 'other-window) - (helm-match-line-cleanup-pulse) - (recenter))) - (error nil))) - -(defun helm-grep-mode-jump-other-window-forward (arg) - (interactive "p") - (helm-grep-mode-jump-other-window-1 arg)) - -(defun helm-grep-mode-jump-other-window-backward (arg) - (interactive "p") - (helm-grep-mode-jump-other-window-1 (- arg))) - -(defun helm-grep-mode-jump-other-window () - (interactive) - (setq next-error-last-buffer (current-buffer)) - (setq-local helm-current-error (point-marker)) - (let ((candidate (buffer-substring (pos-bol) (pos-eol)))) - (condition-case nil - (progn (helm-grep-action candidate 'other-window) - (helm-match-line-cleanup-pulse)) - (error nil)))) - - -;;; ack-grep types -;; -;; -(defun helm-grep-hack-types () - "Return a list of known ack-grep types." - (with-temp-buffer - ;; "--help-types" works with both 1.96 and 2.1+, while - ;; "--help types" works only with 1.96 Bug#422. - ;; `helm-grep-command' should return the ack executable - ;; when this function is used in the right context - ;; i.e After checking is we are using ack-grep with - ;; `helm-grep-use-ack-p'. - (call-process (helm-grep-command t) nil t nil "--help-types") - (goto-char (point-min)) - (cl-loop while (re-search-forward "^ +\\([^. ]+\\) +\\(.*\\)" nil t) - collect (cons (concat (match-string 1) - " [" (match-string 2) "]") - (match-string 1)) - collect (cons (concat "no" (match-string 1) - " [" (match-string 2) "]") - (concat "no" (match-string 1)))))) - -(defun helm-grep-ack-types-transformer (candidates _source) - (cl-loop for i in candidates - if (stringp i) - collect (rassoc i helm-grep-ack-types-cache) - else - collect i)) - -(defvar helm-grep-ack-types-cache nil) -(defun helm-grep-read-ack-type () - "Select types for the \\='--type' argument of ack-grep." - (require 'helm-mode) - (require 'helm-adaptive) - (setq helm-grep-ack-types-cache (helm-grep-hack-types)) - (let ((types (helm-comp-read - "Types: " helm-grep-ack-types-cache - :name "*Ack-grep types*" - :marked-candidates t - :must-match t - :fc-transformer '(helm-adaptive-sort - helm-grep-ack-types-transformer) - :buffer "*helm ack-types*"))) - (mapconcat (lambda (type) (concat "--type=" type)) types " "))) - - -;;; grep extensions -;; -;; -(defun helm-grep-guess-extensions (files) - "Try to guess file extensions in FILES list when using grep recurse. -These extensions will be added to command line with --include arg -of grep." - (cl-loop with ext-list = (list helm-grep-preferred-ext "*") - with lst = (if (file-directory-p (car files)) - (directory-files - (car files) nil - directory-files-no-dot-files-regexp) - files) - for i in lst - for ext = (file-name-extension i 'dot) - for glob = (and ext (not (string= ext "")) - (concat "*" ext)) - unless (or (not glob) - (and glob-list (member glob glob-list)) - (and glob-list (member glob ext-list)) - (and glob-list (member glob helm-grep-ignored-files))) - collect glob into glob-list - finally return (delq nil (append ext-list glob-list)))) - -(defun helm-grep-get-file-extensions (files) - "Try to return a list of file extensions to pass to \\='--include' arg of grep." - (require 'helm-adaptive) - (let* ((all-exts (helm-grep-guess-extensions - (mapcar 'expand-file-name files))) - (extensions (helm-comp-read "Search Only in: " all-exts - :marked-candidates t - :fc-transformer 'helm-adaptive-sort - :buffer "*helm grep exts*" - :name "*helm grep extensions*"))) - (when (listp extensions) ; Otherwise it is empty string returned by C-RET. - ;; If extensions is a list of one string containing spaces, - ;; assume user entered more than one glob separated by space(s) and - ;; split this string to pass it later to mapconcat. - ;; e.g '("*.el *.py") - (cl-loop for i in extensions - append (split-string-and-unquote i " "))))) - - -;;; Set up source -;; -;; -(defvar helm-grep-before-init-hook nil - "Hook that runs before initialization of the Helm buffer.") - -(defvar helm-grep-after-init-hook nil - "Hook that runs after initialization of the Helm buffer.") - -(defclass helm-grep-class (helm-source-async) - ((candidates-process :initform 'helm-grep-collect-candidates) - (filtered-candidate-transformer :initform #'helm-grep-fc-transformer) - (popup-info :initform #'helm-grep-popup-info-fn) - (keymap :initform 'helm-grep-map) - (pcre :initarg :pcre :initform nil - :documentation - " Backend is using pcre regexp engine when non-nil.") - (nohighlight :initform t) - (nomark :initform t) - (backend :initarg :backend - :initform nil - :documentation - " The grep backend that will be used. - It is currently used only as an internal flag - and doesn't set the backend by itself. - You probably don't want to modify this.") - (help-message :initform 'helm-grep-help-message) - (history :initform 'helm-grep-history) - (action :initform 'helm-grep-actions) - (persistent-action :initform 'helm-grep-persistent-action) - (persistent-help :initform "Jump to line (`C-u' Record in mark ring)") - (requires-pattern :initform 2) - (before-init-hook :initform 'helm-grep-before-init-hook) - (after-init-hook :initform 'helm-grep-after-init-hook) - (find-file-target :initform #'helm-grep-quit-an-find-file-fn) - (group :initform 'helm-grep))) - -(defvar helm-source-grep nil) - -(defun helm-do-grep-1 (targets &optional recurse backend exts - default-input input source) - "Launch helm using backend BACKEND on a list of TARGETS files. - -When RECURSE is given and BACKEND is \\='grep' use -r option of -BACKEND and prompt user for EXTS to set the --include args of -BACKEND. -Interactively you can give more than one arg separated by space -at prompt. -E.g.: - $Pattern: *.el *.py *.tex - -From Lisp use the EXTS argument as a list of extensions as above. -If you are using ack-grep, you will be prompted for --type -instead and EXTS will be ignored. If prompt is empty -`helm-grep-ignored-files' are added to --exclude. - -Argument DEFAULT-INPUT is use as `default' arg of `helm' and -INPUT is used as `input' arg of `helm'. See `helm' docstring. - -Arg BACKEND when non-nil specifies which backend to use. -It is used currently to specify \\='zgrep' or \\='git'. -When BACKEND \\='zgrep' is used don't prompt for a choice in -recurse, and ignore EXTS, search being made recursively on files -matching `helm-zgrep-file-extension-regexp' only." - (unless source (setq source 'helm-source-grep)) - (let* (non-essential - (ack-rec-p (helm-grep-use-ack-p :where 'recursive)) - (exts (and recurse - ;; [FIXME] I could handle this from helm-walk-directory. - (not (eq backend 'zgrep)) ; zgrep doesn't handle -r opt. - (not ack-rec-p) - (or exts (helm-grep-get-file-extensions targets)))) - (include-files - (and exts - (mapconcat (lambda (x) - (concat "--include=" - (shell-quote-argument x))) - (if (> (length exts) 1) - (remove "*" exts) - exts) " "))) - (types (and (not include-files) - (not (eq backend 'zgrep)) - recurse - ack-rec-p - ;; When %e format spec is not specified - ;; ignore types and do not prompt for choice. - (string-match "%e" helm-grep-default-command) - (helm-grep-read-ack-type))) - (src-name (capitalize (helm-grep-command recurse backend))) - (com (cond ((eq backend 'zgrep) helm-default-zgrep-command) - ((eq backend 'git) helm-grep-git-grep-command) - (recurse helm-grep-default-recurse-command) - ;; When resuming, the local value of - ;; `helm-grep-default-command' is used, only git-grep - ;; should need this. - (t helm-grep-default-command)))) - ;; When called as action from an other source e.g *-find-files - ;; we have to kill action buffer. - (when (get-buffer helm-action-buffer) - (kill-buffer helm-action-buffer)) - ;; If `helm-find-files' haven't already started, - ;; give a default value to `helm-ff-default-directory' - ;; and set locally `default-directory' to this value . See below [1]. - (unless helm-ff-default-directory - (setq helm-ff-default-directory default-directory)) - ;; We need to store these vars locally - ;; to pass infos later to `helm-resume'. - (helm-set-local-variable - 'helm-zgrep-recurse-flag (and recurse (eq backend 'zgrep)) - 'helm-grep-last-targets targets - 'helm-grep-include-files (or include-files types) - 'helm-grep-in-recurse recurse - 'helm-grep-use-zgrep (eq backend 'zgrep) - 'helm-grep-default-command com - 'helm-input-idle-delay helm-grep-input-idle-delay - 'default-directory helm-ff-default-directory) ;; [1] - ;; Setup the source. - (set source (helm-make-source src-name 'helm-grep-class - :header-name (and (eq backend 'git) - (lambda (name) - (format "%s [%s]" - name - (abbreviate-file-name - helm-ff-default-directory)))) - :backend backend - :pcre (string-match-p "\\`ack" com))) - (helm - :sources source - :buffer (format "*helm %s*" (helm-grep-command recurse backend)) - :default default-input - :input input - :keymap helm-grep-map - :history 'helm-grep-history - :truncate-lines helm-grep-truncate-lines))) - - -;;; zgrep -;; -;; -(defun helm-ff-zgrep-1 (flist recursive) - (unwind-protect - (let* ((def-dir (or helm-ff-default-directory - default-directory)) - (only (if recursive - (or (gethash def-dir helm-rzgrep-cache) - (puthash - def-dir - (helm-walk-directory - def-dir - :directories nil - :path 'full - :match helm-zgrep-file-extension-regexp) - helm-rzgrep-cache)) - flist))) - (helm-do-grep-1 only recursive 'zgrep)) - (setq helm-zgrep-recurse-flag nil))) - - -;;; transformers -;; -;; -(defun helm-grep-split-line (line) - "Split a grep output line." - ;; The output of grep may send a truncated line in this chunk, - ;; so don't split until grep line is valid, that is - ;; once the second part of the line comes with next chunk - ;; send by process. - (when (string-match helm-grep-split-line-regexp line) - ;; Don't use split-string because buffer/file name or string - ;; may contain a ":". - (cl-loop for n from 1 to 3 collect (match-string n line)))) - -(defun helm-grep--filter-candidate-1 (candidate &optional dir pcre) - (let* ((root (or dir (and helm-grep-default-directory-fn - (funcall helm-grep-default-directory-fn)))) - (ansi-p (string-match-p helm--ansi-color-regexp candidate)) - (line (if ansi-p (ansi-color-apply candidate) candidate)) - (split (helm-grep-split-line line)) - (fname (if (and root split) - ;; Filename should always be provided as a local - ;; path, if the root directory is remote, the - ;; tramp prefix will be added before executing - ;; action, see `helm-grep-action' and Bug#2032. - (expand-file-name (car split) - (or (file-remote-p root 'localname) - root)) - (car-safe split))) - (lineno (nth 1 split)) - (str (nth 2 split)) - (display-fname (cl-ecase helm-grep-file-path-style - (basename (and fname (file-name-nondirectory fname))) - (absolute fname) - (relative (and fname root - (file-relative-name fname root)))))) - (if (and display-fname lineno str) - (cons (concat (propertize display-fname - 'face 'helm-grep-file - 'help-echo (abbreviate-file-name fname) - 'helm-grep-fname fname) - ":" - (propertize lineno 'face 'helm-grep-lineno) - ":" - (if ansi-p str (helm-grep-highlight-match str pcre))) - line) - ""))) - -(defun helm-grep-filter-one-by-one (candidate &optional pcre) - "`filter-one-by-one' transformer function for `helm-do-grep-1'." - (let ((helm-grep-default-directory-fn - (or helm-grep-default-directory-fn - (lambda () (or helm-ff-default-directory - (and helm-alive-p - (helm-default-directory)) - default-directory))))) - (if (consp candidate) - ;; Already computed do nothing (default as input). - candidate - (and (stringp candidate) - (helm-grep--filter-candidate-1 candidate nil pcre))))) - -(defun helm-grep-popup-info-fn (_candidate) - (helm-aif (get-text-property (pos-bol) 'helm-grep-fname) - (abbreviate-file-name it))) - -(defun helm-grep-fc-transformer (candidates source) - (let ((helm-grep-default-directory-fn - (or helm-grep-default-directory-fn - (lambda () (or helm-ff-default-directory - (and (null (eq major-mode 'helm-grep-mode)) - (helm-default-directory)) - default-directory)))) - (pcre (helm-get-attr 'pcre source))) - (cl-loop for c in candidates - collect (helm-grep--filter-candidate-1 c nil pcre)))) - -(defun helm-grep-highlight-match (str &optional pcre) - "Highlight in string STR all occurences matching `helm-pattern'." - (let (beg end) - (condition-case-unless-debug nil - (with-temp-buffer - (insert (propertize str 'read-only nil)) ; Fix bug#1176 - (goto-char (point-min)) - (cl-loop for reg in - (cl-loop for r in (helm-mm-split-pattern - helm-input) - unless (string-match "\\`!" r) - collect - (helm-aif (and helm-migemo-mode - (assoc r helm-mm--previous-migemo-info)) - (cdr it) r)) - do - (while (and (re-search-forward - (if pcre - (helm--translate-pcre-to-elisp reg) - reg) - nil t) - (> (- (setq end (match-end 0)) - (setq beg (match-beginning 0))) - 0)) - (helm-add-face-text-properties beg end 'helm-grep-match)) - do (goto-char (point-min))) - (buffer-string)) - (error nil)))) - - -;;; Grep from buffer list -;; -;; -(defun helm-grep-buffers-1 (candidate &optional zgrep) - "Run grep on all file buffers or CANDIDATE if it is a file buffer. -If one of selected buffers is not a file buffer, it is ignored -and grep will run on all others file-buffers. -If only one candidate is selected and it is not a file buffer, -switch to this buffer and run `helm-occur'. -If a prefix arg is given run grep on all buffers ignoring -non-file buffers." - (let* ((prefarg (or current-prefix-arg helm-current-prefix-arg)) - (helm-ff-default-directory - (if (and helm-ff-default-directory - (file-remote-p helm-ff-default-directory)) - default-directory - helm-ff-default-directory)) - (cands (if prefarg - (buffer-list) - (helm-marked-candidates))) - (win-conf (current-window-configuration)) - ;; Non--fname and remote buffers are ignored. - (bufs (cl-loop for buf in cands - for fname = (buffer-file-name (get-buffer buf)) - when (and fname (not (file-remote-p fname))) - collect (expand-file-name fname)))) - (if bufs - (if zgrep - (helm-do-grep-1 bufs nil 'zgrep) - (helm-do-grep-1 bufs)) - ;; bufs is empty, thats mean we have only CANDIDATE - ;; and it is not a buffer-filename, fallback to occur. - (switch-to-buffer candidate) - (when (get-buffer helm-action-buffer) - (kill-buffer helm-action-buffer)) - (helm-occur) - (when (eq helm-exit-status 1) - (set-window-configuration win-conf))))) - -(defun helm-grep-buffers (candidate) - "Action to grep buffers." - (helm-grep-buffers-1 candidate)) - -(defun helm-zgrep-buffers (candidate) - "Action to zgrep buffers." - (helm-grep-buffers-1 candidate 'zgrep)) - - -;;; Helm interface for pdfgrep -;; pdfgrep program -;; and a pdf-reader (e.g xpdf) are needed. -;; -(defvar helm-pdfgrep-default-function 'helm-pdfgrep-init) -(defun helm-pdfgrep-init (only-files &optional recurse) - "Start an asynchronous pdfgrep process in ONLY-FILES list." - (let* ((default-directory (or helm-ff-default-directory - default-directory)) - (fnargs (helm-grep-prepare-candidates - (if (file-remote-p default-directory) - (mapcar (lambda (x) - (file-remote-p x 'localname)) - only-files) - only-files) - default-directory)) - (cmd-line (format (if recurse - helm-pdfgrep-default-recurse-command - helm-pdfgrep-default-command) - helm-pattern - fnargs)) - process-connection-type) - ;; Start pdf grep process. - (helm-log "helm-pdfgrep-init" "Starting Pdf Grep process in directory `%s'" default-directory) - (helm-log "helm-pdfgrep-init" "Command line used was:\n\n%s" - (concat ">>> " (propertize cmd-line 'face 'helm-grep-cmd-line) "\n\n")) - (prog1 - (start-file-process-shell-command - "pdfgrep" helm-buffer cmd-line) - (message nil) - (set-process-sentinel - (get-buffer-process helm-buffer) - (lambda (process event) - (if (or (string= event "finished\n") - (process-get process 'reach-limit)) - (with-helm-window - (setq mode-line-format - '(" " mode-line-buffer-identification " " - (:eval (format "L%s" (helm-candidate-number-at-point))) " " - (:eval (propertize - (format "[Pdfgrep Process Finish - %s result(s)] " - (max (1- (count-lines - (point-min) (point-max))) 0)) - 'face 'helm-grep-finish)))) - (force-mode-line-update) - (when helm-allow-mouse - (helm--bind-mouse-for-selection helm-selection-point))) - (helm-log "helm-pdfgrep-init" "Error: Pdf grep %s" - (replace-regexp-in-string "\n" "" event)))))))) - -(defun helm-do-pdfgrep-1 (only &optional recurse) - "Launch pdfgrep with a list of ONLY files." - (unless (executable-find "pdfgrep") - (error "Error: No such program `pdfgrep'.")) - (let (helm-grep-in-recurse) ; recursion is implemented differently in *pdfgrep. - ;; When called as action from an other source e.g *-find-files - ;; we have to kill action buffer. - (when (get-buffer helm-action-buffer) - (kill-buffer helm-action-buffer)) - (setq helm-pdfgrep-targets only) - (helm - :sources (helm-build-async-source "PdfGrep" - :init (lambda () - ;; If `helm-find-files' haven't already started, - ;; give a default value to `helm-ff-default-directory'. - (setq helm-ff-default-directory (or helm-ff-default-directory - default-directory))) - :candidates-process (lambda () - (funcall helm-pdfgrep-default-function - helm-pdfgrep-targets recurse)) - :nohighlight t - :nomark t - :filter-one-by-one #'helm-grep-filter-one-by-one - :history 'helm-grep-history - :keymap helm-pdfgrep-map - :help-message 'helm-pdfgrep-help-message - :action #'helm-pdfgrep-action - :persistent-help "Jump to PDF Page" - :requires-pattern 2) - :buffer "*helm pdfgrep*" - :history 'helm-grep-history))) - -(defun helm-pdfgrep-action (candidate) - (helm-grep-action candidate 'pdf)) - -(defun helm-pdfgrep-action-1 (_split pageno fname) - (save-selected-window - (start-file-process-shell-command - "pdf-reader" nil - (format-spec helm-pdfgrep-default-read-command - (list (cons ?f fname) (cons ?p pageno)))))) - -;;; AG - PT - RG -;; -;; https://github.com/ggreer/the_silver_searcher -;; https://github.com/monochromegane/the_platinum_searcher -;; https://github.com/BurntSushi/ripgrep - -(defun helm-grep--ag-command () - (and helm-grep-ag-command - (car (helm-remove-if-match - "\\`[A-Z]*=" (split-string helm-grep-ag-command))))) - -(defun helm-grep-ag-get-types () - "Returns a list of AG types if available with AG version. -See AG option \"--list-file-types\" -Ripgrep (rg) types are also supported if this backend is used." - (with-temp-buffer - (let* ((com (helm-grep--ag-command)) - (ripgrep (string= com "rg")) - (regex (if ripgrep "^\\(.*\\):" "^ *\\(--[a-z]*\\)")) - (prefix (if ripgrep "-t " ""))) - (when (equal (call-process com - nil t nil - (if ripgrep - "--type-list" "--list-file-types")) 0) - (goto-char (point-min)) - (cl-loop while (re-search-forward regex nil t) - for type = (match-string 1) - collect (cons type (concat prefix type))))))) - -(defun helm-grep-ag-prepare-cmd-line (pattern directory &optional type) - "Prepare AG command line to search PATTERN in DIRECTORY. -When TYPE is specified it is one of what `helm-grep-ag-get-types' -returns if available with current AG version." - (let* ((patterns (helm-mm-split-pattern pattern t)) - (pipe-switches (mapconcat 'identity helm-grep-ag-pipe-cmd-switches " ")) - (pipe-cmd (helm-acase (helm-grep--ag-command) - (("ag" "pt") - (format "%s -S --color%s" it (concat " " pipe-switches))) - ("rg" (format "rg -N -S --color=%s%s" - (when (string-match "--color=\\([a-z]+\\) " - helm-grep-ag-command) - (match-string 1 helm-grep-ag-command)) - (concat " " pipe-switches))))) - (cmd (format helm-grep-ag-command - (mapconcat 'identity type " ") - (shell-quote-argument (car patterns)) - (shell-quote-argument directory)))) - (helm-aif (cdr patterns) - (concat cmd (cl-loop for p in it concat - (format " | %s -- %s" - pipe-cmd (shell-quote-argument p)))) - cmd))) - -(defun helm-grep-ag-init (directory &optional type) - "Start AG process in DIRECTORY maybe searching only files of type TYPE." - (let* ((default-directory (or helm-ff-default-directory - (helm-default-directory) - default-directory)) - (cmd-line (helm-grep-ag-prepare-cmd-line - ;; NOTE Encode directory name and pattern, - ;; or it may not work with Chinese and maybe other non-utf8 - ;; characters on MSWindows systems issue#2677 and issue#2678. - (encode-coding-string helm-pattern locale-coding-system) - (or (file-remote-p directory 'localname) - (encode-coding-string directory locale-coding-system)) - type)) - (start-time (float-time)) - (proc-name (helm-grep--ag-command)) - ;; Fix error in MacOS with process-buffer deleted resulting in a nil - ;; helm-window (with-helm-window) in sentinel see issue#2741. - (process-connection-type (string= proc-name "ag"))) - (set (make-local-variable 'helm-grep-last-cmd-line) cmd-line) - (helm-log "helm-grep-ag-init" "Starting %s process in directory `%s'" - proc-name directory) - (helm-log "helm-grep-ag-init" "Command line used was:\n\n%s" - (concat ">>> " cmd-line "\n\n")) - (prog1 - (start-file-process-shell-command - proc-name helm-buffer cmd-line) - (set-process-sentinel - (get-buffer-process helm-buffer) - (lambda (process event) - (let* ((err (process-exit-status process)) - (noresult (= err 1))) - (cond (noresult - (with-helm-buffer - (insert (concat "* Exit with code 1, no result found," - " command line was:\n\n " - (propertize helm-grep-last-cmd-line - 'face 'helm-grep-cmd-line))) - (setq mode-line-format - `(" " mode-line-buffer-identification " " - (:eval (format "L%s" (helm-candidate-number-at-point))) " " - (:eval (propertize - (format - "[%s process finished - (no results)] " - ,(upcase proc-name)) - 'face 'helm-grep-finish)))))) - ((or (string= event "finished\n") - (process-get process 'reach-limit)) - (helm-log "helm-grep-ag-init" "%s process finished with %s results in %fs" - proc-name - (helm-get-candidate-number) - (- (float-time) start-time)) - (helm-maybe-show-popup-tip-info) - (with-helm-window - (setq mode-line-format - `(" " mode-line-buffer-identification " " - (:eval (format "L%s" (helm-candidate-number-at-point))) " " - (:eval (propertize - (format - "[%s process finished in %.2fs - (%s results)] " - ,(upcase proc-name) - ,(- (float-time) start-time) - (helm-get-candidate-number)) - 'face 'helm-grep-finish)))) - (force-mode-line-update) - (when helm-allow-mouse - (helm--bind-mouse-for-selection helm-selection-point)))) - (t (helm-log - "helm-grep-ag-init" - "Error: %s %s" - proc-name - (replace-regexp-in-string "\n" "" event)))))))))) - -(defun helm-grep-ag-search-results (_candidate) - "Launch a new helm session on the current results. -Allow narrowing the grep ag results to a specific file or pattern without -continuing calling grep ag, i.e. once called, what you type in minibuffer will be -searched with helm match functions in all the candidates found previously by -grep ag." - (with-helm-buffer - (let* ((src (helm-get-current-source)) - (candidates (nthcdr 1 (split-string - (buffer-substring-no-properties - (point-min) (point-max)) - "\n"))) - (transfo (helm-get-attr 'filtered-candidate-transformer src)) - (actions helm-grep-actions) - (name (helm-get-attr 'name src)) - (directory (helm-get-attr 'directory src))) - (helm :sources (helm-build-sync-source (format "Search in %s" name) - :candidates candidates - :keymap 'helm-grep-map - :candidate-transformer - (lambda (candidates) - (let ((helm-grep-default-directory-fn - (lambda () directory))) - (funcall transfo candidates nil))) - :action actions) - :buffer "*helm search ag*")))) - -(helm-make-command-from-action helm-grep-ag-run-search-results - "Run `helm-grep-ag-search-results' action." 'helm-grep-ag-search-results) - -(defvar helm-grep-ag-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-grep-map) - (define-key map (kbd "C-s") 'helm-grep-run-ag-grep-parent-directory) - (define-key map (kbd "C-c s") 'helm-grep-ag-run-search-results) - map)) - -(defclass helm-grep-ag-class (helm-source-async) - ((nohighlight :initform t) - (pcre :initarg :pcre :initform t - :documentation - " Backend is using pcre regexp engine when non--nil.") - (keymap :initform 'helm-grep-ag-map) - (history :initform 'helm-grep-ag-history) - (help-message :initform 'helm-grep-help-message) - (filtered-candidate-transformer :initform #'helm-grep-fc-transformer) - (popup-info :initform #'helm-grep-popup-info-fn) - (persistent-action :initform 'helm-grep-persistent-action) - (persistent-help :initform "Jump to line (`C-u' Record in mark ring)") - (directory :initarg :directory :initform nil - :documentation - " Directory currently searched.") - (requires-pattern :initform 2) - (nomark :initform t) - (action :initform 'helm-grep-actions) - (find-file-target :initform #'helm-grep-quit-an-find-file-fn) - (group :initform 'helm-grep))) - -(defvar helm-source-grep-ag nil) - -(defun helm-grep-ag-1 (directory &optional type input default) - "Start helm ag in DIRECTORY maybe searching in files of type TYPE. -Arg DEFAULT is what you will have with `next-history-element', -arg INPUT is what you will have by default at prompt on startup." - (setq helm-source-grep-ag - (helm-make-source (upcase (helm-grep--ag-command)) 'helm-grep-ag-class - :header-name (lambda (name) - (format "%s [%s]" - name (abbreviate-file-name directory))) - :directory directory - :action (append helm-grep-actions - `((,(format "%s grep parent directory" - (upcase (helm-grep--ag-command))) - . helm-grep-ag-grep-parent-directory) - (,(format "Search results in grep %s buffer" - (upcase (helm-grep--ag-command))) - . helm-grep-ag-search-results))) - :candidates-process - (lambda () (helm-grep-ag-init directory type)))) - (helm-set-local-variable 'helm-input-idle-delay helm-grep-input-idle-delay) - (helm :sources 'helm-source-grep-ag - :history 'helm-grep-ag-history - :input input - :default default - :truncate-lines helm-grep-truncate-lines - :buffer (format "*helm %s*" (helm-grep--ag-command)))) - -(defun helm-grep-ag-grep-parent-directory (_candidate) - "Restart helm-grep-ag in the parent of the currently searched directory." - (let* ((src (with-helm-buffer (car helm-sources))) - (directory (helm-basedir (helm-get-attr 'directory src) t)) - (input helm-pattern)) - (helm-grep-ag-1 directory nil input))) - -(helm-make-command-from-action helm-grep-run-ag-grep-parent-directory - "Ag grep parent directory." 'helm-grep-ag-grep-parent-directory) - -(defun helm-grep-ag (directory with-types) - "Start grep AG in DIRECTORY. -When WITH-TYPES is non-nil provide completion on AG types." - (require 'helm-adaptive) - (let ((com (capitalize (helm-grep--ag-command)))) - (helm-grep-ag-1 directory - (helm-aif (and with-types - (helm-grep-ag-get-types)) - (helm-comp-read - (format "%s type: " com) it - :must-match t - :marked-candidates t - :fc-transformer 'helm-adaptive-sort - :buffer (format "*helm %s types*" com)))))) - -;;; Git grep -;; -;; -(defvar helm-source-grep-git nil) - -(defun helm-grep-git-1 (directory &optional all default input) - "Run git-grep on DIRECTORY. -If DIRECTORY is not inside or part of a git repo exit with error. -If optional arg ALL is non-nil grep the whole repo otherwise -start at DIRECTORY. -Arg DEFAULT is what you will have with `next-history-element', -arg INPUT is what you will have by default at prompt on startup." - (require 'vc) - (let* (helm-grep-default-recurse-command - ;; Expand filename of each candidate with the git root dir. - ;; The filename will be in the helm-grep-fname prop. - (helm-grep-default-directory-fn (lambda () - (vc-find-root directory ".git"))) - (helm-ff-default-directory (funcall helm-grep-default-directory-fn))) - (cl-assert helm-ff-default-directory nil "Not inside a Git repository") - (helm-do-grep-1 (if all '("") `(,(expand-file-name directory))) - nil 'git nil default input 'helm-source-grep-git))) - - -;;;###autoload -(defun helm-do-grep-ag (arg) - "Preconfigured `helm' for grepping with AG in `default-directory'. -With prefix arg prompt for type if available with your AG -version." - (interactive "P") - (require 'helm-files) - (helm-grep-ag (expand-file-name default-directory) arg)) - -;;;###autoload -(defun helm-do-grep-ag-project (arg) - "Preconfigured `helm' for grepping with AG from the current project root. -If no project found use `default-directory'. -With prefix arg prompt for type if available with your AG version." - (interactive "P") - (require 'helm-files) - (require 'project) - (let ((project-root (helm-acase (project-current) - ;; vc returns (type backend path). - ((dst* (_type _backend path)) path) - ;; projectile returns (type . path). - ((dst* (_type . path)) path) - (t default-directory)))) - (helm-grep-ag (expand-file-name project-root) arg))) - -;;;###autoload -(defun helm-grep-do-git-grep (arg) - "Preconfigured `helm' for git-grepping `default-directory'. -With a prefix arg ARG git-grep the whole repository." - (interactive "P") - (require 'helm-files) - (helm-grep-git-1 default-directory arg)) - - -(provide 'helm-grep) - -;;; helm-grep.el ends here diff --git a/elpa/helm-20251212.555/helm-help.el b/elpa/helm-20251212.555/helm-help.el deleted file mode 100644 index 3708ff3c..00000000 --- a/elpa/helm-20251212.555/helm-help.el +++ /dev/null @@ -1,2655 +0,0 @@ -;;; helm-help.el --- Help messages for Helm. -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2025 Thierry Volpiatto - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Code: -(require 'helm) - - -(defgroup helm-help nil - "Embedded help for `helm'." - :group 'helm) - -(defface helm-helper - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :inherit helm-header)) - "Face for Helm help string in minibuffer." - :group 'helm-help) - -(defvar helm-help--string-list '(helm-help-message - helm-buffer-help-message - helm-ff-help-message - helm-read-file-name-help-message - helm-generic-file-help-message - helm-fd-help-message - helm-grep-help-message - helm-pdfgrep-help-message - helm-etags-help-message - helm-ucs-help-message - helm-bookmark-help-message - helm-esh-help-message - helm-buffers-ido-virtual-help-message - helm-moccur-help-message - helm-top-help-message - helm-M-x-help-message - helm-imenu-help-message - helm-colors-help-message - helm-semantic-help-message - helm-kmacro-help-message - helm-kill-ring-help-message) - "A list of help messages (strings) used by `helm-documentation'.") - -(defvar helm-documentation-buffer-name "*helm documentation*") - -;;;###autoload -(defun helm-documentation () - "Preconfigured `helm' for Helm documentation. -With a prefix arg refresh the documentation. - -Find here the documentation of all documented sources." - (interactive) - (let ((buf (get-buffer-create helm-documentation-buffer-name))) - (switch-to-buffer buf) - (set-buffer buf) - (let ((inhibit-read-only t)) - (erase-buffer) - (save-excursion - (cl-loop for elm in helm-help--string-list - for str = (helm-interpret-value elm) - do (insert (substitute-command-keys str) "\n\n"))) - (org-mode)) - (setq buffer-read-only t) - (view-mode))) - - -;;; Local help messages. - -;;; `helm-buffer-list' help -;; -;; -(defvar helm-buffer-help-message - "* Helm Buffer - -** Tips - -*** Completion - -**** Major-mode - -You can enter a partial major-mode name (e.g. lisp, sh) to narrow down buffers. -To specify the major-mode, prefix it with \"*\" e.g. \"*lisp\". - -If you want to match all buffers but the ones with a specific major-mode -\(negation), prefix the major-mode with \"!\" e.g. \"*!lisp\". - -If you want to specify more than one major-mode, separate them with \",\", -e.g. \"*!lisp,!sh,!fun\" lists all buffers but the ones in lisp-mode, sh-mode -and fundamental-mode. - -Then enter a space followed by a pattern to narrow down to buffers matching this -pattern. - -**** Search inside buffers - -If you enter a space and a pattern prefixed by \"@\", Helm searches for text -matching this pattern *inside* the buffer (i.e. not in the name of the buffer). - -Negation are supported i.e. \"!\". - -When you specify more than one of such patterns, it will match -buffers with contents matching each of these patterns i.e. AND, -not OR. That means that if you specify \"@foo @bar\" the contents -of buffer will have to be matched by foo AND bar. If you specify -\"@foo @!bar\" it means the contents of the buffer have to be -matched by foo but NOT bar. - -If you enter a pattern prefixed with an escaped \"@\", Helm searches for a -buffer matching \"@pattern\" but does not search inside the buffer. - -**** Search by directory name - -If you prefix the pattern with \"/\", Helm matches over the directory names -of the buffers. - -This feature can be used to narrow down the search to one directory while -subsequent strings entered after a space match over the buffer name only. - -Note that negation is not supported for matching on buffer filename. - -Starting from Helm v1.6.8, you can specify more than one directory. - -**** Fuzzy matching - -`helm-buffers-fuzzy-matching' turns on fuzzy matching on buffer -names, but not on directory names or major modes. A pattern -starting with \"^\" disables fuzzy matching and matching is done -litteraly IOW do not use regexps (\"^\" or whatever special -regexp character) when you want to fuzzy match. - -**** Examples - -With the following pattern - - \"*lisp ^helm @moc\" - -Helm narrows down the list by selecting only the buffers that are in lisp mode, -start with \"helm\" and which content matches \"moc\". - -Without the \"@\" - - \"*lisp ^helm moc\" - -Helm looks for lisp mode buffers starting with \"helm\" and containing \"moc\" -in their name. - -With this other pattern - - \"*!lisp !helm\" - -Helm narrows down to buffers that are not in \"lisp\" mode and that do not match -\"helm\". - -With this last pattern - - /helm/ w3 - -Helm narrows down to buffers that are in any \"helm\" subdirectory and -matching \"w3\". - -*** Creating buffers - -When creating a new buffer, use `\\[universal-argument]' to choose a mode from a -list. This list is customizable, see `helm-buffers-favorite-modes'. - -*** Killing buffers - -You can kill buffers either one by one or all the marked buffers at once. - -One kill-buffer command leaves Helm while the other is persistent. Run the -persistent kill-buffer command either with the regular -`helm-execute-persistent-action' called with a prefix argument (`\\[universal-argument] \\\\[helm-execute-persistent-action]') -or with its specific command `helm-buffer-run-kill-persistent'. See the -bindings below. - -*** Switching to buffers - -To switch to a buffer, press RET, to switch to a buffer in another window, select this buffer -and press \\\\[helm-buffer-switch-other-window], when called with a prefix arg -the buffer will be displayed vertically in other window. -If you mark more than one buffer, the marked buffers will be displayed in different windows. - -*** Saving buffers - -If buffer is associated to a file and is modified, it is by default colorized in orange, -see [[Meaning of colors and prefixes for buffers][Meaning of colors and prefixes for buffers]]. -You can save these buffers with \\\\[helm-buffer-save-persistent]. -If you want to save all these buffers, you can mark them with \\[helm-buffers-mark-similar-buffers] -and save them with \\[helm-buffer-save-persistent]. You can also do this in one step with -\\[helm-buffer-run-save-some-buffers]. Note that you will not be asked for confirmation. - -*** Meaning of colors and prefixes for buffers - -Remote buffers are prefixed with '@'. -Red => Buffer's file was modified on disk by an external process. -Indianred2 => Buffer exists but its file has been deleted. -Orange => Buffer is modified and not saved to disk. -Italic => A non-file buffer. -Yellow => Tramp archive buffer. -DimGray => Indirect buffer. - -** Commands -\\ -|Keys|Description| -|-------------+----------| -|\\[helm-buffer-run-zgrep]|Grep Buffer(s) works as zgrep too (`\\[universal-argument]' to grep all buffers but non-file buffers). -|\\[helm-buffers-run-occur]|Multi-Occur buffer or marked buffers (`\\[universal-argument]' to toggle force-searching current-buffer). -|\\[helm-buffer-switch-other-window]|Switch to other window. -|\\[helm-buffer-switch-other-frame]|Switch to other frame. -|\\[helm-buffers-run-browse-project]|Browse project from buffer. -|\\[helm-buffer-run-query-replace-regexp]|Query-replace-regexp in marked buffers. -|\\[helm-buffer-run-query-replace]|Query-replace in marked buffers. -|\\[helm-buffer-run-ediff]|Ediff current buffer with candidate. With two marked buffers, ediff those buffers. -|\\[helm-buffer-run-ediff-merge]|Ediff-merge current buffer with candidate. With two marked buffers, ediff-merge those buffers. -|\\[helm-buffer-diff-persistent]|Toggle Diff-buffer with saved file without leaving Helm. -|\\[helm-buffer-revert-persistent]|Revert buffer without leaving Helm. -|\\[helm-buffer-save-persistent]|Save buffer without leaving Helm. -|\\[helm-buffer-run-save-some-buffers]|Save all unsaved buffers. -|\\[helm-buffer-run-kill-buffers]|Delete marked buffers and leave Helm. -|\\[helm-buffer-run-kill-persistent]|Delete buffer without leaving Helm. -|\\[helm-buffer-run-rename-buffer]|Rename buffer. -|\\[helm-toggle-all-marks]|Toggle all marks. -|\\[helm-mark-all]|Mark all. -|\\[helm-toggle-buffers-details]|Toggle details. -|\\[helm-buffers-toggle-show-hidden-buffers]|Show hidden buffers. -|\\[helm-buffers-mark-similar-buffers]|Mark all buffers of the same type (color) as current buffer.") - -;;; Find files help (`helm-find-files') -;; -;; -(defvar helm-ff-help-message - "* Helm Find Files - -** Tips - -*** Navigation summary - -For a better experience you can enable auto completion by setting -`helm-ff-auto-update-initial-value' to non-nil in your init file. It is not -enabled by default to not confuse new users. - -**** Navigate with arrow keys - -You can use and arrows to go down or up one level, to disable -this customize `helm-ff-lynx-style-map'. -Note that using `setq' will NOT work. - -**** Use `\\\\[helm-execute-persistent-action]' (persistent action) on a directory to go down one level - -On a symlinked directory a prefix argument expands to its true name. - -**** Use `\\\\[helm-find-files-up-one-level]' or `DEL' on a directory to go up one level - -***** `DEL' behavior - -`DEL' by default deletes char backward. - -But when `helm-ff-DEL-up-one-level-maybe' is non nil `DEL' behaves -differently depending on the contents of helm-pattern. It goes up one -level if the pattern is a directory ending with \"/\" or disables HFF -auto update and delete char backward if the pattern is a filename or -refers to a non existing path. Going up one level can be disabled -if necessary by deleting \"/\" at the end of the pattern using -\\\\[backward-char] and \\[helm-delete-minibuffer-contents]. - -Note that when deleting char backward, Helm takes care of -disabling update giving you the opportunity to edit your pattern for -e.g. renaming a file or creating a new file or directory. -When `helm-ff-auto-update-initial-value' is non nil you may want to -disable it temporarily, see [[Toggle auto-completion][Toggle auto-completion]] for this. - -**** Use `\\\\[helm-find-files-down-last-level]' to walk back the resulting tree of all the `\\\\[helm-find-files-up-one-level]' or DEL you did - -The tree is reinitialized each time you browse a new tree with -`\\\\[helm-execute-persistent-action]' or by entering some pattern in the prompt. - -**** `RET' behavior - -It behaves differently depending on `helm-selection' (current candidate in helm-buffer): - -- candidate basename is \".\" => Open it in dired. -- candidate is a directory => Expand it. -- candidate is a file => Open it. - -If you have marked candidates and you press RET on a directory, -Helm will navigate to this directory. If you want to exit with -RET with default action with these marked candidates, press RET a -second time while you are on the root of this directory e.g. -\"/home/you/dir/.\" or press RET on any file which is not a -directory. You can also exit with default action at any moment -with `f1'. - -Note that when copying, renaming, etc. from `helm-find-files' the -destination file is selected with `helm-read-file-name'. - -**** `TAB' behavior - -Normally `TAB' is bound to `helm-select-action' in helm-map which -display the action menu. - -You can change this behavior by setting in `helm-find-files-map' -a new command for `TAB': - - (define-key helm-find-files-map (kbd \"C-i\") 'helm-ff-TAB) - -It will then behave slighly differently depending of -`helm-selection': - -- candidate basename is \".\" => open the action menu. -- candidate is a directory => expand it (behave as \\\\[helm-execute-persistent-action]). -- candidate is a file => open action menu. - -Called with a prefix arg open menu unconditionally. - -*** Show information on files (permissions etc...) - -Turn on `helm-popup-tip-mode'. - -*** Filter out files or directories - -You can show files or directories only with respectively -\\\\[helm-ff-toggle-dirs-only] and \\\\[helm-ff-toggle-files-only]. -These are toggle commands i.e. filter/show_all. -Changing directory disable filtering. - -*** Sort directory contents - -When listing a directory without narrowing its contents, i.e. when pattern ends with \"/\", -you can sort alphabetically, by newest or by size by using respectively -\\\\[helm-ff-sort-alpha], \\[helm-ff-sort-by-newest] or \\[helm-ff-sort-by-size]. -NOTE: -When starting back narrowing i.e. entering something in minibuffer after \"/\" sorting is done -again with fuzzy sorting and no more with sorting methods previously selected. - -You can use these sort functions only on files or directory, -see [[Filter out files or directories][Filter out files or directories]]. - -*** Find file at point - -Helm uses `ffap' partially or completely to find file at point depending on the -value of `helm-ff-guess-ffap-filenames': if non-nil, support is complete -\(annoying), if nil, support is partial. - -Note that when the variable -`helm-ff-allow-non-existing-file-at-point' is non nil Helm will -insert the filename at point even if file with this name doesn't -exists. If non existing file at point ends with numbers prefixed -with \":\" the \":\" and numbers are stripped. - -**** Find file at line number - -When text at point is in the form of - - ~/elisp/helm/helm.el:1234 - -Helm finds this file at the indicated line number, here 1234. - -**** Find URL at point - -When a URL is found at point, Helm expands to that URL only. -Pressing `RET' opens that URL using `browse-url-browser-function'. - -**** Find e-mail address at point - -When an e-mail address is found at point, Helm expands to this e-mail address -prefixed with \"mailto:\". Pressing `RET' opens a message buffer with that -e-mail address. - -*** Quick pattern expansion - -**** Enter `~/' at end of pattern to quickly reach home directory - -**** Enter `/' at end of pattern to quickly reach the file system root - -**** Enter `./' at end of pattern to quickly reach `default-directory' - -\(As per its value at the beginning of the session.) - -If you already are in the `default-directory' this will move the cursor to the top. - -**** Enter `../' at end of pattern will reach upper directory, moving cursor to the top - -This is different from using `\\\\[helm-find-files-up-one-level]' in that it moves -the cursor to the top instead of remaining on the previous subdir name. - -**** Enter `..name/' at end of pattern to start a recursive search - -It searches directories matching \"name\" under the current directory, -see the [[Recursive completion on subdirectories][Recursive completion on subdirectories]] section below for more details. - -**** Any environment variable (e.g. `$HOME') at end of pattern gets expanded - -**** Any valid filename yanked after pattern gets expanded - -**** Special case: URL at point - -The quick expansions do not take effect after end a URL, you must kill the -pattern first (`\\[helm-delete-minibuffer-contents]'). - -*** Helm-find-files supports fuzzy matching - -It starts from the third character of the pattern. - -For instance \"fob\" or \"fbr\" will complete \"foobar\" but \"fb\" needs a -third character in order to complete it. - -*** Watch briefly files contents while navigating - -You can use `\\[helm-execute-persistent-action]' on a filename for this, then: - -- First hit expands to that filename in the Helm buffer. -- Second hit displays the buffer filename. -- Third hit kills the buffer filename. - -Note: `\\[universal-argument] \\[helm-execute-persistent-action]' displays the buffer directly. - -*** Browse images directories with `helm-follow-mode' and navigate up/down - -Before Emacs-27 Helm was using image-dired that works with -external ImageMagick tools. From Emacs-27 Helm use native -display of images with image-mode by default for Emacs-27 (see `helm-ff-display-image-native'), -this allows automatic resize when changing window size, zooming with `\\[helm-ff-increase-image-size-persistent]' and `\\[helm-ff-decrease-image-size-persistent]' -and rotate images as before. - -You can also use `helm-follow-action-forward' and `helm-follow-action-backward' with -`\\[helm-follow-action-forward]' and `\\[helm-follow-action-backward]' respectively. -Note that these commands have different behavior when `helm-follow-mode' -is enabled (go to next/previous line only). - -Use `\\[universal-argument] \\[helm-execute-persistent-action]' to display an image or kill its buffer. - -TIP: Use `\\\\[helm-toggle-resplit-and-swap-windows]' and `\\[helm-enlarge-window]' to display Helm window vertically -and to enlarge it while viewing images. -Note this may not work with exotic Helm windows settings such as the ones in Spacemacs. - -**** Show thumbnails - -Helm use image-dired to show thumbnails on image files, you can -toggle the thumbnail view with \\`\\[helm-ff-toggle-thumbnails]'. - -**** Launch a slideshow from marked files - -Helm provides an action from `helm-find-files' that allows -running a slideshow on marked files. Just mark image files and -launch slideshow from action menu, bindings are self documented -in mode-line. NOTE: When hitting any other keys than the ones -mentionned in mode-line, slideshow will come in pause, to restart -it you will have to press twice SPACE. - -*** Open files externally - -- Open file with external program (`\\\\[helm-ff-run-open-file-externally]',`C-u' to choose). - -Helm is looking what is used by default to open file -externally (mailcap files) but have its own variable -`helm-external-programs-associations' to store external -applications. If you call the action or its binding without -prefix arg Helm will see if there is an application suitable in -`helm-external-programs-associations', otherwise it will look in -mailcap files. If you want to specify which external application -to use (and its options) use a prefix arg. - -If you have to pass arguments after filename use `%s' in your command e.g. \"foo %s -a -b\" -If you want to detach your program from Emacs, you can use e.g. \"(foo %s &)\" (only supported on Linux/Unix). -When using `%s' do not quote it (i.e. \"%s\"), helm is already quoting filename argument. - -Note: What you configure for Helm in `helm-external-programs-associations' -will take precedence on mailcap files. - -- Preview file with external program (`\\[helm-ff-run-preview-file-externally]'). - -Same as above but doesn't quit Helm session, it is apersistent action. - -- Open file externally with default tool (`\\[helm-ff-run-open-file-with-default-tool]'). - -Use `xdg-open' to open files. - -*** Toggle auto-completion - -Normally auto-completion in helm-find-files is disabled by -default but you can toggle it with `\\[helm-ff-run-toggle-auto-update]'. To enable it on startup by -default, customize `helm-ff-auto-update-initial-value'. - -It is useful when trying to create a new file or directory and you don't want -Helm to complete what you are writing. - -Note: On a terminal, the default binding `C-' may not work. -In this case use `C-c '. - -*** Show infos of files - -To have infos on files like size, permissions etc... hit `\\[helm-ff-properties-persistent]'. -To have automatically brief infos on selected file, turn on `helm-popup-tip-mode'. - -*** You can create a new directory and a new file at the same time - -Simply write the path in the prompt and press `RET', e.g. -\"~/new/newnew/newnewnew/my_newfile.txt\". - -*** To create a new directory, append a \"/\" to the new name and press `RET' - -*** To create a new file, enter a filename not ending with \"/\" - -Note that when you enter a new name, this one is prefixed with [+]. - -*** Recursive search from Helm-find-files - -**** You can use Helm-browse-project (see binding below) - -- With no prefix argument: -If the current directory is under version control with either git or hg and -helm-ls-git and/or helm-ls-hg are installed, it lists all the files under -version control. Otherwise it falls back to Helm-find-files. See -https://github.com/emacs-helm/helm-ls-git and -https://github.com/emacs-helm/helm-ls-hg. - -- With one prefix argument: -List all the files under this directory and other subdirectories -\(recursion) and this list of files will be cached. - -- With two prefix arguments: -Same but the cache is refreshed. - -**** You can start a recursive search with \"locate\", \"find\" or [[https://github.com/sharkdp/fd][Fd]] - -See \"NOTE\" in the [[Recursive completion on subdirectories][section on subdirectories]]. - -Using \"locate\", you can enable the local database with a prefix argument. If the -local database doesn't already exists, you will be prompted for its creation. -If it exists and you want to refresh it, give it two prefix args. - -When using locate the Helm buffer remains empty until you type something. -Regardless Helm uses the basename of the pattern entered in the helm-find-files -session by default. Hitting `\\[next-history-element]' should just kick in the -locate search with this pattern. If you want Helm to automatically do this, add -`helm-source-locate' to `helm-sources-using-default-as-input'. - -NOTE: On Windows use Everything with its command line ~es~ as a replacement of locate. -See [[https://github.com/emacs-helm/helm/wiki/Locate#windows][Locate on Windows]] - -If your system use plocate as backend and you have no results when searching, -see [[Recursive completion on subdirectories][section on subdirectories]]. - -**** Recursive completion on subdirectories - -Starting from the directory you are currently browsing, it is -possible to have completion of all directories underneath. Say -you are at \"/home/you/foo/\" and you want to go to -\"/home/you/foo/bar/baz/somewhere/else\", simply type -\"/home/you/foo/..else\" and enter the final \"/\". Helm will -then list all possible directories under \"foo\" matching -\"else\". - -You can use either find, locate or fdfind as backend, see the variable -`helm-locate-recursive-dirs-command', the default is to use find as backend. - -NOTE: When using `locate' as backend which uses an index, the -directory tree displayed may be out-of-date and not reflect the -latest change until you update the index (using \"updatedb\" for -\"locate\"). - -On recent systems plocate is used instead of mlocate and the -corresponding updatedb command doesn't index anymore user -directories, see the option PRUNE_BIND_MOUNTS in the updatedb man -page. - -If a locale db file is found under current directory it will be -used instead of the global updatedb index. - -To create a locale db file under current directory, use `C-u C-u -C-x C-f' from helm-find-files. - -*** Insert filename at point or complete filename at point - -On insertion (i.e. there is nothing at point): - -- `\\[helm-ff-run-complete-fn-at-point]': insert absolute file name. -- `\\[universal-argument] \\[helm-ff-run-complete-fn-at-point]': insert abbreviated file name. -- `\\[universal-argument] \\[universal-argument] \\[helm-ff-run-complete-fn-at-point]': insert relative file name. -- `\\[universal-argument] \\[universal-argument] \\[universal-argument] \\[helm-ff-run-complete-fn-at-point]': insert basename. - -On completion (\\[helm-ff-run-complete-fn-at-point]): - -- Target starts with \"~/\": insert abbreviate file name. -- target starts with \"/\" or \"[a-z]:/\": insert full path. -- Otherwise: insert relative file name. - -*** Use the wildcard to select multiple files - -Use of wildcard is supported to run an action over a set of files. - -Example: You can copy all the files with \".el\" extension by using \"​*.el\" and -then run copy action. - -Similarly, \"​*​*.el\" (note the two stars) will recursively select all \".el\" -files under the current directory. - -Note that when recursively copying files, you may have files with same name -dispatched across different subdirectories, so when copying them in the same -directory they will get overwritten. To avoid this Helm has a special action -called \"backup files\" that has the same behavior as the command line \"cp -f ---backup=numbered\": it allows you to copy many files with the same name from -different subdirectories into one directory. Files with same name are renamed -as follows: \"foo.txt.~1~\". Like with the --force option of cp, it is possible -to backup files in current directory. - -This command is available only when `dired-async-mode' is active. - -When using an action that involves an external backend (e.g. grep), using \"**\" -is not recommended (even though it works fine) because it will be slower to -select all the files. You are better off leaving the backend to do it, it will -be faster. However, if you know you have not many files it is reasonable to use -this, also using not recursive wildcard (e.g. \"*.el\") is perfectly fine for -this. - -The \"**\" feature is active by default in the option `helm-file-globstar'. It -is different from the Bash \"shopt globstar\" feature in that to list files with -a named extension recursively you would write \"​*​*.el\" whereas in Bash it would -be \"​*​*/​*.el\". Directory selection with \"​*​*/\" like Bash \"shopt globstar\" -option is not supported yet. - -Helm supports different styles of wildcards: - -- `sh' style, the ones supported by `file-expand-wildcards'. -e.g. \"​*.el\", \"​*.[ch]\" which match respectively all \".el\" -files or all \".c\" and \".h\" files. - -- `bash' style (partially) In addition to what allowed in `sh' -style you can specify file extensions that have more than one -character like this: \"*.{sh,py}\" which match \".sh\" and -\".py\" files. - -Of course in both styles you can specify one or two \"*\". - -*** Query replace regexp on filenames - -Replace different parts of a file basename with something else. - -When calling this action you will be prompted twice as with -`query-replace', first for the matching expression of the text to -replace and second for the replacement text. Several facilities, -however, are provided to make the two prompts more powerfull. - -**** Syntax of the first prompt - -In addition to simple regexps, these shortcuts are available: - -- Basename without extension => \"%.\" -- Only extension => \".%\" -- Substring => \"%::\" -- Whole basename => \"%\" - -**** Syntax of the second prompt - -In addition to a simple string to use as replacement, here is what you can use: - -- A placeholder refering to what you have selected in the first prompt: \"\\@\". - -After this placeholder you can use a search-and-replace syntax à-la sed: - - \"\\@/// - -You can select a substring from the string represented by the placeholder: - - \"\\@::\" - -- A special character representing a number which is incremented: \"\\#\". - -- Shortcuts for `upcase', `downcase' and `capitalize' -are available as`%u', `%d' and `%c' respectively. - -**** Examples - -***** Recursively rename all files with \".JPG\" extension to \".jpg\" - -Use the `helm-file-globstar' feature described in [[Use the wildcard to select multiple files][recursive globbing]] -by entering \"**.JPG\" at the end of the Helm-find-files pattern, then hit -\\\\[helm-ff-run-query-replace-fnames-on-marked] and enter \"JPG\" on first prompt, then \"jpg\" on second prompt and hit `RET'. - -Alternatively you can enter \".%\" at the first prompt, then \"jpg\" and hit -`RET'. Note that when using this instead of using \"JPG\" at the first prompt, -all extensions will be renamed to \"jpg\" even if the extension of one of the -files is, say, \"png\". If you want to keep the original extension you can use -\"%d\" at the second prompt (downcase). - -***** Batch-rename files from number 001 to 00x - -Use \"\\#\" inside the second prompt. - -Example 1: To rename the files - - foo.jpg - bar.jpg - baz.jpg - -to - - foo-001.jpg - foo-002.jpg - foo-003.jpg - -use \"%.\" as matching regexp and \"foo-\\#\" as replacement string. - -Example 2: To rename the files - - foo.jpg - bar.jpg - baz.jpg - -to - - foo-001.jpg - bar-002.jpg - baz-003.jpg - -use as matching regexp \"%.\" and as replacement string \"\\@-\\#\". - -***** Replace a substring - -Use \"%::\". - -Example: To rename files - - foo.jpg - bar.jpg - baz.jpg - -to - - fOo.jpg - bAr.jpg - bAz.jpg - -use as matching regexp \"%:1:2\" and as replacement string \"%u\" (upcase). - -Note that you \*cannot* use \"%.\" and \".%\" along with substring replacement. - -***** Modify the string from the placeholder (\\@) - -- By substring, i.e. only using the substring of the placeholder: \"\\@::\". -The length of placeholder is used for when unspecified. - -Example 1: \"\\@:0:2\" replaces from the beginning to the second char of the placeholder. - -Example 2: \\@:2: replaces from the second char of the placeholder to the end. - -- By search-and-replace: \"\\@///\". - -Incremental replacement is also handled in . - -Example 3: \"\\@/foo/bar/\" replaces \"foo\" by \"bar\" in the placeholder. - -Example 4: \"\\@/foo/-\\#/\" replaces \"foo\" in the placeholder by 001, 002, etc. - -***** Clash in replacements (avoid overwriting files) - -When performing any of these replacement operations you may end up with same -names as replacement. In such cases Helm numbers the file that would otherwise -overwritten. For instance, should you remove the \"-m\" part from the files -\"emacs-m1.txt\", \"emacs-m2.txt\" and \"emacs-m3.txt\" you would end up with -three files named \"emacs.txt\", the second renaming overwriting first file, and -the third renaming overwriting second file and so on. Instead Helm will -automatically rename the second and third files as \"emacs(1).txt\" and -\"emacs(2).txt\" respectively. - -***** Query-replace on filenames vs. serial-rename action - -Unlike the [[Serial renaming][serial rename]] actions, the files renamed with -the query-replace action stay in their initial directory and are not moved to -the current directory. As such, using \"\\#\" to serial-rename files only makes -sense for files inside the same directory. It even keeps renaming files -with an incremental number in the next directories. - -*** Serial renaming - -You can use the serial-rename actions to rename, copy or symlink marked files to -a specific directory or in the current directory with all the files numbered -incrementally. - -- Serial-rename by renaming: -Rename all marked files with incremental numbering to a specific directory. - -- Serial-rename by copying: -Copy all marked files with incremental numbering to a specific directory. - -- Serial-rename by symlinking: -Symlink all marked files with incremental numbering to a specific directory. - -*** Edit marked files in a dired buffer - -You can open a dired buffer containing only marked files with `\\\\[helm-ff-run-marked-files-in-dired]'. -With a prefix argument you can open this same dired buffer in wdired mode for -editing. Note that wildcards are supported as well, so you can use e.g. -\"*.txt\" to select all \".txt\" files in the current directory or \"**.txt\" to -select all files recursively from the current directory. -See [[Use the wildcard to select multiple files]] section above. - -*** Defining default target directory for copying, renaming, etc - -You can customize `helm-dwim-target' to behave differently depending on the -windows open in the current frame. Default is to provide completion on all -directories associated to each window. - -*** Copying/Renaming from or to remote directories - -Never use ssh tramp method to copy/rename large files, use -instead its scp method if you want to avoid out of memory -problems and crash Emacs or the whole system. Moreover when using -scp method, you will hit a bug when copying more than 3 files at -the time, see [[https://github.com/emacs-helm/helm/issues/1945][bug#1945]]. -The best way currently is using Rsync to copy files from or to -remote, see [[Use Rsync to copy files][Use Rsync to copy files]]. -Also if you often work on remote you may consider using SSHFS -instead of relying on tramp. - -*** Copying and renaming asynchronously - -If you have the async library installed (if you got Helm from MELPA you do), you -can use it for copying/renaming files by enabling `dired-async-mode'. - -Note that even when async is enabled, running a copy/rename action with a prefix -argument will execute action synchronously. Moreover it will follow the first -file of the marked files in its destination directory. - -When `dired-async-mode' is enabled, an additional action named \"Backup files\" -will be available. (Such command is not natively available in Emacs). -See [[Use the wildcard to select multiple files]] for details. - -*** Multiple copies of a file - -The command \\\\[helm-ff-run-mcp] allows -copying a single file to multiple directories. To use it, mark -the file you want to copy first and then mark the directories -where you want to copy file. For example if you run -\\[helm-ff-run-mcp] on the marked candidates '(\"foo.txt\" \"bar/\" \"baz\"), -\"foo.txt\" will be copied to directories \"bar/\" and \"baz/\". - -*** Use Rsync to copy files - -If Rsync is available, you can use it to copy/sync files or directories -with some restrictions though: - -- Copying from/to tramp sudo method may not work (permissions). -- Copying from remote to remote is not supported (rsync restriction) -however you can mount a remote with sshfs and copy to it (best), otherwise you have to modify -the command line with a prefix arg, see [[https://unix.stackexchange.com/questions/183504/how-to-rsync-files-between-two-remotes][how-to-rsync-files-between-two-remotes]] -for the command line to use. - -This command is mostly useful when copying large files as it is -fast, asynchronous and provide a progress bar in mode-line. Each -rsync process have its own progress bar, so you can run several -rsync jobs, they are independents. If rsync fails you can -consult the \"*helm-rsync*\" buffer to see rsync errors. An -help-echo (move mouse over progress bar) is provided to see which -file is in transfer. Note that when copying directories, no -trailing slashes are added to directory names, which mean that -directory is created on destination if it doesn't already exists, -see rsync documentation for more infos on rsync behavior. To -synchronize a directory, mark all in the directory and rsync all -marked to the destination directory or rsync the directory itself -to its parent, e.g. remote:/home/you/music => /home/you. - -The options are configurable through `helm-rsync-switches', but -you can modify them on the fly when needed by using a prefix arg, -in this case you will be prompted for modifications. - -NOTE: When selecting a remote file, if you use the tramp syntax -for specifying a port, i.e. host#2222, helm will add -automatically \"-e 'ssh -p 2222'\" to the rsync command line -unless you have specified yourself the \"-e\" option by editing -rsync command line with a prefix arg (see above). - -*** Drag and drop files from Helm - -When mouse support is enabled in Helm (which is the default, see -`helm-allow-mouse') you can drag and drop files to `default-directory' -of the buffer you drag-and-drop in or in an external application. - -By default Helm copy files when using drag-and-drop, you can customize -`helm-ff-drag-mouse-1-default-action' to modify this, however note that -other actions than `copy' are not supported when dropping in dired buffers -as of now, it works when dropping in external apps like Thunar though. - -Also drag-and-drop is not working when trying to drop in a window that -is in another desktop, in this case use the following solution. - -To drag-and-drop to external applications you can also use the -external application [[https://github.com/mwh/dragon][Dragon]] and use it as follow: - -#+begin_src elisp - (defun helm-ff-dragon (files) - \"Create a small window with FILES ready to drag and drop. -Use this to drop files on externals applications or desktop. -Dropping on emacs buffers with this is not supported. - -Needs `dragon' executable: https://github.com/mwh/dragon.\" - (interactive (list (helm-marked-candidates))) - (cl-assert (executable-find \"dragon\") nil \"Dragon executable not found\") - (apply #'call-process \"dragon\" nil nil nil \"--all\" \"--and-exit\" files)) - (define-key helm-find-files-map (kbd \"C-c m\") 'helm-ff-dragon) -#+end_src - -Tip: From the Dragon window, you can move your mouse to an other desktop -where the external application you want to drag-and-drop is. - -NOTE: Drag-and-dropping from elsewhere to Helm is forbidden. - -*** Access files on Android phones from Helm - -Since Android doesn't provide anymore mass storage for USB, it is -not simple to access files on Android, the best way to do this -currently seems to use Adb, here some hints to set this up, read -in addition the Tramp documentation. - -1) Install Adb, most distribution provide it. -2) Enable on your phone USB debug in System/dvlpmnt settings. -3) From helm-find-files use adb tramp method: - /adb::/ -From there you can navigate as usual, mark and copy files etc... - -*** Bookmark the `helm-find-files' session - -You can bookmark the `helm-find-files' session with `\\[helm-ff-bookmark-set]'. -You can later retrieve these bookmarks by calling `helm-filtered-bookmarks' -or, from the current `helm-find-files' session, by hitting `\\[helm-find-files-switch-to-bookmark]'. - -*** Grep files from `helm-find-files' - -You can grep individual files from `helm-find-files' by using -\`\\\\[helm-ff-run-grep]'. This same command can also -recursively grep files from the current directory when called with a prefix -argument. In this case you will be prompted for the file extensions to use -\(grep backend) or the types of files to use (ack-grep backend). See the -`helm-grep-default-command' documentation to set this up. For compressed files -or archives, use zgrep with \`\\\\[helm-ff-run-zgrep]'. - -Otherwise you can use recursive commands like \`\\\\[helm-ff-run-grep-ag]' or `\\\\[helm-ff-run-git-grep]' -that are much faster than using `\\\\[helm-ff-run-grep]' with a prefix argument. -See `helm-grep-ag-command' and `helm-grep-git-grep-command' to set this up. - -You can also use \"id-utils\"' GID with \`\\\\[helm-ff-run-gid]' -by creating an ID index file with the \"mkid\" shell command. - -All those grep commands use the symbol at point as the default pattern. -Note that default is different from input (nothing is added to the prompt until -you hit `\\[next-history-element]'). - -**** Grepping on remote files - -On remote files grep is not well supported by TRAMP unless you suspend updates before -entering the pattern and re-enable it once your pattern is ready. -To toggle suspend-update, use `\\\\[helm-toggle-suspend-update]'. - -*** Compressing or uncompressing files from helm-find-files - -**** Compressing/uncompressing using Helm commands - -Helm provide commands like dired (reusing dired code) -to (un)compress files from `helm-find-files', however these -commands are asynchronous. - -You can use `\\\\[helm-ff-run-compress-marked-files]' to compress marked files. -To compress file(s) to an archive use `\\\\[helm-ff-run-compress-to]'. - -To quickly compress/uncompress small files without quitting Helm use `\\\\[helm-ff-persistent-compress]'. -NOTE: This persistent action is NOT asynchronous, IOW it will block Helm -for a while until compression/uncompression finish. - -**** Compressing/uncompressing using external commands in Eshell - -You can use Eshell aliases to uncompress files, -see [[Execute Eshell commands on files][Execute Eshell commands on files]] for more infos. - -Here some aliases using commands from the excellent =atools= package: - -alias pack2zip apack -e -F .zip $* & -alias pack2gz apack -e -F .tar.gz $* & -alias pack2bz apack -e -F .tar.bz $* & -alias pack2xz apack -e -F .tar.xz $* & -alias unpack aunpack $1 & - -Note the \"&\" at end of commands that make eshell aliases asynchronous. -NOTE: Using the ampersand at end of command to make it asynchronous is broken -in all emacs versions before emacs-28 (see emacs bug#50209). - -Of course you can use any other commands of your choice as aliases. - -*** Execute Eshell commands on files - -Setting up aliases in Eshell allows you to set up powerful customized commands. - -Your aliases for using eshell command on file should allow -specifying one or more files, use e.g. \"alias foo $1\" or -\"alias foo $*\", if you want your command to be asynchronous add -at end \"&\", e.g. \"alias foo $* &\". - -Adding Eshell aliases to your `eshell-aliases-file' or using the -`alias' command from Eshell allows you to create personalized -commands not available in `helm-find-files' actions and use them -from `\\\\[helm-ff-run-eshell-command-on-file]'. - -Example: You want a command to uncompress some \"*.tar.gz\" files from `helm-find-files': - -1) Create an Eshell alias named, say, \"untargz\" with the command -\"alias untargz tar zxvf $*\". - -2) Now from `helm-find-files' select the \"*.tar.gz\" file (you can also -mark files if needed) and hit `\\\\[helm-ff-run-eshell-command-on-file]'. - -Note: When using marked files with this, the meaning of the prefix argument is -quite subtle. Say you have \"foo\", \"bar\" and \"baz\" marked; when you run -the alias command `example' on these files with no prefix argument it will run -`example' sequentially on each file: - -$ example foo -$ example bar -$ example baz - -With a prefix argument however it will apply `example' on all files at once: - -$ example foo bar baz - -Of course the alias command should support this. - -NOTE: Helm assume that any alias command ending with '$*' or -'$*&' supports many files as arguments, so no need to give a -prefix arg for such alias, however if your command is not an -alias you have to specify a prefix arg if you want your command -to apply all files at once. - -If you add %s to the command line %s will be replaced with the candidate, this mean you can -add extra argument to your command e.g. command -extra-arg %s or command %s -extra-arg. -If you want to pass many files inside %s, don't forget to use a prefix arg. - -You can also use special placeholders in extra-args, -see the specific info page once you hit `\\\\[helm-ff-run-eshell-command-on-file]'. - -*** Using TRAMP with `helm-find-files' to read remote directories - -`helm-find-files' works fine with TRAMP despite some limitations. - -- Grepping files is not very well supported when used incrementally. -See [[Grepping on remote files]]. - -- Locate does not work on remote directories. - -**** A TRAMP syntax crash course - -Please refer to TRAMP's documentation for more details. - -- Connect to host 192.168.0.4 as user \"foo\": - -/scp:192.168.0.4@foo: - -- Connect to host 192.168.0.4 as user \"foo\" on port 2222: - -/scp:192.168.0.4@foo#2222: - -- Connect to host 192.168.0.4 as root using multihops syntax: - -/ssh:192.168.0.4@foo|sudo:192.168.0.4: - -Note: You can also use `tramp-default-proxies-alist' when connecting often to -the same hosts. - -As a rule of thumb, prefer the scp method unless using multihops (which only -works with the ssh method), especially when copying large files. - -IMPORTANT: -You need to hit `C-j' once on top of a directory on the first connection -to complete the pattern in the minibuffer. - -**** Display color for directories, symlinks etc... with tramp - -Starting at helm version 2.9.7 it is somewhat possible to -colorize fnames by listing files without loosing performances with -external commands (ls and awk) if your system is compatible. -For this you can use `helm-list-dir-external' as value -for `helm-list-remote-directory-fn'. - -See `helm-list-remote-directory-fn' documentation for more infos. - -**** Completing host - -As soon as you enter the first \":\" after method e.g =/scp:= you will -have some completion about previously used hosts or from your =~/.ssh/config= -file, hitting `\\[helm-execute-persistent-action]' or `right' on a candidate will insert this host in minibuffer -without addind the ending \":\", second hit insert the last \":\". -As soon the last \":\" is entered TRAMP will kick in and you should see the list -of candidates soon after. - -**** Completion on tramp methods - -If you enter \":\" directly after \"/\" or \"|\" you will have completion on tramp methods, -hitting `\\[helm-execute-persistent-action]' or `right' on a method will insert it in minibuffer. - -When connection fails, be sure to delete your TRAMP connection with M-x -`helm-delete-tramp-connection' before retrying. - -**** Editing local files as root - -Use the sudo method: - -\"/sudo:host:\" or simply \"/sudo::\". - -*** Attach files to a mail buffer (message-mode) - -If you are in a `message-mode' or `mail-mode' buffer, that action will appear -in action menu, otherwise it is available at any time with \\\\[helm-ff-run-mail-attach-files]. -It behaves as follows: - -- If you are in a (mail or message) buffer, files are attached there. - -- If you are not in a mail buffer but one or more mail buffers exist, you are -prompted to attach files to one of these mail buffers. - -- If you are not in a mail buffer and no mail buffer exists, -a new mail buffer is created with the attached files in it. - -*** Open files in separate windows - -When [[Marked candidates][marking]] multiple files or using [[Use the wildcard to select multiple files][wildcard]], helm allow opening all -this files in separate windows using an horizontal layout or a -vertical layout if you used a prefix arg, when no more windows can be -displayed in frame, next files are opened in background without being -displayed. When using \\\\[helm-ff-run-switch-other-window] the current -buffer is kept and files are displayed next to it with same behavior as above. -When using two prefix args, files are opened in background without beeing displayed. - -*** Expand archives as directories in a avfs directory - -If you have mounted your filesystem with 'mountavfs' command, -you can expand archives in the \"~/.avfs\" directory with \\\\[helm-execute-persistent-action]. - -To umount Avfs, use ~fusermount -u ~/.avfs~ - -NOTE: You need the package 'avfs', on debian like distros use ~apt-get install avfs~. - -*** Tramp archive support (emacs-27+ only) - -As Tramp archive often crash Helm and Emacs, Helm does its best -to disable it, however it is hard to do so as Tramp Archive is -enabled inconditionally in Emacs. Here I build my Emacs -without-dbus to ensure Tramp archive wont kickin unexpectedly. - -If you want to browse archives please use [[Expand archives as -directories in a avfs directory][Avfs]] which is much better and -stable. - -*** Touch files - -In the completion buffer, you can choose the default which is the current-time, it is -the first candidate or the timestamp of one of the selected files. -If you need to use something else, use \\\\[next-history-element] and edit -the date in minibuffer. -It is also a way to quickly create a new file without opening a buffer, saving it -and killing it. -To touch more than one new file, separate you filenames with a comma (\",\"). -If one wants to create (touch) a new file with comma inside the name use a prefix arg, -this will prevent splitting the name and create multiple files. - -*** Change mode on files (chmod) - -When running `\\\\[helm-ff-run-chmod]' on marked -files, you can enter the new mode in prompt but you can also use the -first marked file as model to use it as default. For example you can -mark a file with mode 777 and mark other files with mode 664, press -'RET' and answer 'y', all marked files will be changed to 777. To see -the default mode and eventually edit it use 'M-n'. You can use numeric -mode or letters, see 'chmod' man page for more infos. - -NOTE: Another way to change modes on files in helm-find-files is -running `\\\\[helm-ff-run-switch-to-shell]' and use 'chmod' directly. - -*** Change owner and/or group on files - -Change owner of marked files with `\\\\[helm-ff-run-chown]' and group with `\\\\[helm-ff-run-chgrp]'. -To change both at the same time use e.g. \"user:user\" at prompt. -If you have not the rights to do this, you may have an error (see dired-log), in this case -open the directory as root with tramp methods sudo or su to operate. - -*** Delete files - -You can delete files without quitting helm with -`\\\\[helm-ff-persistent-delete]' or delete files and quit helm with `\\[helm-ff-run-delete-file]'. - -In the second method you can choose to -make this command asynchronous by customizing -\`helm-ff-delete-files-function'. - -_WARNING_: When deleting files asynchronously you will NOT be -WARNED if directories are not empty, that's mean non empty directories will -be deleted recursively in background without asking. - -A good compromise is to trash your files -when using asynchronous method (see [[Trashing files][Trashing files]]). - -When choosing synchronous delete, you can allow recursive -deletion of directories with `helm-ff-allow-recursive-deletes'. -Note that when trashing (synchronous) you are not asked for recursive deletion. - -Note that `helm-ff-allow-recursive-deletes' have no effect when -deleting asynchronously. - -First method (persistent delete) is always synchronous. - -Note that when a prefix arg is given, trashing behavior is inversed. -See [[Trashing files][Trashing files]]. - -**** Trashing files - -If you want to trash your files instead of deleting them you can -set `delete-by-moving-to-trash' to non nil, like this your files -will be moved to trash instead of beeing deleted. - -You can reverse at any time the behavior of `delete-by-moving-to-trash' by using -a prefix arg with any of the delete files command. - -On GNULinux distributions, when navigating to a Trash directory you -can restore any file in ..Trash/files directory with the 'Restore -from trash' action you will find in action menu (needs the -trash-cli package installed for remote files, see [[Trashing remote files with tramp][Here]]). -You can as well delete files from Trash directories with the 'delete files from trash' -action. -If you want to know where a file will be restored, hit `M-i', you will find a trash info. - -Tip: Navigate to your Trash/files directories with `helm-find-files' and set a bookmark -there with \\\\[helm-ff-bookmark-set] for fast access to Trash. - -NOTE: Restoring files from trash is working only on system using -the -[[http://freedesktop.org/wiki/Specifications/trash-spec][freedesktop trash specifications]]. - -***** Trashing remote files with tramp - -Trashing remote files (or local files with sudo method) is disabled by default -because tramp is requiring the 'trash' command to be installed, if you want to -trash your remote files, customize `helm-trash-remote-files'. -The package on most GNU/Linux based distributions is trash-cli, it is available [[https://github.com/andreafrancia/trash-cli][here]]. - -NOTE: -When deleting your files with sudo method, your trashed files will not be listed -with trash-list command line until you log in as root. - -*** Checksum file - -Checksum is calculated with the md5sum, sha1sum, sha224sum, -sha256sum, sha384sum and sha512sum commands when available, otherwise the -Emacs function `secure-hash' is used but it is slow and may crash -Emacs and even the whole system as it eats all memory. So if -your system doesn't have the md5sum and sha*sum command line tools be -careful when checking sum of larges files e.g. isos. - -*** Ignored or boring files - -Helm-find-files can ignore files matching -`helm-boring-file-regexp-list' or files that are git ignored, you -can set this with `helm-ff-skip-boring-files' or -`helm-ff-skip-git-ignored-files'. -NOTE: This will slow down helm, be warned. - -*** Helm-find-files is using a cache - -Helm is caching each directory files list in a hash table for -faster search, when a directory is modified it is removed from cache -so that further visit in this directory refresh cache. -You may have in some rare cases to refresh directory manually with `\\\\[helm-refresh]' -for example when helm-find-files session is running and a file is modified/deleted -in current visited directory by an external command from outside Emacs. - -NOTE: Helm is using file-notify to watch visited directories, -nowaday most systems come with a notify package but if your -system doesn't support this, you can turn off file notifications -by customizing the variable `helm-ff-use-notify'. In this case -you will have to refresh manually directories when needed with `\\\\[helm-refresh]'. - -*** Prefix file candidates with icons - -If `all-the-icons' package is installed, turning on -`helm-ff-icon-mode' will show icons before files and directories. - -** Commands -\\ -|Keys|Description -|-----------+----------| -|\\[helm-ff-run-locate]|Run `locate' (`\\[universal-argument]' to specify locate database, `M-n' to insert basename of candidate). -|\\[helm-ff-run-browse-project]|Browse project (`\\[universal-argument]' to recurse, `\\[universal-argument] \\[universal-argument]' to recurse and refresh database). -|\\[helm-ff-run-find-sh-command]|Run `find' shell command from this directory. -|\\[helm-ff-run-grep]|Run Grep (`\\[universal-argument]' to recurse). -|\\[helm-ff-run-pdfgrep]|Run Pdfgrep on marked files. -|\\[helm-ff-run-zgrep]|Run zgrep (`\\[universal-argument]' to recurse). -|\\[helm-ff-run-grep-ag]|Run AG grep on current directory. -|\\[helm-ff-run-git-grep]|Run git-grep on current directory. -|\\[helm-ff-run-gid]|Run gid (id-utils). -|\\[helm-ff-run-etags]|Run Etags (`\\[universal-argument]' to use thing-at-point, `\\[universal-argument] \\[universal-argument]' to reload cache). -|\\[helm-ff-run-rename-file]|Rename Files (`\\[universal-argument]' to follow). -|\\[helm-ff-run-query-replace-fnames-on-marked]|Query replace on marked files. -|\\[helm-ff-run-copy-file]|Copy Files (`\\[universal-argument]' to follow). -|\\[helm-ff-run-mcp]|Copy car of marked to remaining directories. -|\\[helm-ff-run-rsync-file]|Rsync Files (`\\[universal-argument]' to edit command). -|\\[helm-ff-run-byte-compile-file]|Byte Compile Files (`\\[universal-argument]' to load). -|\\[helm-ff-run-load-file]|Load Files. -|\\[helm-ff-run-symlink-file]|Symlink Files. -|\\[helm-ff-run-hardlink-file]|Hardlink files. -|\\[helm-ff-run-relsymlink-file]|Relative symlink Files. -|\\[helm-ff-run-chmod]|Change mode on Files. -|\\[helm-ff-run-chown]|Change owner on Files. -|\\[helm-ff-run-chgrp]|Change group on Files. -|\\[helm-ff-run-delete-file]|Delete Files. -|\\[helm-ff-run-touch-files]|Touch files. -|\\[helm-ff-run-kill-buffer-persistent]|Kill buffer candidate without leaving Helm. -|\\[helm-ff-persistent-delete]|Delete file without leaving Helm. -|\\[helm-ff-run-switch-to-shell]|Switch to prefered shell. -|\\[helm-ff-run-eshell-command-on-file]|Eshell command on file (`\\[universal-argument]' to apply on marked files, otherwise treat them sequentially). -|\\[helm-ff-run-ediff-file]|Ediff file. -|\\[helm-ff-run-ediff-merge-file]|Ediff merge file. -|\\[helm-ff-run-complete-fn-at-point]|Complete file name at point. -|\\[helm-ff-run-switch-other-window]|Switch to other window. -|\\[helm-ff-run-switch-other-frame]|Switch to other frame. -|\\[helm-ff-run-open-file-externally]|Open file with external program (`\\[universal-argument]' to choose). -|\\[helm-ff-run-preview-file-externally]|Preview file with external program. -|\\[helm-ff-run-open-file-with-default-tool]|Open file externally with default tool. -|\\[helm-ff-rotate-left-persistent]|Rotate image left. -|\\[helm-ff-rotate-right-persistent]|Rotate image right. -|\\[helm-ff-increase-image-size-persistent]|Zoom in image. -|\\[helm-ff-decrease-image-size-persistent]|Zoom out image. -|\\[helm-ff-toggle-thumbnails]|Show thumbnails on image files. -|\\[helm-find-files-up-one-level]|Go to parent directory. -|\\[helm-find-files-history]|Switch to the visited-directory history. -|\\[helm-ff-file-name-history]|Switch to file name history. -|\\[helm-ff-properties-persistent]|Show file properties in a tooltip. -|\\[helm-mark-all]|Mark all visible candidates. -|\\[helm-ff-run-toggle-auto-update]|Toggle auto-expansion of directories. -|\\[helm-unmark-all]|Unmark all candidates, visible and invisible ones. -|\\[helm-ff-run-mail-attach-files]|Attach files to message buffer. -|\\[helm-ff-run-print-file]|Print file, (`\\[universal-argument]' to refresh printer list). -|\\[helm-enlarge-window]|Enlarge Helm window. -|\\[helm-narrow-window]|Narrow Helm window. -|\\[helm-ff-run-toggle-basename]|Toggle basename/fullpath. -|\\[helm-ff-run-find-file-as-root]|Find file as root. -|\\[helm-ff-run-find-alternate-file]|Find alternate file. -|\\[helm-ff-run-insert-org-link]|Insert org link. -|\\[helm-ff-bookmark-set]|Set bookmark to current directory. -|\\[helm-find-files-switch-to-bookmark]|Jump to bookmark list. -|\\[helm-ff-sort-alpha]|Sort alphabetically. -|\\[helm-ff-sort-by-newest]|Sort by newest. -|\\[helm-ff-sort-by-size]|Sort by size. -|\\[helm-ff-toggle-dirs-only]|Show only directories. -|\\[helm-ff-toggle-files-only]|Show only files. -|\\[helm-ff-sort-by-ext]|Sort by extensions. -|\\[helm-ff-run-compress-to]|Compress file(s) to archive. -|\\[helm-ff-run-compress-marked-files]|Compress file(s). -|\\[helm-ff-persistent-compress]|Compress file(s) without quitting.") - -;;; Help for file-name-history -;; -;; -(defvar helm-file-name-history-help-message - "* Helm file name history - -** Tips - -Helm is turning on `recentf-mode' for you only when calling this command -and if `helm-turn-on-recentf' is non nil. That's mean that the files -opened prior calling this command would not be saved if you didn't -enable `recentf-mode' yourself in your init file or manually. - -** Commands -\\ -\\[helm-ff-file-name-history-run-ff]|Preselect file in helm-find-files.") - -;;; Help for `helm-read-file-name' -;; -;; -(defun helm-read-file-name-help-message () - (let ((name (if helm-alive-p - (assoc-default 'name (helm-get-current-source)) - "generic"))) - (format - "* Helm `%s' read file name completion - -This is `%s' read file name completion that have been \"helmized\" -because you have enabled [[Helm mode][helm-mode]]. -Don't confuse this with `helm-find-files' which is a native helm command, -see [[Helm functions vs helmized Emacs functions]]. - -** Tips - -*** Navigation - -**** Enter `~/' at end of pattern to quickly reach home directory - -**** Enter `/' at end of pattern to quickly reach the file system root - -**** Enter `./' at end of pattern to quickly reach `default-directory' - -\(As per its value at the beginning of the session.) - -If you already are in the `default-directory' this will move the cursor to the top. - -**** Enter `../' at end of pattern will reach upper directory, moving cursor on top - -This is different from using `\\[helm-find-files-up-one-level]' in that it moves -the cursor to the top instead of remaining on the previous subdir name. - -**** You can complete with partial basename - -It starts from the third character of the pattern. - -For instance \"fob\" or \"fbr\" will complete \"foobar\" but \"fb\" needs a -third character in order to complete it. - -*** Persistent actions - -By default `helm-read-file-name' uses the persistent actions of `helm-find-files'. - -**** Use `\\[universal-argument] \\\\[helm-execute-persistent-action]' to display an image - -**** `\\\\[helm-execute-persistent-action]' on a filename will expand to this filename in Helm-buffer - -Second hit displays the buffer filename. -Third hit kills the buffer filename. -Note: `\\[universal-argument] \\\\[helm-execute-persistent-action]' displays the buffer directly. - -**** Browse images directories with `helm-follow-mode' and navigate up/down - -*** Delete characters backward - -When you want to delete characters backward, e.g. to create a new file or directory, -auto-update may come in the way when it keeps updating to an existent directory. -In that case, type `C-' and then `'. -This should not be needed when copying/renaming files because autoupdate is disabled -by default in that case. - -Note: On a terminal, the default binding `C-' may not work. -In this case use `C-c '. - -*** Create new directories and files - -**** You can create a new directory and a new file at the same time - -Simply write the path in prompt and press `RET', e.g. -\"~/new/newnew/newnewnew/my_newfile.txt\". - -**** To create a new directory, append a \"/\" at to the new name and press `RET' - -**** To create a new file, enter a filename not ending with \"/\" - -File and directory creation works only with some commands (e.g. `find-file') -and it will not work with others where it is not intended to return a file or -a directory \(e.g `list-directory'). - -*** Exiting minibuffer with empty string - -You can exit minibuffer with empty string with \\\\[helm-cr-empty-string]. -It is useful when some commands are prompting continuously until you enter an empty prompt. - -** Commands -\\ -|Keys|Description -|-----------+----------| -|\\[helm-find-files-up-one-level]|Go to parent directory. -|\\[helm-ff-run-toggle-auto-update]|Toggle auto-expansion of directories. -|\\[helm-ff-run-toggle-basename]|Toggle basename. -|\\[helm-ff-file-name-history]|File name history. -|C/\\[helm-cr-empty-string]|Return empty string unless `must-match' is non-nil. -|\\[helm-next-source]|Go to next source. -|\\[helm-previous-source]|Go to previous source." - name name))) - -;;; FD help -;; -;; -(defvar helm-fd-help-message - "* Helm fd - -** Tips - -\[[https://github.com/sharkdp/fd][The Fd command line tool]] is very fast to search files recursively. -You may have to wait several seconds at first usage when your -hard drive cache is \"cold\", then once the cache is initialized -searchs are very fast. You can pass any [[https://github.com/sharkdp/fd#command-line-options][Fd options]] before pattern, e.g. \"-e py foo\". - -The [[https://github.com/sharkdp/fd][Fd]] command line can be customized with `helm-fd-switches' user variable. -Always use =--color always= as option otherwise you will have no colors. -To customize colors see [[https://github.com/sharkdp/fd#colorized-output][Fd colorized output]]. - -NOTE: -Starting from fd version 8.2.1, you have to provide the env var -LS_COLORS to Emacs to have a colorized output, the easiest way is -to add to your =~/.profile= file =eval $(dircolors)=. -Another way is using =setenv= in your init file. -This is not needed when running Emacs from a terminal either with =emacs -nw= -or =emacs= because emacs inherit the env vars of this terminal. -See [[https://github.com/sharkdp/fd/issues/725][fd bugref#725]] - -Search is (pcre) regexp based (see [[https://docs.rs/regex/1.0.0/regex/#syntax][Regexp syntax]]), multi patterns are _not_ supported. - -** Man page - -NAME - fd - find entries in the filesystem - -SYNOPSIS - fd [-HIEsiaLp0hV] [-d depth] [-t filetype] [-e ext] [-E exclude] [-c - when] [-j num] [-x cmd] [pattern] [path...] - -DESCRIPTION - fd is a simple, fast and user-friendly alternative to find(1). - -OPTIONS - -H, --hidden - Include hidden files and directories in the search results - (default: hidden files and directories are skipped). - - -I, --no-ignore - Show search results from files and directories that would other‐ - wise be ignored by .gitignore, .ignore, .fdignore, or the global - ignore file. - - -u, --unrestricted - Alias for '--no-ignore'. Can be repeated; '-uu' is an alias for - '--no-ignore --hidden'. - - --no-ignore-vcs - Show search results from files and directories that would other‐ - wise be ignored by .gitignore files. - - -s, --case-sensitive - Perform a case-sensitive search. By default, fd uses case-insen‐ - sitive searches, unless the pattern contains an uppercase char‐ - acter (smart case). - - -i, --ignore-case - Perform a case-insensitive search. By default, fd uses case- - insensitive searches, unless the pattern contains an uppercase - character (smart case). - - -g, --glob - Perform a glob-based search instead of a regular expression - search. - - --regex - Perform a regular-expression based seach (default). This can be - used to override --glob. - - -F, --fixed-strings - Treat the pattern as a literal string instead of a regular - expression. - - -a, --absolute-path - Shows the full path starting from the root as opposed to rela‐ - tive paths. - - -l, --list-details - Use a detailed listing format like 'ls -l'. This is basically an - alias for '--exec-batch ls -l' with some additional 'ls' - options. This can be used to see more metadata, to show symlink - targets and to achieve a deterministic sort order. - - -L, --follow - By default, fd does not descend into symlinked directories. - Using this flag, symbolic links are also traversed. - - -p, --full-path - By default, the search pattern is only matched against the file‐ - name (or directory name). Using this flag, the pattern is - matched against the full path. - - -0, --print0 - Separate search results by the null character (instead of new‐ - lines). Useful for piping results to xargs. - - --max-results count - Limit the number of search results to 'count' and quit immedi‐ - ately. - - -1 Limit the search to a single result and quit immediately. This - is an alias for '--max-results=1'. - - --show-errors - Enable the display of filesystem errors for situations such as - insufficient permissions or dead symlinks. - - --one-file-system, --mount, --xdev - By default, fd will traverse the file system tree as far as - other options dictate. With this flag, fd ensures that it does - not descend into a different file system than the one it started - in. Comparable to the -mount or -xdev filters of find(1). - - -h, --help - Print help information. - - -V, --version - Print version information. - - -d, --max-depth d - Limit directory traversal to at most d levels of depth. By - default, there is no limit on the search depth. - - --min-depth d - Only show search results starting at the given depth. See also: - '--max-depth' and '--exact-depth'. - - --exact-depth d - Only show search results at the exact given depth. This is an - alias for '--min-depth --max-depth '. - - -t, --type filetype - Filter search by type: - - f, file - regular files - - d, directory - directories - - l, symlink - symbolic links - - x, executable - executable (files) - - e, empty - empty files or directories - - s, socket - sockets - - p, pipe - named pipes (FIFOs) - - This option can be used repeatedly to allow for multiple file - types. - - -e, --extension ext - Filter search results by file extension ext. This option can be - used repeatedly to allow for multiple possible file extensions. - - -E, --exclude pattern - Exclude files/directories that match the given glob pattern. - This overrides any other ignore logic. Multiple exclude pat‐ - terns can be specified. - - --ignore-file path - Add a custom ignore-file in '.gitignore' format. These files - have a low precedence. - - -c, --color when - Declare when to colorize search results: - - auto Colorize output when standard output is connected to terminal (default). - - never Do not colorize output. - - always Always colorize output. - - -j, --threads num - Set number of threads to use for searching & executing (default: - number of available CPU cores). - - -S, --size size - Limit results based on the size of files using the format - <+-> - - '+' file size must be greater than or equal to this - - '-' file size must be less than or equal to this - - 'NUM' The numeric size (e.g. 500) - - 'UNIT' The units for NUM. They are not case-sensitive. Allowed - unit values: - - 'b' bytes - - 'k' kilobytes (base ten, 10^3 = 1000 bytes) - - 'm' megabytes - - 'g' gigabytes - - 't' terabytes - - 'ki' kibibytes (base two, 2^10 = 1024 bytes) - - 'mi' mebibytes - - 'gi' gibibytes - - 'ti' tebibytes - - --changed-within date|duration - Filter results based on the file modification time. The argument - can be provided as a specific point in time (YYYY-MM-DD - HH:MM:SS) or as a duration (10h, 1d, 35min). --change-newer- - than can be used as an alias. - - Examples: - --changed-within 2weeks - --change-newer-than \"2018-10-27 10:00:00\" - - --changed-before date|duration - Filter results based on the file modification time. The argument - can be provided as a specific point in time (YYYY-MM-DD - HH:MM:SS) or as a duration (10h, 1d, 35min). --change-older- - than can be used as an alias. - - Examples: - --changed-before \"2018-10-27 10:00:00\" - --change-older-than 2weeks - - -o, --owner [user][:group] - Filter files by their user and/or group. Format: - [(user|uid)][:(group|gid)]. Either side is optional. Precede - either side with a '!' to exclude files instead. - - Examples: - --owner john - --owner :students - --owner \"!john:students\" - - -x, --exec command - Execute command for each search result. The following placehold‐ - ers are substituted by a path derived from the current search - result: - - {} path - - {/} basename - - {//} parent directory - - {.} path without file extension - - {/.} basename without file extension - - -X, --exec-batch command - Execute command with all search results at once. A single - occurence of the following placeholders is authorized and - sub stituted by the paths derived from the search results before the - command is executed: - - {} path - - {/} basename - - {//} parent directory - - {.} path without file extension - - {/.} basename without file extension - -** Commands -\\ -|Keys|Description -|-----------+----------| -|\\[helm-ff-run-grep]|Run grep (`\\[universal-argument]' to recurse). -|\\[helm-ff-run-zgrep]|Run zgrep. -|\\[helm-ff-run-pdfgrep]|Run PDFgrep on marked files. -|\\[helm-ff-run-copy-file]|Copy file(s) -|\\[helm-ff-run-rename-file]|Rename file(s). -|\\[helm-ff-run-symlink-file]|Symlink file(s). -|\\[helm-ff-run-hardlink-file]|Hardlink file(s). -|\\[helm-ff-run-delete-file]|Delete file(s). -|\\[helm-ff-run-byte-compile-file]|Byte compile Elisp file(s) (`\\[universal-argument]' to load). -|\\[helm-ff-run-load-file]|Load Elisp file(s). -|\\[helm-ff-run-ediff-file]|Ediff file. -|\\[helm-ff-run-ediff-merge-file]|Ediff-merge file. -|\\[helm-ff-run-switch-other-window]|Switch to other window. -|\\[helm-ff-properties-persistent]|Show file properties. -|\\[helm-ff-run-open-file-externally]|Open file with external program (`\\[universal-argument]' to choose). -|\\[helm-ff-run-open-file-with-default-tool]|Open file externally with default tool. -|\\[helm-ff-run-insert-org-link]|Insert org link. -|\\[helm-fd-previous-directory]|Move to previous directory. -|\\[helm-fd-next-directory]|Move to next directory.") - -;;; Generic file help - Used by locate. -;; -;; -(defvar helm-generic-file-help-message - "* Helm Generic files - -** Tips - -*** Locate - -You can append to the search pattern any of the locate command line options, -e.g. -b, -e, -n , etc. See the locate(1) man page for more details. - -Some other sources (at the moment \"recentf\" and \"file in current directory\") -support the -b flag for compatibility with locate when they are used with it. - -When you enable fuzzy matching on locate with `helm-locate-fuzzy-match', the -search will be performed on basename only for efficiency (so don't add \"-b\" at -prompt). As soon as you separate the patterns with spaces, fuzzy matching will -be disabled and search will be done on the full filename. Note that in -multi-match, fuzzy is completely disabled, which means that each pattern is a -match regexp (i.e. \"helm\" will match \"helm\" but \"hlm\" will *not* match -\"helm\"). - -NOTE: On Windows use Everything with its command line ~es~ as a replacement of locate. -See [[https://github.com/emacs-helm/helm/wiki/Locate#windows][Locate on Windows]] - -On recent systems, the updatedb command doesn't -index anymore user directories, see the option PRUNE_BIND_MOUNTS -in the updatedb man page. - -*** Browse project - -When the current directory is not under version control, don't forget to refresh -the cache when files have been added/removed in the directory. - -*** Find command - -Recursively search files using the \"find\" shell command. - -Candidates are all filenames that match all given globbing patterns. This -respects the options `helm-case-fold-search' and -`helm-findutils-search-full-path'. - -You can pass arbitrary \"find\" options directly after a \"*\" separator. -For example, this would find all files matching \"book\" that are larger -than 1 megabyte: - - book * -size +1M - -** Commands -\\ -|Keys|Description -|-----------+----------| -|\\[helm-ff-run-toggle-basename]|Toggle basename. -|\\[helm-ff-run-grep]|Run grep (`\\[universal-argument]' to recurse). -|\\[helm-ff-run-zgrep]|Run zgrep. -|\\[helm-ff-run-pdfgrep]|Run PDFgrep on marked files. -|\\[helm-ff-run-copy-file]|Copy file(s) -|\\[helm-ff-run-rename-file]|Rename file(s). -|\\[helm-ff-run-symlink-file]|Symlink file(s). -|\\[helm-ff-run-hardlink-file]|Hardlink file(s). -|\\[helm-ff-run-delete-file]|Delete file(s). -|\\[helm-ff-run-byte-compile-file]|Byte compile Elisp file(s) (`\\[universal-argument]' to load). -|\\[helm-ff-run-load-file]|Load Elisp file(s). -|\\[helm-ff-run-ediff-file]|Ediff file. -|\\[helm-ff-run-ediff-merge-file]|Ediff-merge file. -|\\[helm-ff-run-switch-other-window]|Switch to other window. -|\\[helm-ff-properties-persistent]|Show file properties. -|\\[helm-ff-run-open-file-externally]|Open file with external program (`\\[universal-argument]' to choose). -|\\[helm-ff-run-open-file-with-default-tool]|Open file externally with default tool. -|\\[helm-ff-run-insert-org-link]|Insert org link.") - -;;; Grep help -;; -;; -(defvar helm-grep-help-message - "* Helm Grep - -** Tips - -With Helm supporting Git-grep and AG/RG, you are better off using -one of them for recursive searches, keeping grep or ack-grep to -grep individual or marked files. See [[Helm AG][Helm AG]]. - -*** Meaning of the prefix argument -**** With grep or ack-grep - -Grep recursively, in this case you are -prompted for types (ack-grep) or for wild cards (grep). - -**** With AG or RG - -the prefix arg allows you to specify a type of file to search in. - -*** You can use wild cards when selecting files (e.g. \"*.el\") - -Note that a way to grep specific files recursively is to use -e.g. \"**.el\" to select files, the variable `helm-file-globstar' -controls this (it is non nil by default), however it is much -slower than using grep recusively (see helm-find-files -documentation about this feature). - -*** Grep hidden files - -You may want to customize your command line for grepping hidden -files, for AG/RG use \"--hidden\", see man page -of your backend for more infos. - -*** You can grep in different directories by marking files or using wild cards - -*** You can save the result in a `helm-grep-mode' buffer - -See [[Commands][commands]] below. - -Once in that buffer you can use [[https://github.com/mhayashi1120/Emacs-wgrep][emacs-wgrep]] (external package not bundled with Helm) -to edit your changes, for Helm the package name is `wgrep-helm', it is hightly recommended. - -Type `g' to update (revert) the buffer (after saving your buffer's changes to file). - -NOTE: `next-error' is available from this `helm-grep-mode' buffer. - -When you are running `next-error' from elsewhere, you can update -the buffer with `helm-revert-next-error-last-buffer' (up to you -to bind it to a convenient key). - -*** Helm-grep supports multi-matching - -\(Starting from version 1.9.4.) - -Simply add a space between each pattern as for most Helm commands. - -NOTE: Depending the regexp you use it may match as well the -filename, this because we pipe the first grep command which send -the filename in output. - -*** See full path of selected candidate - -Add (helm-popup-tip-mode 1) in your init file or enable it -interactively with M-x helm-popup-tip-mode, however it is -generally enough to just put your mouse cursor over candidate. - -*** Stop grepping with AG or RG and search in the current results - -Once you have found your results with helm grep ag you can search -in these results (helm search, no grep). This allows narrowing -the results to a specific file for example or to a specific -pattern without launching grep ag/rg. The command is \\\\[helm-grep-ag-run-search-results]. -If you want to continue grepping, switch to the previous helm session -which is helm-grep-ag session with \\\\[helm-resume-previous-session-after-quit]. - -_NOTE_: This is available only in AG/RG, not grep. - -*** Grep AG/RG on parent directory - -The command -\\\\[helm-grep-run-ag-grep-parent-directory] allow to grep the parent directory -of the currently searched directory. - -*** Open file in other window - -The command \\\\[helm-grep-run-other-window-action] allow you to open file -in other window horizontally or vertically if a prefix arg is supplied. - -*** Performance over TRAMP - -Grepping works but it is badly supported as TRAMP doesn't support multiple -processes running in a short delay (less than 5s) among other things. - -Helm uses a special hook to suspend the process automatically while you are -typing. Even if Helm handles this automatically by delaying each process by 5s, -you are adviced to this manually by hitting `\\\\[helm-toggle-suspend-update]' (suspend process) before -typing, and hit again `\\\\[helm-toggle-suspend-update]' when the regexp is ready to send to the remote -process. For simple regexps, there should be no need for this. - -Another solution is to not use TRAMP at all and mount your remote file system via -SSHFS. - -* Helm GID - -Still supported, but mostly deprecated, using AG/RG or Git-grep -is much more efficient, also `id-utils' seems no more maintained. - -** Tips - -Helm-GID reads the database created with the `mkid' command from id-utils. -The name of the database file can be customized with `helm-gid-db-file-name', it -is usually \"ID\". - -Helm-GID use the symbol at point as default-input. This command is also -accessible from `helm-find-files' which allow you to navigate to another -directory to consult its database. - -Note: Helm-GID supports multi-matches but only the last pattern entered will be -highlighted since there is no ~--color~-like option in GID itself. - -* Helm AG - -** Tips - -Helm-AG is different from grep or ack-grep in that it works on a -directory recursively and not on a list of files. It is called -helm-AG but it support several backend, namely AG, RG and PT. -Nowaday the best backend is Ripgrep aka RG, it is the fastest and -is actively maintained, see `helm-grep-ag-command' and -`helm-grep-ag-pipe-cmd-switches' to configure it. - -You can ignore files and directories with a \".agignore\" or -\".rgignore\" file, local to a directory or global when placed in -the home directory. (See the AG/RG man pages for more details.) -Note that `helm-grep-ignored-files'and -`helm-grep-ignored-directories' have no effect in helm-AG/RG. - -As always you can access Helm AG from `helm-find-files'. - -Starting with version 0.30, AG accepts one or more TYPE arguments on its command -line. Helm provides completion on these TYPE arguments when available with your -AG version. Use a prefix argument when starting a Helm-AG session to enable this -completion. See RG and AG man pages on how to add new types. - - -Note: You can mark several types to match in the AG query. The first AG -versions providing this feature allowed only one type, so in this case only the -last mark will be used. - -* Helm git-grep - -Helm-git-grep searches the current directory, i.e. the default directory or the -directory in Helm-find-files. If this current directory is a subdirectory of a -project and you want to also match parent directories (i.e the whole project), -use a prefix argument. - -** Commands -\\ -|Keys|Description -|-----------+----------| -|\\[helm-goto-next-file]|Next File. -|\\[helm-goto-precedent-file]|Previous File. -|\\[helm-yank-text-at-point]|Yank text at point in minibuffer. -|\\[helm-grep-run-other-window-action]|Jump to other window. -|\\[helm-grep-run-other-frame-action]|Jump to other frame. -|\\[helm-grep-run-default-action]|Run default action (same as `RET'). -|\\[helm-grep-run-save-buffer]|Save to a `helm-grep-mode' enabled buffer.") - -;;; PDF grep help -;; -;; -(defvar helm-pdfgrep-help-message - "* Helm PDFgrep Map - -** Commands -\\ -|Keys|Description -|-----------+----------| -|\\[helm-goto-next-file]|Next file. -|\\[helm-goto-precedent-file]|Previous file. -|\\[helm-yank-text-at-point]|Yank text at point in minibuffer.") - -;;; Etags help -;; -;; -(defvar helm-etags-help-message - "* Helm Etags Map - -** Commands -\\ -|Keys|Description -|-----------+----------| -|\\[helm-goto-next-file]|Next file. -|\\[helm-goto-precedent-file]|Previous file. -|\\[helm-yank-text-at-point]|Yank text at point in minibuffer.") - -;;; UCS help -;; -;; -(defvar helm-ucs-help-message - "* Helm UCS - -** Tips - -Use commands below to insert unicode characters in current buffer without -leaving Helm. - -** Commands -\\ -|Keys|Description -|-----------+----------| -|\\[helm-ucs-persistent-insert]|Insert character. -|\\[helm-ucs-persistent-forward]|Forward character. -|\\[helm-ucs-persistent-backward]|Backward character. -|\\[helm-ucs-persistent-delete]|Delete character backward. -|\\[helm-ucs-persistent-insert-space]|Insert space.") - -;;; Bookmark help -;; -;; -(defvar helm-bookmark-help-message - "* Helm bookmark name - -** Tips - -*** Display bookmarks with Icons - -When `helm-bookmark-use-icon' is non nil and you have a -`helm-x-icons-provider' either `all-the-icons' or `nerd-icons' package -is installed icons before candidates will be displayed. - -*** Reset bookmark position - -When using `helm-filtered-bookmarks' you can modify your bookmark -position by resetting it, to do this, jump to your bookmark, move point -to the new location, then call again `helm-filtered-bookmarks' and find -your current bookmark, yank its name in minibuffer with `\\\\[helm-yank-selection]' -switch to the \"Set bookmark\" source and hit RET. - -** Commands -\\ -|Keys|Description -|-----------+----------| -|\\[helm-bookmark-run-jump-other-window]|Jump other window. -|\\[helm-bookmark-run-delete]|Delete bookmark. -|\\[helm-bookmark-run-edit]|Edit bookmark. -|\\[helm-bookmark-toggle-filename]|Toggle bookmark location visibility.") - -;;; Eshell command on file help -;; -;; -(defvar helm-esh-help-message - "* Helm Eshell on file - -** Tips - -*** Pass extra arguments after filename - -Normally the command or alias will be called with file as argument. For instance - - candidate_file - -But you can also pass an argument or more after \"candidate_file\" like this: - - %s [extra_args] - -\"candidate_file\" will be added at \"%s\" and the command will look at this: - - candidate_file [extra_args] - -**** Use placeholders in extra arguments - -placeholder for file without extension: \\@ -placeholder for incremental number: \\# - -\"candidate_file\" will be added at \"%s\" and \\@ but without extension. - - - -\"candidate_file\" will be added at \"%s\" and \\# will be replaced by an incremental number. - - %s \\# - -Here examples: - -Say you want to use the =convert= command to convert all your .png files in a directory to .jpg. - -This will convert all your files to jpg keeping the same basename. - - convert %s \\@.jpg - -This will convert all your files to foo-001.jpg, foo-002.jpg etc... - - convert %s foo-\\#.jpg - -You can of course combine both placeholders if needed. - - convert %s \\@-\\#.jpg - -*** Specify marked files as arguments - -When you have marked files and your command support only one file -as arg, helm will execute command sequencially on each file like -this: - -Example: - - file1 - file2 - ...etc - -When you have marked files and your command accept many files at -once helm will run your command with all files at once like this: - -Example: - - file1 file2 etc... - -The two use case above are applied automatically by Helm -depending if your command is an eshell alias which value ends by -'$1' or '$*'. If your command is not an alias, i.e. you entered -an arbitrary command on prompt with '%s' to specify filenames, -you will have to pass one prefix argument from the command -selection buffer. - -Note: This does not work on remote files. - -With two prefix-args the output is printed to the -`current-buffer', the command being executed in the same -conditions as described above. -NOTE: If your command is not an alias, you can't pass all files at once and print in current buffer at the same time. -Also note that running multiple files at once is not supported with remote files. - -*** Run eshell commands asynchronously - -You can run your commands asynchronously by adding \"&\" at end -of any commands, e.g. \"foo %s &\". You can also directly setup -your alias in the eshell alias file with e.g. \"alias foo $1 &\". - -** Commands -\\") - -;;; Ido virtual buffer help -;; -;; -(defvar helm-buffers-ido-virtual-help-message - "* Helm Ido virtual buffers - -** Commands -\\ -|Keys|Description -|-----------+----------| -|\\[helm-ff-run-switch-other-window]|Switch to other window. -|\\[helm-ff-run-switch-other-frame]|Switch to other frame. -|\\[helm-ff-run-grep]|Grep file. -|\\[helm-ff-run-zgrep]|Zgrep file. -|\\[helm-ff-run-delete-file]|Delete file. -|\\[helm-ff-run-open-file-externally]|Open file externally.") - -;;; helm-occur help -;; -;; -(defvar helm-moccur-help-message - "* Helm Moccur - -** Tips - -*** Searching in many buffers - -Start from `helm-buffers-list' or `helm-mini', mark some buffers and hit \\\\[helm-execute-persistent-action]' (persistent-action), to do it repeatedly -you can use `\\\\[helm-follow-action-forward]' and `\\\\[helm-follow-action-backward]' or enable `helm-follow-mode' with `\\\\[helm-follow-mode]'. -Follow mode is enabled by default in helm-occur. - -*** Switch to buffer in other window - -The command \\\\[helm-moccur-run-goto-line-ow] allow you to switch to buffer -in other window horizontally or vertically if a prefix arg is supplied. - -*** Save the results - -Similarly to Helm-grep, you can save the results with `\\\\[helm-occur-run-save-buffer]'. -Once in the saved buffer, you can edit it, see [[Edit a saved buffer][below]]. - -Of course if you don't save the results, you can resume the Helm session with -`helm-resume'. - -*** Refresh the resumed session - -When the buffer(s) where you ran helm-(m)occur get(s) modified, the Helm buffer -will flash red as a warning. You can refresh the buffer by running `\\\\[helm-refresh]'. -This can be done automatically by customizing `helm-moccur-auto-update-on-resume'. - -*** Refresh a saved buffer - -Type `g' to update (revert) the buffer. - -When you are running `next-error' from elsewhere, you can update -the buffer with `helm-revert-next-error-last-buffer' (up to you -to bind it to a convenient key). - -*** Edit a saved buffer - -First, install wgrep (https://github.com/mhayashi1120/Emacs-wgrep) and then: - -1) `C-c C-p' (`wgrep-change-to-wgrep-mode') to edit the buffer(s). -2) `C-x C-s' to save your changes. - -Tip: Use the excellent iedit (https://github.com/victorhge/iedit) to modify all -occurences at once in the buffer. - -NOTE: `next-error' is available from this `helm-occur-mode' buffer. - -*** Search in region - -When searching in current-buffer with `helm-occur', if a region -is found helm will search in this region only. If you marked -this region with `mark-defun' the symbol that was at point before -marking defun will be used when `helm-source-occur' is member of -`helm-sources-using-default-as-input'. - -*** Switch to next or previous source - -See [[Moving in `helm-buffer'][Moving in `helm-buffer']]. - -** Commands -\\ -|Keys|Description -|-----------+----------| -|\\[helm-occur-run-goto-line-ow]|Go to line in other window. -|\\[helm-occur-run-goto-line-of]|Go to line in new frame. -|\\[helm-occur-run-save-buffer]|Save results in new buffer.") -;;; Helm Top -;; -;; -(defvar helm-top-help-message - "* Helm Top - -** Tips - -*** Auto update - -You can enable auto updating in `helm-top' by turning on -`helm-top-poll-mode' either interactively or in your init file -with (helm-top-poll-mode 1). -Calling `helm-top' with a prefix arg also toggle auto updating. - -** Commands -\\ -|Keys|Description -|-----------+----------| -|\\[helm-top-run-sort-by-com]|Sort by commands. -|\\[helm-top-run-sort-by-cpu]|Sort by CPU usage. -|\\[helm-top-run-sort-by-user]|Sort alphabetically by user. -|\\[helm-top-run-sort-by-mem]|Sort by memory.") - -;;; Helm M-x -;; -;; -(defvar helm-M-x-help-message - "* Helm M-x - -** Tips - -*** Display docstring without quitting session (persistent action) - -You can get help on any command with persistent action (\\\\[helm-execute-persistent-action]) - -*** Display short docstring in helm buffer - -You can toggle short docstring description with \\\\[helm-M-x-toggle-short-doc]. -if you want this at startup you can configure `helm-M-x-show-short-doc'. - -NOTE: helm-M-x will be slower with this enabled. - -*** History source - -Helm-M-x is displaying two sources, one for the commands -themselves and one for the command history, more exactly -`extended-command-history', by default the history source is -displayed in first position, however you can put it in second -position if you don't like that by customizing -`helm-M-x-reverse-history'. - -**** Duplicate entries in helm-M-x history - -helm-M-x history obey to history variables, if you have -duplicates in your helm-M-x history set `history-delete-duplicates' to non nil. - -**** Number of entries in history - -The number of entries saved is controlled by `history-length' -global value, however if you want a different value for -`extended-command-history' e.g. 50 you can add to your config: - - (put 'extended-command-history 'history-length 50) - -*** Enabled modes are highlighted in helm-M-x - -*** Prefix arguments - -You can pass prefix arguments *after* starting `helm-M-x'. A mode-line -counter will display the number of given prefix arguments. - -If you pass prefix arguments before running `helm-M-x', it will -be displayed in the prompt. -The first `\\\\[universal-argument]' after `helm-M-x' clears those prefix arguments. - -NOTE: When you specify prefix arguments once `helm-M-x' is -started, the prefix argument apply on the next command, so if you -hit RET, it will apply on the selected command, but if you type a -new character at prompt to narrow down further candidates, the -prefix arg will apply to `self-insert-command' (e.g. if you type -`C-u e' \"eeee\" will be inserted in prompt) so select the -command you want to execute before specifying prefix arg. - -** Commands -\\ -|Keys|Description -|-----------+------------| -|\\[helm-M-x-universal-argument]|Universal argument for selected command -|\\[helm-M-x-toggle-short-doc]|Toggle details on commands") - - -;;; Helm imenu -;; -;; -(defvar helm-imenu-help-message - "* Helm Imenu - -** Commands -\\ -|Keys|Description -|-----------+----------| -|\\[helm-imenu-next-section]|Go to next section. -|\\[helm-imenu-previous-section]|Go to previous section.") - -;;; Helm colors -;; -;; -(defvar helm-colors-help-message - "* Helm colors - -** Commands -\\ -|Keys|Description -|-----------+----------| -|\\[helm-color-run-insert-name]|Insert the entry name. -|\\[helm-color-run-kill-name]|Kill the entry name. -|\\[helm-color-run-insert-rgb]|Insert entry in RGB format. -|\\[helm-color-run-kill-rgb]|Kill entry in RGB format.") - -;;; Helm Semantic -;; -;; -(defvar helm-semantic-help-message - "* Helm Semantic - -** Commands -\\") - -;;; Helm kmacro -;; -;; -(defvar helm-kmacro-help-message - "* Helm kmacro - -** Tips - -- Start recording a kmacro with `f3'. -- End the kmacro recording with `f4'. -- Run `helm-execute-kmacro' to list all your kmacros. - -When you press RET, your macro goes on top of ring and become the -current macro, hit `f4' for further executions. -Use `helm-execute-kmacro' again to change eventually your macro to execute. - -Note: You can't record keys running Helm commands except `helm-M-x', under the -condition that you don't choose a command using Helm completion. - -See [[info:emacs#Keyboard Macros][Keyboard Macros]] for further infos on macros. - -** Commands -\\") - -;;; Kill ring -;; -;; -(defvar helm-kill-ring-help-message - "* Helm kill ring - -** Tips - -Every Helm session lets you save a candidate to the kill-ring / clipboard / -primary-selection with `\\\\[helm-kill-selection-and-quit]'. - -To save space, Helm-kill-ring truncates the candidates longer than -`helm-kill-ring-max-offset'. -`\\\\[helm-kill-ring-kill-selection]' then saves the whole -text and not the truncated value. The view of truncated candidates can be -toggled; see the command list below. - -As opposed to `yank', numeric prefix arguments are ignored with -`helm-show-kill-ring': there is no need for them since selection happens within -Helm. Moreover Helm has [[Shortcuts for executing the default action on the n-th candidate][Shortcuts for executing the default action on the n-th candidate]]. - -It is recommended to globally bind `M-y' to `helm-show-kill-ring'. Once in the -Helm-kill-ring session you can navigate to next/previous line with `M-y' and -`M-u' for convenience. Of course `\\[helm-next-line]' and `\\[helm-previous-line]' are still available. - -It is possible to delete candidates from the kill ring with `\\\\[helm-kill-ring-delete]' -but also persistently with `\\\\[helm-kill-ring-run-persistent-delete]'. - -You can concatenate marked candidates and yank them in the current -buffer, thus creating a new entry in the kill ring. Candidates are -concatenated with `helm-kill-ring-separator' as default but you can -change interactively the separator while yanking by using two prefix -args. When you have something else than \"\\n\" as default value for -`helm-kill-ring-separator' and you want to use \"\\n\" from prompt, use -`C-q C-j' to enter a newline in prompt. - -To not push a new entry in the kill ring, use `\\\\[helm-copy-to-buffer]' instead of RET -\(note that you can't change separator with this). - -When inserting candidates with the default action (`RET'), `point' is placed at -the end of the candidate and `mark' at the beginning. You can revert this behavior -by using a prefix argument, i.e. `C-u RET', like the regular `yank' command does. - -** Commands -\\ -|Keys|Description -|-----------+----------| -|\\[helm-next-line]|Next line. -|\\[helm-previous-line]|Previous line. -|\\[helm-kill-ring-delete]|Delete entry. -|\\[helm-kill-ring-toggle-truncated]|Toggle truncated view of candidate. -|\\[helm-kill-ring-kill-selection]|Kill non-truncated of selection.") - -;;; Completing-read -;; -(defun helm-comp-read-help-message () - (let ((com (assoc-default 'name (helm-get-current-source)))) - (format - "* Helm completing-read completion for `%s' - -Command `%s' is using a `completing-read' for completion on your input, -this completion have been \"helmized\" because you have enabled [[Helm mode][helm-mode]]'. - -** Tips - -*** Disabling or use something else than helm for completion of some commands - -You can disable helm completion or use something else for specific commands of your choice, -for this customize variable `helm-completing-read-handlers-alist'. - -*** Exiting minibuffer with empty string - -You can exit minibuffer with empty string with \\\\[helm-cr-empty-string]. -It is useful when some commands are prompting continuously until you enter an empty prompt. - -** Commands -\\ -|Keys|Description -|-----------+----------| -|\\[helm-cr-empty-string]|Exit minibuffer with empty string." - com com))) - - -;;; Mode line strings -;; -;; -;;;###autoload -(defvar helm-comp-read-mode-line "\ -\\\ -C/\\[helm-cr-empty-string]:Empty \ -\\\ -\\[helm-help]:Help \ -\\[helm-select-action]:Act \ -\\[helm-maybe-exit-minibuffer]/\ -f1/f2/f-n:NthAct \ -\\[helm-toggle-suspend-update]:Tog.suspend \ -\\[helm-customize-group]:Conf") - -;;;###autoload -(defvar helm-read-file-name-mode-line-string "\ -\\\ -\\[helm-help]:Help \ -C/\\[helm-cr-empty-string]:Empty \ -\\\ -\\[helm-select-action]:Act \ -\\[helm-maybe-exit-minibuffer]/\ -f1/f2/f-n:NthAct \ -\\[helm-toggle-suspend-update]:Tog.suspend \ -\\[helm-customize-group]:Conf" - "String displayed in mode-line in `helm-source-find-files'.") - -;;;###autoload -(defvar helm-top-mode-line "\ -\\\ -\\[helm-help]:Help \ -\\\ -\\[helm-select-action]:Act \ -\\[helm-maybe-exit-minibuffer]/\ -f1/f2/f-n:NthAct \ -\\[helm-toggle-suspend-update]:Tog.suspend \ -\\[helm-customize-group]:Conf") - - -(provide 'helm-help) - -;;; helm-help.el ends here diff --git a/elpa/helm-20251212.555/helm-id-utils.el b/elpa/helm-20251212.555/helm-id-utils.el deleted file mode 100644 index e62fe5d7..00000000 --- a/elpa/helm-20251212.555/helm-id-utils.el +++ /dev/null @@ -1,127 +0,0 @@ -;;; helm-id-utils.el --- Helm interface for id-utils. -*- lexical-binding: t -*- - -;; Copyright (C) 2015 ~ 2025 Thierry Volpiatto - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Code: - -(require 'helm-grep) -(require 'helm-help) - -(defgroup helm-id-utils nil - "ID-Utils related Applications and libraries for Helm." - :group 'helm) - -(defcustom helm-gid-program "gid" - "Name of gid command (usually `gid'). -For Mac OS X users, if you install GNU coreutils, the name `gid' -might be occupied by `id' from GNU coreutils, and you should set -it to correct name (or absolute path). For example, if using -MacPorts to install id-utils, it should be `gid32'." - :group 'helm-id-utils - :type 'file) - -(defcustom helm-gid-db-file-name "ID" - "Name of a database file created by `mkid' command from `ID-utils'." - :group 'helm-id-utils - :type 'string) - -(defun helm-gid-candidates-process () - (let* ((patterns (helm-mm-split-pattern helm-pattern)) - (default-com (format "%s -r %s" helm-gid-program - (shell-quote-argument (car patterns)))) - (cmd (helm-aif (cdr patterns) - (concat default-com - (cl-loop for p in it - concat (format " | grep --color=always %s" - (shell-quote-argument p)))) - default-com)) - (start-time (float-time)) - (proc (start-process-shell-command - "gid" helm-buffer cmd))) - (set (make-local-variable 'helm-grep-last-cmd-line) cmd) - (prog1 proc - (set-process-sentinel - proc (lambda (process event) - (when (or (string= event "finished\n") - (process-get process 'reach-limit)) - (helm-maybe-show-popup-tip-info) - (with-helm-window - (setq mode-line-format - `(" " mode-line-buffer-identification " " - (:eval (format "L%s" (helm-candidate-number-at-point))) " " - (:eval (propertize - (format "[%s process finished in %.2fs - (%s results)] " - ,(upcase (process-name process)) - ,(- (float-time) start-time) - (helm-get-candidate-number)) - 'face 'helm-locate-finish)))) - (force-mode-line-update)) - (helm-log "helm-gid-candidates-process" "Error: Gid %s" - (replace-regexp-in-string "\n" "" event)))))))) - -(defun helm-gid-filtered-candidate-transformer (candidates _source) - ;; "gid -r" may add dups in some rare cases. - (cl-loop for c in (helm-fast-remove-dups candidates :test 'equal) - collect (helm-grep--filter-candidate-1 c))) - -(defclass helm-gid-source (helm-source-async) - ((header-name - :initform - (lambda (name) - (concat name " [" (helm-get-attr 'db-dir) "]"))) - (db-dir :initarg :db-dir - :initform nil - :custom string - :documentation " Location of ID file.") - (candidates-process :initform #'helm-gid-candidates-process) - (filtered-candidate-transformer - :initform #'helm-gid-filtered-candidate-transformer) - (popup-info :initform #'helm-grep-popup-info-fn) - (action :initform (helm-make-actions - "Find File" 'helm-grep-action - "Find file other frame" 'helm-grep-other-frame - "Save results in grep buffer" 'helm-grep-save-results - "Find file other window" 'helm-grep-other-window)) - (persistent-action :initform 'helm-grep-persistent-action) - (history :initform 'helm-grep-history) - (nohighlight :initform t) - (help-message :initform 'helm-grep-help-message) - (requires-pattern :initform 2))) - -;;;###autoload -(defun helm-gid () - "Preconfigured `helm' for `gid' command line of `ID-Utils'. -Need A database created with the command `mkid' above -`default-directory'. -Need id-utils as dependency which provide `mkid', `gid' etc.. -See ." - (interactive) - (let* ((db (locate-dominating-file - default-directory - helm-gid-db-file-name)) - (helm-grep-default-directory-fn - (lambda () default-directory)) - (helm-maybe-use-default-as-input t)) - (cl-assert db nil "No DataBase found, create one with `mkid'") - (helm :sources (helm-make-source "Gid" 'helm-gid-source - :db-dir db) - :buffer "*helm gid*" - :keymap helm-grep-map - :truncate-lines helm-grep-truncate-lines))) - -(provide 'helm-id-utils) - -;;; helm-id-utils ends here diff --git a/elpa/helm-20251212.555/helm-imenu.el b/elpa/helm-20251212.555/helm-imenu.el deleted file mode 100644 index 07826c5f..00000000 --- a/elpa/helm-20251212.555/helm-imenu.el +++ /dev/null @@ -1,541 +0,0 @@ -;;; helm-imenu.el --- Helm interface for Imenu -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2025 Thierry Volpiatto - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Code: - -(require 'cl-lib) -(require 'helm) -(require 'helm-lib) -(require 'imenu) -(require 'helm-utils) -(require 'helm-help) -(require 'helm-x-icons) - -(defvar all-the-icons-default-adjust) -(defvar all-the-icons-scale-factor) -(defvar nerd-icons-default-adjust) -(defvar nerd-icons-scale-factor) - -(declare-function which-function "which-func") - - -(defgroup helm-imenu nil - "Imenu related libraries and applications for Helm." - :group 'helm) - -(defcustom helm-imenu-delimiter " / " - "Delimit types of candidates and their value in `helm-buffer'." - :group 'helm-imenu - :type 'string) - -(defcustom helm-imenu-execute-action-at-once-if-one - #'helm-imenu--execute-action-at-once-p - "Goto the candidate when only one is remaining." - :group 'helm-imenu - :type 'function) - -(defcustom helm-imenu-all-buffer-assoc nil - "Major mode association alist for `helm-imenu-in-all-buffers'. -Allow `helm-imenu-in-all-buffers' searching in these associated -buffers even if they are not derived from each other. The alist -is bidirectional, i.e. no need to add \\='((foo . bar) (bar . foo)), -only \\='((foo . bar)) is needed." - :type '(alist :key-type symbol :value-type symbol) - :group 'helm-imenu) - -(defcustom helm-imenu-in-all-buffers-separate-sources t - "Display imenu index of each buffer in its own source when non-nil. - -When nil all candidates are displayed in a single source. - -NOTE: Each source will have as name \"Imenu \". -`helm-source-imenu-all' will not be set, however it will continue -to be used as a flag for using default as input. If you do not -want this behavior, remove it from -`helm-sources-using-default-as-input' even if not using a single -source to display imenu in all buffers." - :type 'boolean - :group 'helm-imenu) - -(defcustom helm-imenu-type-faces - '(("^Variables$" . font-lock-variable-name-face) - ("^\\(Function\\|Functions\\|Defuns\\)$" . font-lock-function-name-face) - ("^\\(Types\\|Provides\\|Requires\\|Classes\\|Class\\|Includes\\|Imports\\|Misc\\|Code\\)$" . font-lock-type-face)) - "Faces for showing type in helm-imenu. -This is a list of cons cells. The cdr of each cell is a face to -be used, and it can also just be like \\='(:foreground -\"yellow\"). Each car is a regexp match pattern of the imenu type -string." - :group 'helm-faces - :type '(repeat - (cons - (regexp :tag "Imenu type regexp pattern") - (sexp :tag "Face")))) - -(defcustom helm-imenu-extra-modes nil - "Extra modes where `helm-imenu-in-all-buffers' should look into." - :group 'helm-imenu - :type '(repeat symbol)) - -(defcustom helm-imenu-hide-item-type-name nil - "Hide display name of imenu item type along with the icon when non nil. - -This value can be toggled with \\\\[helm-imenu-toggle-type-view]. -Don't use `setq' to set this." - :group 'helm-imenu - :type 'boolean - :set (lambda (var val) - (if (require helm-x-icons-provider nil t) - (set var val) - (set var nil)))) - -(defcustom helm-imenu-use-icon nil - "Display an icon from `helm-x-icons-provider' package when non nil. - -Don't use `setq' to set this." - :group 'helm-imenu - :type 'boolean - :set (lambda (var val) - (set var (and (require helm-x-icons-provider nil t) val)))) - -(defcustom helm-imenu-icon-type-alist - '(("Array" . (helm-x-icons-generic "crop" :face font-lock-builtin-face)) - ("Arrays" . (helm-x-icons-generic "crop" :face font-lock-builtin-face)) - ("Boolean" . (helm-x-icons-generic "crop" :face font-lock-builtin-face)) - ("Booleans" . (helm-x-icons-generic "crop" :face font-lock-builtin-face)) - ("Class" . (helm-x-icons-generic "package" :face font-lock-type-face)) - ("Classes" . (helm-x-icons-generic "package" :face font-lock-type-face)) - ("Color" . (helm-x-icons-generic "color_lens" :face font-lock-builtin-face)) - ("Colors" . (helm-x-icons-generic "color_lens" :face font-lock-builtin-face)) - ("Constant" . (helm-x-icons-generic "crop" :face font-lock-builtin-face)) - ("Constants" . (helm-x-icons-generic "crop" :face font-lock-builtin-face)) - ("Constructor" . (helm-x-icons-generic "cube" :face font-lock-function-name-face)) - ("Constructors" . (helm-x-icons-generic "cube" :face font-lock-function-name-face)) - ("Enum Member" . (helm-x-icons-generic "three-bars" :face font-lock-type-face)) - ("Enum Members" . (helm-x-icons-generic "three-bars" :face font-lock-type-face)) - ("Enum" . (helm-x-icons-generic "cog" :face font-lock-type-face)) - ("Enums" . (helm-x-icons-generic "cog" :face font-lock-type-face)) - ("Event" . (helm-x-icons-generic "lightning" :face font-lock-builtin-face)) - ("Events" . (helm-x-icons-generic "lightning" :face font-lock-builtin-face)) - ("Field" . (helm-x-icons-generic "three-bars" :face font-lock-type-face)) - ("Fields" . (helm-x-icons-generic "three-bars" :face font-lock-type-face)) - ("File" . (helm-x-icons-generic "file" :face font-lock-variable-name-face)) - ("Files" . (helm-x-icons-generic "file" :face font-lock-variable-name-face)) - ("Folder" . (helm-x-icons-generic "folder" :face font-lock-variable-name-face)) - ("Folders" . (helm-x-icons-generic "folder" :face font-lock-variable-name-face)) - ("Interface" . (helm-x-icons-generic "package" :face font-lock-builtin-face)) - ("Interfaces" . (helm-x-icons-generic "package" :face font-lock-builtin-face)) - ("Keyword" . (helm-x-icons-generic "key" :face font-lock-builtin-face)) - ("Keywords" . (helm-x-icons-generic "key" :face font-lock-builtin-face)) - ("Method" . (helm-x-icons-generic "cube" :face font-lock-function-name-face)) - ("Methods" . (helm-x-icons-generic "cube" :face font-lock-function-name-face)) - ("Defun" . (helm-x-icons-generic "cube" :face font-lock-function-name-face)) - ("Defuns" . (helm-x-icons-generic "cube" :face font-lock-function-name-face)) - ("Fn" . (helm-x-icons-generic "cube" :face font-lock-function-name-face)) - ("Fns" . (helm-x-icons-generic "cube" :face font-lock-function-name-face)) - ("Function" . (helm-x-icons-generic "cube" :face font-lock-function-name-face)) - ("Functions" . (helm-x-icons-generic "cube" :face font-lock-function-name-face)) - ("Misc" . (helm-x-icons-generic "globe" :face font-lock-function-name-face)) - ("Miscs" . (helm-x-icons-generic "globe" :face font-lock-function-name-face)) - ("Module" . (helm-x-icons-generic "angle-double-right" :face font-lock-builtin-face)) - ("Modules" . (helm-x-icons-generic "angle-double-right" :face font-lock-builtin-face)) - ("Numeric" . (helm-x-icons-generic "crop" :face font-lock-builtin-face)) - ("Numerics" . (helm-x-icons-generic "crop" :face font-lock-builtin-face)) - ("Object" . (helm-x-icons-generic "angle-double-right" :face font-lock-builtin-face)) - ("Objects" . (helm-x-icons-generic "angle-double-right" :face font-lock-builtin-face)) - ("Operator" . (helm-x-icons-generic "calculator" :face font-lock-builtin-face)) - ("Operators" . (helm-x-icons-generic "calculator" :face font-lock-builtin-face)) - ("Property" . (helm-x-icons-generic "book" :face font-lock-variable-name-face)) - ("Properties" . (helm-x-icons-generic "book" :face font-lock-variable-name-face)) - ("Reference" . (helm-x-icons-generic "book" :face font-lock-variable-name-face)) - ("References" . (helm-x-icons-generic "book" :face font-lock-variable-name-face)) - ("Snippet" . (helm-x-icons-generic "border_style" :face font-lock-variable-name-face)) - ("Snippets" . (helm-x-icons-generic "border_style" :face font-lock-variable-name-face)) - ("String" . (helm-x-icons-generic "text_fields" :face font-lock-variable-name-face)) - ("Strings" . (helm-x-icons-generic "text_fields" :face font-lock-variable-name-face)) - ("Struct" . (helm-x-icons-generic "cog" :face font-lock-type-face)) - ("Structs" . (helm-x-icons-generic "cog" :face font-lock-type-face)) - ("Text" . (helm-x-icons-generic "text_fields" :face font-lock-variable-name-face)) - ("Texts" . (helm-x-icons-generic "text_fields" :face font-lock-variable-name-face)) - ("Top level" . (helm-x-icons-generic "globe" :face font-lock-function-name-face)) - ("Trait" . (helm-x-icons-generic "package" :face font-lock-builtin-face)) - ("Traits" . (helm-x-icons-generic "package" :face font-lock-builtin-face)) - ("Type" . (helm-x-icons-generic "cog" :face font-lock-type-face)) - ("Types" . (helm-x-icons-generic "cog" :face font-lock-type-face)) - ("Type Parameter" . (helm-x-icons-generic "code" :face font-lock-type-face)) - ("Type Parameters" . (helm-x-icons-generic "code" :face font-lock-type-face)) - ("Unit" . (helm-x-icons-generic "bar-chart" :face font-lock-builtin-face)) - ("Units" . (helm-x-icons-generic "bar-chart" :face font-lock-builtin-face)) - ("Value" . (helm-x-icons-generic "cog" :face font-lock-type-face)) - ("Values" . (helm-x-icons-generic "cog" :face font-lock-type-face)) - ("Variable" . (helm-x-icons-generic "book" :face font-lock-variable-name-face)) - ("Variables" . (helm-x-icons-generic "book":face font-lock-variable-name-face))) - "An alist of types associated with a sexp returning an icon. -The sexp should be an `all-the-icons' function with its args." - :type '(alist :key-type string :value-type sexp) - :group 'helm-imenu) - -(defcustom helm-imenu-default-type-sexp - '(helm-x-icons-generic "globe" :face font-lock-function-name-face) - "Default sexp to use when no type for an object is found." - :type 'sexp - :group 'helm-imenu) - -;;; keymap -(defvar helm-imenu-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-map) - (define-key map (kbd "M-") 'helm-imenu-next-section) - (define-key map (kbd "M-") 'helm-imenu-previous-section) - (define-key map (kbd "C-]") 'helm-imenu-toggle-type-view) - map)) - -(defun helm-imenu-toggle-type-view () - "Toggle candidate type view." - (interactive) - (with-helm-window - (setq helm-imenu-hide-item-type-name (not helm-imenu-hide-item-type-name)) - (let* ((sel (substring (helm-get-selection nil 'withprop) - (if helm-imenu-use-icon 2 0))) - (type (get-text-property 1 'type-name sel))) - (setq sel (substring-no-properties sel)) - (helm-force-update (if helm-imenu-hide-item-type-name - (format "^[ ]*%s$" - (car (last (split-string - sel helm-imenu-delimiter t)))) - (format "^[ ]*%s / %s$" - type sel)))))) -(put 'helm-imenu-toggle-type-view 'no-helm-mx t) - -(defcustom helm-imenu-lynx-style-map nil - "Use Arrow keys to jump to occurences." - :group 'helm-imenu - :type 'boolean - :set (lambda (var val) - (set var val) - (if val - (progn - (define-key helm-imenu-map (kbd "") 'helm-execute-persistent-action) - (define-key helm-imenu-map (kbd "") 'helm-maybe-exit-minibuffer)) - (define-key helm-imenu-map (kbd "") nil) - (define-key helm-imenu-map (kbd "") nil)))) - -(defun helm-imenu-next-or-previous-section (n) - (with-helm-window - (let* ((fn (lambda () - (let ((str (buffer-substring - (pos-bol) (pos-eol)))) - (if helm-imenu-hide-item-type-name - (get-text-property 1 'type-name str) - (car (split-string str helm-imenu-delimiter)))))) - (curtype (funcall fn)) - (stop-fn (if (> n 0) - #'helm-end-of-source-p - #'helm-beginning-of-source-p))) - (while (and (not (funcall stop-fn)) - (string= curtype (funcall fn))) - (forward-line n)) - (helm-mark-current-line) - (helm-follow-execute-persistent-action-maybe)))) - -(defun helm-imenu-next-section () - (interactive) - (helm-imenu-next-or-previous-section 1)) - -(defun helm-imenu-previous-section () - (interactive) - (helm-imenu-next-or-previous-section -1)) - - -;;; Internals -(defvar helm-cached-imenu-alist nil) -(make-variable-buffer-local 'helm-cached-imenu-alist) - -(defvar helm-cached-imenu-candidates nil) -(make-variable-buffer-local 'helm-cached-imenu-candidates) - -(defvar helm-cached-imenu-tick nil) -(make-variable-buffer-local 'helm-cached-imenu-tick) - -(defvar helm-imenu--in-all-buffers-cache nil) - - -(defvar helm-source-imenu nil "See (info \"(emacs)Imenu\")") -(defvar helm-source-imenu-all nil) - -(defclass helm-imenu-source (helm-source-sync) - ((candidates :initform 'helm-imenu-candidates) - (candidate-transformer :initform 'helm-imenu-transformer) - (persistent-action :initform 'helm-imenu-persistent-action) - (persistent-help :initform "Show this entry") - (nomark :initform t) - (keymap :initform 'helm-imenu-map) - (help-message :initform 'helm-imenu-help-message) - (action :initform 'helm-imenu-action) - (find-file-target :initform #'helm-imenu-quit-and-find-file-fn) - (group :initform 'helm-imenu))) - -(defcustom helm-imenu-fuzzy-match nil - "Enable fuzzy matching in `helm-source-imenu'." - :group 'helm-imenu - :type 'boolean - :set (lambda (var val) - (set var val) - (setq helm-source-imenu - (helm-make-source "Imenu" 'helm-imenu-source - :fuzzy-match helm-imenu-fuzzy-match)))) - -(defun helm-imenu--maybe-switch-to-buffer (candidate) - (let ((cand (cdr candidate))) - (helm-aif (and (markerp cand) (marker-buffer cand)) - (helm-buffers-switch-to-buffer-or-tab it)))) - -(defun helm-imenu--execute-action-at-once-p () - (let ((cur (helm-get-selection)) - (mb (with-helm-current-buffer - (save-excursion - (goto-char (pos-bol)) - (point-marker))))) - ;; Happen when cursor is on the line where a definition is. This - ;; prevent jumping to the definition where we are already, instead - ;; display helm with all definitions and preselection to the place - ;; we already are. - (if (equal (cdr cur) mb) - (prog1 nil - (helm-set-pattern "") - (helm-force-update - (concat "\\_<" (regexp-quote (car cur)) "\\_>"))) - t))) - -(defun helm-imenu-quit-and-find-file-fn (source) - (let ((sel (helm-get-selection nil nil source))) - (when (and (consp sel) (markerp (cdr sel))) - (buffer-file-name (marker-buffer (cdr sel)))))) - -(defun helm-imenu-action (candidate) - "Default action for `helm-source-imenu'." - (helm-log-run-hook "helm-imenu-action" 'helm-goto-line-before-hook) - (helm-imenu--maybe-switch-to-buffer candidate) - (imenu candidate) - ;; If semantic is supported in this buffer - ;; imenu used `semantic-imenu-goto-function' - ;; and position have been highlighted, - ;; no need to highlight again. - (unless (eq imenu-default-goto-function - 'semantic-imenu-goto-function) - (helm-highlight-current-line))) - -(defun helm-imenu-persistent-action (candidate) - "Default persistent action for `helm-source-imenu'." - (helm-imenu--maybe-switch-to-buffer candidate) - (imenu candidate) - (helm-highlight-current-line)) - -(defun helm-imenu-candidates (&optional buffer) - (with-current-buffer (or buffer helm-current-buffer) - (let ((tick (buffer-modified-tick))) - (if (eq helm-cached-imenu-tick tick) - helm-cached-imenu-candidates - (setq imenu--index-alist nil) - (prog1 (setq helm-cached-imenu-candidates - (let ((index (imenu--make-index-alist t))) - (helm-imenu--candidates-1 - (delete (assoc "*Rescan*" index) index)))) - (setq helm-cached-imenu-tick tick)))))) - -(defun helm-imenu-candidates-in-all-buffers (&optional build-sources) - (let* ((lst (buffer-list)) - (progress-reporter (make-progress-reporter - "Imenu indexing buffers..." 1 (length lst)))) - (prog1 - (cl-loop with cur-buf = (if build-sources - (current-buffer) helm-current-buffer) - for b in lst - for count from 1 - when (with-current-buffer b - (and (or (member major-mode helm-imenu-extra-modes) - (derived-mode-p 'prog-mode)) - (helm-same-major-mode-p - cur-buf helm-imenu-all-buffer-assoc))) - if build-sources - collect (helm-make-source - (format "Imenu in %s" (buffer-name b)) - 'helm-imenu-source - :candidates (with-current-buffer b - (helm-imenu-candidates b)) - :fuzzy-match helm-imenu-fuzzy-match) - else - append (with-current-buffer b - (helm-imenu-candidates b)) - do (progress-reporter-update progress-reporter count)) - (progress-reporter-done progress-reporter)))) - -(defun helm-imenu--candidates-1 (alist) - (cl-loop for elm in alist - nconc (cond - ((imenu--subalist-p elm) - (helm-imenu--candidates-1 - (cl-loop for (e . v) in (cdr elm) collect - (cons (propertize - e 'helm-imenu-type (car elm)) - ;; If value is an integer, convert it - ;; to a marker, otherwise it is a cons cell - ;; and it will be converted on next recursions. - ;; (Bug#1060) [1]. - (if (integerp v) (copy-marker v) v))))) - ((listp (cdr elm)) - (and elm (list elm))) - (t - ;; bug in imenu, should not be needed. - (and (cdr elm) - ;; Semantic uses overlays whereas imenu uses - ;; markers (Bug#1706). - (setcdr elm (helm-acase (cdr elm) ; Same as [1]. - ((guard* (overlayp it)) - (copy-overlay it)) - ((guard* (or (markerp it) (integerp it))) - (copy-marker it)))) - (list elm)))))) - -(defun helm-imenu--get-prop (item) - ;; property value of ITEM can have itself - ;; a property value which have itself a property value - ;; ...and so on; Return a list of all these - ;; properties values starting at ITEM. - (let* ((prop (get-text-property 0 'helm-imenu-type item)) - (lst (list prop item))) - (when prop - (while prop - (setq prop (get-text-property 0 'helm-imenu-type prop)) - (and prop (push prop lst))) - lst))) - -(defun helm-imenu-icon-for-type (type) - "Return an icon for type TYPE. -The icon is found in `helm-imenu-icon-type-alist', if not -`helm-imenu-default-type-sexp' is evaled to provide a default icon." - (let ((all-the-icons-scale-factor 1.0) - (all-the-icons-default-adjust 0.0) - (nerd-icons-scale-factor 1.0) - (nerd-icons-default-adjust 0.0)) - (or (helm-aand (assoc-default type helm-imenu-icon-type-alist) - (apply (car it) (cdr it))) - (apply (car helm-imenu-default-type-sexp) - (cdr helm-imenu-default-type-sexp))))) - -(defun helm-imenu-transformer (candidates) - (cl-loop for (k . v) in candidates - ;; (k . v) == (symbol-name . marker) - for bufname = (buffer-name - (helm-acase v - ((guard* (overlayp it)) (overlay-buffer it)) - ((guard* (markerp it)) (marker-buffer it)))) - for types = (or (helm-imenu--get-prop k) - (list (if (with-current-buffer bufname - (derived-mode-p 'prog-mode)) - "Function" - "Top level") - k)) - for type-icon = (and helm-imenu-use-icon - (helm-imenu-icon-for-type (car types))) - for type-name = (propertize - (car types) 'face - (cl-loop for (p . f) in helm-imenu-type-faces - when (string-match p (car types)) - return f - finally return 'default)) - for disp1 = (mapconcat 'identity - (cdr types) - (propertize helm-imenu-delimiter - 'face 'shadow)) - for disp = (concat (if helm-imenu-use-icon - (concat (propertize " " 'display type-icon) " ") - "") - (if helm-imenu-hide-item-type-name - "" - (concat type-name - (propertize helm-imenu-delimiter - 'face 'shadow))) - (propertize disp1 'help-echo bufname 'types types)) - collect - (cons (propertize disp 'type-name type-name) (cons k v)))) - - -;;;###autoload -(defun helm-imenu () - "Preconfigured `helm' for `imenu'." - (interactive) - (require 'which-func) - (unless helm-source-imenu - (setq helm-source-imenu - (helm-make-source "Imenu" 'helm-imenu-source - :fuzzy-match helm-imenu-fuzzy-match))) - (let* ((imenu-auto-rescan t) - (helm-highlight-matches-around-point-max-lines 'never) - (str (thing-at-point 'symbol)) - (init-reg (and str (concat "\\_<" (regexp-quote str) "\\_>"))) - (helm-execute-action-at-once-if-one - helm-imenu-execute-action-at-once-if-one)) - (helm :sources 'helm-source-imenu - :default (and str (list init-reg str)) - :preselect (helm-aif (which-function) - (concat "\\_<" (regexp-quote it) "\\_>") - init-reg) - :buffer "*helm imenu*"))) - -;;;###autoload -(defun helm-imenu-in-all-buffers () - "Fetch Imenu entries in all buffers with similar mode as current. -A mode is similar as current if it is the same, it is derived -i.e. `derived-mode-p' or it have an association in -`helm-imenu-all-buffer-assoc'." - (interactive) - (require 'which-func) - (unless helm-imenu-in-all-buffers-separate-sources - (unless helm-source-imenu-all - (setq helm-source-imenu-all - (helm-make-source "Imenu in all buffers" 'helm-imenu-source - :init (lambda () - ;; Use a cache to avoid repeatedly sending - ;; progress-reporter message when updating - ;; (Bug#1704). - (setq helm-imenu--in-all-buffers-cache - (helm-imenu-candidates-in-all-buffers))) - :candidates 'helm-imenu--in-all-buffers-cache - :fuzzy-match helm-imenu-fuzzy-match)))) - (let* ((imenu-auto-rescan t) - (helm-highlight-matches-around-point-max-lines 'never) - (str (thing-at-point 'symbol)) - (init-reg (and str (concat "\\_<" (regexp-quote str) "\\_>"))) - (helm-execute-action-at-once-if-one - helm-imenu-execute-action-at-once-if-one) - (helm-maybe-use-default-as-input - (not (null (memq 'helm-source-imenu-all - helm-sources-using-default-as-input)))) - (sources (if helm-imenu-in-all-buffers-separate-sources - (helm-imenu-candidates-in-all-buffers 'build-sources) - '(helm-source-imenu-all)))) - (helm :sources sources - :default (and str (list init-reg str)) - :preselect (helm-aif (which-function) - (concat "\\_<" (regexp-quote it) "\\_>") - init-reg) - :buffer "*helm imenu all*"))) - -(provide 'helm-imenu) - -;;; helm-imenu.el ends here diff --git a/elpa/helm-20251212.555/helm-info.el b/elpa/helm-20251212.555/helm-info.el deleted file mode 100644 index b6575fcb..00000000 --- a/elpa/helm-20251212.555/helm-info.el +++ /dev/null @@ -1,410 +0,0 @@ -;;; helm-info.el --- Browse info index with helm -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2025 Thierry Volpiatto - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Code: - -(require 'cl-lib) -(require 'info) -;; helm-utils is requiring helm which is requiring helm-lib, but let's require -;; them explicitely anyway to make it clear what we need. helm-core is needed to -;; build all the helm-info-* commands and sources. -(require 'helm) -(require 'helm-lib) -(require 'helm-utils) ; for `helm-goto-line'. - -(declare-function Info-index-nodes "info" (&optional file)) -(declare-function Info-goto-node "info" (&optional fork)) -(declare-function Info-find-node "info" (filename nodename &optional no-going-back)) -(declare-function ring-insert "ring") -(declare-function ring-empty-p "ring") -(declare-function ring-ref "ring") -(defvar Info-history) -(defvar Info-directory-list) -(defvar helm-completions-detailed) -;; `Info-minibuf-history' is not declared in Emacs, see emacs bug/58786. -(when (and (> emacs-major-version 28) - (not (boundp 'Info-minibuf-history))) - (defvar Info-minibuf-history nil)) - - -;;; Customize - -(defgroup helm-info nil - "Info-related applications and libraries for Helm." - :group 'helm) - -(defcustom helm-info-default-sources - '(helm-source-info-elisp - helm-source-info-cl - helm-source-info-eieio - helm-source-info-pages) - "Default sources to use for looking up symbols at point in Info -files with `helm-info-at-point'." - :group 'helm-info - :type '(repeat (choice symbol))) - -;;; Build info-index sources with `helm-info-source' class. - -(defun helm-info-init (&optional file) - "Initialize candidates for info FILE. -If FILE have nodes, loop through all nodes and accumulate candidates -found in each node, otherwise scan only the current info buffer." - (unless file (setq file (helm-get-attr 'info-file))) - ;; Allow reinit candidate buffer when using edebug. - (helm-aif (and debug-on-error - (helm-candidate-buffer)) - (kill-buffer it)) - (unless (helm-candidate-buffer) - (save-window-excursion - (info file " *helm info temp buffer*") - (let ((tobuf (helm-candidate-buffer 'global)) - Info-history) - (helm-aif (Info-index-nodes) - (dolist (node it) - (Info-goto-node node) - (helm-info-scan-current-buffer tobuf)) - (helm-info-scan-current-buffer tobuf)) - (bury-buffer))))) - -(defun helm-info-scan-current-buffer (tobuf) - "Scan current info buffer and print lines to TOBUF. -Argument TOBUF is the `helm-candidate-buffer'." - (let (start end line) - (goto-char (point-min)) - (while (search-forward "\n* " nil t) - (unless (search-forward "Menu:\n" (1+ (pos-eol)) t) - (setq start (pos-bol) - ;; Fix Bug#1503 by getting the invisible - ;; info displayed on next line in long strings. - ;; e.g "* Foo.\n (line 12)" instead of - ;; "* Foo.(line 12)" - end (or (save-excursion - (goto-char (pos-bol)) - (re-search-forward "(line +[0-9]+)" nil t)) - (pos-eol)) - ;; Long string have a new line inserted before the - ;; invisible spec, remove it. - line (replace-regexp-in-string - "\n" "" (buffer-substring start end))) - (with-current-buffer tobuf - (insert line) - (insert "\n")))))) - -(defun helm-info-goto (node-line) - "The helm-info action to jump to NODE-LINE." - (require 'helm-utils) - (let ((alive (buffer-live-p (get-buffer "*info*")))) - (Info-goto-node (car node-line)) - (when alive (revert-buffer nil t)) - (helm-goto-line (cdr node-line)))) - -(defvar helm-info--node-regexp - "^\\* +\\(.+\\):[[:space:]]+\\(.*\\)\\(?:[[:space:]]*\\)(line +\\([0-9]+\\))" - "A regexp that should match file name, node name and line number in -a line like this: - -\* bind: Bash Builtins. (line 21).") - -(defun helm-info-display-to-real (line) - "Transform LINE to an acceptable argument for `info'. -If line have a node use the node, otherwise use directly first name found." - (let ((info-file (helm-get-attr 'info-file)) - nodename linum) - (when (string-match helm-info--node-regexp line) - (setq nodename (match-string 2 line) - linum (match-string 3 line))) - (if nodename - (cons (format "(%s)%s" - info-file - (replace-regexp-in-string ":\\'" "" nodename)) - (string-to-number (or linum "1"))) - (cons (format "(%s)%s" - info-file - (helm-aand (replace-regexp-in-string "^* " "" line) - (replace-regexp-in-string "::?.*\\'" "" it))) - 1)))) - -(defclass helm-info-source (helm-source-in-buffer) - ((info-file :initarg :info-file - :initform nil - :custom 'string) - (init :initform #'helm-info-init) - (filtered-candidate-transformer - :initform - (lambda (candidates _source) - (require 'helm-mode) - (cl-loop for line in candidates - when (string-match helm-info--node-regexp line) - do (progn - (helm-add-face-text-properties - (match-beginning 1) (match-end 1) - 'font-lock-keyword-face - nil line) - (helm-add-face-text-properties - (match-beginning 2) (match-end 2) - 'helm-completions-detailed - nil line)) - collect line))) - (display-to-real :initform #'helm-info-display-to-real) - (get-line :initform #'buffer-substring) - (action :initform '(("Goto node" . helm-info-goto))))) - -(defmacro helm-build-info-source (fname &rest args) - `(helm-make-source (concat "Info Index: " ,fname) 'helm-info-source - :info-file ,fname ,@args)) - -(defun helm-build-info-index-command (name doc source buffer) - "Define a Helm command NAME with documentation DOC. -Arg SOURCE will be an existing helm source named -`helm-source-info-' and BUFFER a string buffer name." - (defalias (intern (concat "helm-info-" name)) - (lambda () - (interactive) - (helm :sources source - :buffer buffer - :candidate-number-limit 1000)) - doc)) - -(defun helm-define-info-index-sources (info-list &optional commands) - "Define Helm info sources for all entries in INFO-LIST. - -Sources will be named named helm-source-info- where NAME is an element of -INFO-LIST. - -Sources are generated for all entries of `helm-default-info-index-list' which is -generated by `helm-get-info-files'. - -If COMMANDS arg is non-nil, also build commands named `helm-info-'." - (cl-loop for str in info-list - for sym = (intern (concat "helm-source-info-" str)) - do (set sym (helm-build-info-source str)) - when commands - do (helm-build-info-index-command - str (format "Predefined helm for %s info." str) - sym (format "*helm info %s*" str)))) - -(defun helm-info-index-set (var value) - (set var value) - (helm-define-info-index-sources value t)) - -;;; Search Info files - -;; `helm-info' is the main entry point here. It prompts the user for an Info -;; file, then a term in the file's index to jump to. - -(defvar helm-info-searched (make-ring 32) - "Ring of previously searched Info files.") - -(defun helm-get-info-files () - "Return list of Info files to use for `helm-info'. - -Elements of the list are strings of Info file names without -extensions (e.g., \"emacs\" for file \"emacs.info.gz\"). Info -files are found by searching directories in -`Info-directory-list'." - (info-initialize) ; Build Info-directory-list from INFOPATH (Bug#2118) - (let ((files (cl-loop for d in (or Info-directory-list - Info-default-directory-list) - when (file-directory-p d) - append (directory-files d nil "\\.info")))) - (helm-fast-remove-dups - (cl-loop for f in files collect - (helm-file-name-sans-extension f)) - :test 'equal))) - -(defcustom helm-default-info-index-list - (helm-get-info-files) - "Info files to search in with `helm-info'." - :group 'helm-info - :type '(repeat (choice string)) - :set 'helm-info-index-set) - -(defun helm-info-search-index (candidate) - "Search the index of CANDIDATE's Info file using the function -helm-info-." - (let ((helm-info-function - (intern-soft (concat "helm-info-" candidate)))) - (when (fboundp helm-info-function) - (funcall helm-info-function) - (ring-insert helm-info-searched candidate)))) - -(defvar helm-info--files-cache nil) -(defvar helm-info--files-doc-cache (make-hash-table :test 'equal)) - -(defun helm-info-file-doc (file) - "Return dir entry from the Info FILE." - (or - (with-temp-buffer - (ignore-errors (info-insert-file-contents file)) - (goto-char (point-min)) - (when (re-search-forward "^START-INFO-DIR-ENTRY$" nil t) - (forward-line 1) - (when (re-search-forward - "^\\*[[:space:]]+\\([^:]+\\):[[:space:]]+([^)]+)\\.[[:space:]]+\\(.+\\)" - (pos-eol) t) - (format-message "%s: %s" (match-string 1) (match-string 2))))) - "No summary")) - -(defun helm-def-source--info-files () - "Return a Helm source for Info files." - (require 'helm-mode) - (helm-build-sync-source "Helm Info" - :candidates - (lambda () (copy-sequence helm-default-info-index-list)) - :candidate-number-limit 999 - :candidate-transformer - (lambda (candidates) - (let ((candidates (sort candidates #'string-lessp)) - (longest (apply #'max (mapcar #'length candidates))) - done) - (cl-loop with reporter = (unless done - (make-progress-reporter - "Scanning libraries..." - 0 (length candidates))) - for c in candidates - for count from 0 - for sep = (helm-make-separator c longest) - for file = (or - (assoc-default c helm-info--files-cache) - (helm-aif (Info-find-file c t) - (prog1 it - (push (cons c it) helm-info--files-cache)))) - for doc = (and file - (or completions-detailed - helm-completions-detailed) - (or (gethash file helm-info--files-doc-cache) - (puthash file (helm-info-file-doc file) - helm-info--files-doc-cache))) - for disp = (and file - (if (and doc - (or completions-detailed - helm-completions-detailed)) - (helm-aand (propertize - doc 'face - 'helm-completions-detailed) - (propertize - " " 'display (concat sep it)) - (concat c it)) - c)) - when disp - collect (cons disp c) - when reporter do (progress-reporter-update reporter count) - finally do (setq done t)))) - :nomark t - :action '(("Search index" . helm-info-search-index)))) - -;;;###autoload -(defun helm-info (&optional refresh) - "Preconfigured `helm' for searching Info files' indices. - -With a prefix argument \\[universal-argument], set REFRESH to -non-nil. - -Optional parameter REFRESH, when non-nil, re-evaluates -`helm-default-info-index-list' and clears caches (see below). -If the variable has been customized, set it to its saved value. -If not, set it to its standard value. See -`custom-reevaluate-setting' for more. - -REFRESH is useful when new Info files are installed. If -`helm-default-info-index-list' has not been customized, the new -Info files are made available. - -When `completions-detailed' or `helm-completions-detailed' is non -nil, a description of Info files is provided. The Info files are -partially cached in the variables `helm-info--files-cache' and -`helm-info--files-docs-cache'. TIP: You can make these vars -persistent for faster start with the psession package, using -\\[psession-make-persistent-variable]. - -NOTE: The caches affect as well `info-dislpay-manual' when -`helm-mode' is enabled and `completions-detailed' is non nil. -When new Info files are installed, for example a library update -changed Info dir node entry, you can reset the caches with -a prefix arg." - (interactive "P") - (let ((default (unless (ring-empty-p helm-info-searched) - (ring-ref helm-info-searched 0)))) - (when refresh - (custom-reevaluate-setting 'helm-default-info-index-list) - (setq helm-info--files-cache nil) - (clrhash helm-info--files-doc-cache)) - (helm :sources (helm-def-source--info-files) - :buffer "*helm Info*" - :preselect (and default - (concat "\\_<" (regexp-quote default) "\\_>"))))) - -;;;; Info at point - -;; `helm-info-at-point' is the main entry point here. It searches for the -;; symbol at point through the Info sources defined in -;; `helm-info-default-sources' and jumps to it. - -(defvar helm-info--pages-cache nil - "Cache for all Info pages on the system.") - -(defvar helm-source-info-pages - (helm-build-sync-source "Info Pages" - :init #'helm-info-pages-init - :candidates (lambda () helm-info--pages-cache) - :action `(("Show with Info" - . ,(lambda (node-str) - (info (replace-regexp-in-string - "^[^:]+: " "" node-str))))) - :requires-pattern 2) - "Helm source for Info pages.") - -(defun helm-info-pages-init () - "Collect candidates for initial Info node Top." - (or helm-info--pages-cache - (let ((info-topic-regexp "\\* +\\([^:]+: ([^)]+)[^.]*\\)\\.")) - (save-selected-window - (info "dir" " *helm info temp buffer*") - (Info-find-node "dir" "top") - (goto-char (point-min)) - (while (re-search-forward info-topic-regexp nil t) - (push (match-string-no-properties 1) - helm-info--pages-cache)) - (kill-buffer))))) - -;;;###autoload -(defun helm-info-at-point () - "Preconfigured `helm' for searching info at point." - (interactive) - ;; Symbol at point is used as default as long as one of the sources - ;; in `helm-info-default-sources' is member of - ;; `helm-sources-using-default-as-input'. - (let* ((current (and Info-current-file - (intern-soft - (concat "helm-source-info-" - (helm-basename Info-current-file))))) - (helm-info-default-sources - (if (and current (not (memq current helm-info-default-sources))) - (cons current helm-info-default-sources) - helm-info-default-sources))) - (cl-loop for src in helm-info-default-sources - for name = (if (symbolp src) - (assoc 'name (symbol-value src)) - (assoc 'name src)) - unless name - do (warn "Couldn't build source `%S' without its info file" src)) - (helm :sources helm-info-default-sources - :buffer "*helm info*"))) - -(provide 'helm-info) - -;;; helm-info.el ends here diff --git a/elpa/helm-20251212.555/helm-locate.el b/elpa/helm-20251212.555/helm-locate.el deleted file mode 100644 index 1be9d1a0..00000000 --- a/elpa/helm-20251212.555/helm-locate.el +++ /dev/null @@ -1,531 +0,0 @@ -;;; helm-locate.el --- helm interface for locate. -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2025 Thierry Volpiatto - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;; NOTE for WINDOZE users: -;; You have to install Everything with his command line interface here: -;; http://www.voidtools.com/download.php - -;;; Code: - -(require 'cl-lib) -(require 'helm) -(require 'helm-types) -(require 'helm-help) - -(defvar helm-ff-default-directory) -(declare-function helm-read-file-name "helm-mode") - - -(defgroup helm-locate nil - "Locate related Applications and libraries for Helm." - :group 'helm) - -(defcustom helm-locate-db-file-regexp "m?locate\\.db$" - "Default regexp to match locate database. -If nil Search in all files." - :type 'string) - -(defcustom helm-ff-locate-db-filename "locate.db" - "The basename of the locatedb file you use locally in your directories. -When this is set and Helm finds such a file in the directory from -where you launch locate, it will use this file and will not -prompt you for a db file. -Note that this happen only when locate is launched with a prefix -arg." - :type 'string) - -(defcustom helm-locate-command nil - "A list of arguments for locate program. - -Helm will calculate a default value for your system on startup -unless `helm-locate-command' is non-nil. - -Here are the default values it will use according to your system: - -Gnu/linux: \"locate %s -e -A -N --regex %s\" -berkeley-unix: \"locate %s %s\" -windows-nt: \"es %s %s\" -Others: \"locate %s %s\" - -This string will be passed to format so it should end with `%s'. -The first format spec is used for the \"-i\" value of locate/es, -so don't set it directly but use `helm-locate-case-fold-search' -for this. - -The last option must be the one preceding pattern i.e \"-r\" or -\"--regex\". - -The option \"-N\" may not be available on old locate versions, it is needed on -latest systems as locate send quoted filenames, it is BTW enabled by default, if -this option is not recognized on your system, remove it. - -You will be able to pass other options such as \"-b\" or \"l\" -during Helm invocation after entering pattern only when multi -matching, not when fuzzy matching. - -Note that the \"-b\" option is added automatically by Helm when -var `helm-locate-fuzzy-match' is non-nil and switching back from -multimatch to fuzzy matching (this is done automatically when a -space is detected in pattern)." - :type 'string) - -(defcustom helm-locate-create-db-command - "updatedb -l 0 -o '%s' -U '%s'" - "Command used to create a locale locate db file." - :type 'string) - -(defcustom helm-locate-case-fold-search helm-case-fold-search - "It have the same meaning as `helm-case-fold-search'. -The -i option of locate will be used depending of value of -`helm-pattern' when this is set to \\='smart. -When nil \"-i\" will not be used at all and when non-nil it will -always be used. -NOTE: the -i option of the \"es\" command used on windows does -the opposite of \"locate\" command." - :type 'symbol) - -(defcustom helm-locate-fuzzy-match nil - "Enable fuzzy matching in `helm-locate'. -Note that when this is enabled searching is done on basename." - :type 'boolean) - -(defcustom helm-locate-fuzzy-sort-fn - #'helm-locate-default-fuzzy-sort-fn - "Default fuzzy matching sort function for locate." - :type 'boolean) - -(defcustom helm-locate-project-list nil - "A list of directories, your projects. -When set, allow browsing recursively files in all directories of -this list with `helm-projects-find-files'." - :type '(repeat string)) - -(defcustom helm-locate-recursive-dirs-command "find %s -type d -regex .*%s.*$" - "Command used for recursive directories completion in `helm-find-files'. - -For Windows and `es' use something like \"es -r ^%s.*%s.*$\" - -The two format specs are mandatory. - -We were using locate command as default in the past like this: - - \"locate -i -e -A --regex '^%s' '%s.*$'\" - -But in most distributions updatedb is not indexing user dirs -among others (see PRUNE_BIND_MOUNTS in updatedb.conf man page). -However if you use a local db file, it will be used instead of -the global updatedb cache and will be very fast. - -So we use now the find shell command by default which is available on most -distributions and doesn't suffer of these indexing problems. It -is however slower than locate. Here the possible values you can -use: - - \"find %s -type d -regex .*%s.*$\" - \"find %s -type d -name '*%s*'\" - -You can use also the \"fdfind\" command which may be slow at first call because -it creates an index, but is then very fast on subsequent calls, here is the -command you can use: - - \"fdfind --hidden --type d --glob '*%s*' %s\" - -NOTE: The \"fdfind\" executable name may change on some systems, -it can be \"fd\" or whatever. - -See `helm-find-files' embedded help for more infos." - :type 'string - :group 'helm-files) - - -(defvar helm-locate-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-generic-files-map) - (define-key map (kbd "DEL") 'helm-delete-backward-no-update) - map)) - -(defface helm-locate-finish - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :foreground "Green")) - "Face used in mode line when locate process is finish." - :group 'helm-locate) - - -(defun helm-ff-find-locatedb (&optional from-ff) - "Try to find if a local locatedb file is available. -The search is done in `helm-ff-default-directory' or falls back to -`default-directory' if FROM-FF is nil." - (helm-aif (and helm-ff-locate-db-filename - (locate-dominating-file - (or (and from-ff - helm-ff-default-directory) - default-directory) - helm-ff-locate-db-filename)) - (expand-file-name helm-ff-locate-db-filename it))) - -(defun helm-locate-create-db-default-function (db-name directory) - "Default function used to create a locale locate db file. -Argument DB-NAME name of the db file. -Argument DIRECTORY root of file system subtree to scan." - (format helm-locate-create-db-command - db-name (expand-file-name directory))) - -(defvar helm-locate-create-db-function - #'helm-locate-create-db-default-function - "Function used to create a locale locate db file. -It should receive the same arguments as -`helm-locate-create-db-default-function'.") - -(defun helm-locate-1 (&optional localdb init from-ff default) - "Generic function to run Locate. -Prefix arg LOCALDB when (4) search and use a local locate db file -when it exists or create it, when (16) force update of existing -db file even if exists. -It has no effect when locate command is \\='es'. INIT is a string -to use as initial input in prompt. -See `helm-locate-with-db' and `helm-locate'." - (require 'helm-mode) - (helm-locate-set-command) - (let ((pfn (lambda (candidate) - (if (file-directory-p candidate) - (message "Error: The locate Db should be a file") - (if (= (shell-command - (funcall helm-locate-create-db-function - candidate - helm-ff-default-directory)) - 0) - (message "New locatedb file `%s' created" candidate) - (error "Failed to create locatedb file `%s'" candidate))))) - (locdb (and localdb - (not (string-match "^es" helm-locate-command)) - (or (and (equal '(4) localdb) - (helm-ff-find-locatedb from-ff)) - (helm-read-file-name - "Create Locate Db file: " - :initial-input (expand-file-name "locate.db" - (or helm-ff-default-directory - default-directory)) - :preselect helm-locate-db-file-regexp - :test (lambda (x) - (if helm-locate-db-file-regexp - ;; Select only locate db files and directories - ;; to allow navigation. - (or (string-match - helm-locate-db-file-regexp x) - (file-directory-p x)) - x))))))) - (when (and locdb (or (equal localdb '(16)) - (not (file-exists-p locdb)))) - (funcall pfn locdb)) - (helm-locate-with-db (and localdb locdb) init default))) - -(defun helm-locate-set-command () - "Setup `helm-locate-command' if not already defined." - (unless helm-locate-command - (setq helm-locate-command - (cl-case system-type - ;; Use -N option by default (bug#2625) - (gnu/linux "locate %s -e -A -N --regex %s") - (berkeley-unix "locate %s %s") - (windows-nt "es %s %s") - (t "locate %s %s"))))) - -(defun helm-locate-initial-setup () - (require 'helm-for-files) - (helm-locate-set-command)) - -(defvar helm-file-name-history nil) -(defun helm-locate-with-db (&optional db initial-input default) - "Run locate -d DB. -If DB is not given or nil use locate without -d option. -Argument DB can be given as a string or list of db files. -Argument INITIAL-INPUT is a string to use as initial-input. -See also `helm-locate'." - (require 'helm-files) - (when (and db (stringp db)) (setq db (list db))) - (helm-locate-set-command) - (let ((helm-locate-command - (if db - (replace-regexp-in-string - "locate" - (format (if helm-locate-fuzzy-match - "locate -b -d '%s'" "locate -d '%s'") - (mapconcat 'identity - ;; Remove eventually - ;; marked directories by error. - (cl-loop for i in db - unless (file-directory-p i) - ;; expand-file-name to resolve - ;; abbreviated fnames not - ;; expanding inside single - ;; quotes i.e. '%s'. - collect (expand-file-name i)) - ":")) - helm-locate-command) - (if (and helm-locate-fuzzy-match - (not (string-match-p "\\`locate -b" helm-locate-command))) - (replace-regexp-in-string - "\\`locate" "locate -b" helm-locate-command) - helm-locate-command)))) - (setq helm-file-name-history (mapcar 'helm-basename file-name-history)) - (helm :sources 'helm-source-locate - :buffer "*helm locate*" - :ff-transformer-show-only-basename nil - :input initial-input - :default default - :history 'helm-file-name-history))) - -(defun helm-locate-update-mode-line (process-name) - "Update mode-line with PROCESS-NAME status information." - (with-helm-window - (setq mode-line-format - `(" " mode-line-buffer-identification " " - (:eval (format "L%s" (helm-candidate-number-at-point))) " " - (:eval (propertize - (format "[%s process finished - (%s results)]" - ,process-name - (max (1- (count-lines - (point-min) (point-max))) - 0)) - 'face 'helm-locate-finish)))) - (force-mode-line-update))) - -(defun helm-locate--default-process-coding-system () - "Fix `default-process-coding-system' in locate for Windows systems." - ;; This is an attempt to fix issue #1322. - (if (and (eq system-type 'windows-nt) - (boundp 'w32-ansi-code-page)) - (let ((code-page-eol - (intern (format "cp%s-%s" w32-ansi-code-page "dos")))) - (if (ignore-errors (check-coding-system code-page-eol)) - (cons code-page-eol code-page-eol) - default-process-coding-system)) - default-process-coding-system)) - -(defun helm-locate-init () - "Initialize async locate process for `helm-source-locate'." - (let* ((default-process-coding-system - (helm-locate--default-process-coding-system)) - (locate-is-es (string-match "\\`es" helm-locate-command)) - (real-locate (string-match "\\`locate" helm-locate-command)) - (case-sensitive-flag (if locate-is-es "-i" "")) - (ignore-case-flag (if (or locate-is-es - (not real-locate)) "" "-i")) - (args (helm-mm-split-pattern helm-pattern)) - (cmd (format helm-locate-command - (cl-case helm-locate-case-fold-search - (smart (let ((case-fold-search nil)) - (if (string-match "[[:upper:]]" helm-pattern) - case-sensitive-flag - ignore-case-flag))) - (t (if helm-locate-case-fold-search - ignore-case-flag - case-sensitive-flag))) - (helm-aif (cdr args) - (concat - ;; The pattern itself. - (shell-quote-argument (car args)) " " - ;; Possible locate args added - ;; after pattern, don't quote them. - (mapconcat 'identity it " ")) - (shell-quote-argument (car args))))) - (default-directory (if (file-directory-p default-directory) - default-directory "/")) - process-connection-type) - (helm-log "helm-locat-init" "Starting helm-locate process") - (helm-log "helm-locat-init" "Command line used was:\n\n%s" - (concat ">>> " (propertize cmd 'face 'font-lock-comment-face) "\n\n")) - (prog1 - (start-process-shell-command - "locate-process" helm-buffer - cmd) - (set-process-sentinel - (get-buffer-process helm-buffer) - (lambda (process event) - (let* ((err (process-exit-status process)) - (noresult (= err 1))) - (cond (noresult - (with-helm-buffer - (unless (cdr helm-sources) - (insert (concat "* Exit with code 1, no result found," - " command line was:\n\n " - cmd))))) - ((or (string= event "finished\n") - (process-get process 'reach-limit)) - (when (and helm-locate-fuzzy-match - (not (string-match-p "\\s-" helm-pattern))) - (helm-redisplay-buffer)) - (helm-locate-update-mode-line "Locate")) - (t - (helm-log "helm-locat-init" "Error: Locate %s" - (replace-regexp-in-string "\n" "" event)))))))))) - -(defun helm-locate-default-fuzzy-sort-fn (candidates) - "Default sort function for files in fuzzy matching. -Sort is done on basename of CANDIDATES." - (helm-fuzzy-matching-default-sort-fn-1 candidates nil t)) - -(defclass helm-locate-source (helm-source-async helm-type-file) - ((init :initform 'helm-locate-initial-setup) - (candidates-process :initform 'helm-locate-init) - (requires-pattern :initform 3) - (history :initform 'helm-file-name-history) - (persistent-action :initform 'helm-ff-kill-or-find-buffer-fname) - (candidate-number-limit :initform 9999) - (redisplay :initform (progn helm-locate-fuzzy-sort-fn)))) - -;; Override helm-type-file class keymap. -(cl-defmethod helm--setup-source :after ((source helm-locate-source)) - (setf (slot-value source 'keymap) helm-locate-map) - (setf (slot-value source 'group) 'helm-locate)) - -(defvar helm-source-locate - (helm-make-source "Locate" 'helm-locate-source - :pattern-transformer 'helm-locate-pattern-transformer - ;; :match-part is only used here to tell helm which part - ;; of candidate to highlight. - :match-part (lambda (candidate) - (if (or (string-match-p " -b\\'" helm-pattern) - (and helm-locate-fuzzy-match - (not (string-match "\\s-" helm-pattern)))) - (helm-basename candidate) - candidate)))) - -(defun helm-locate-pattern-transformer (pattern) - (if helm-locate-fuzzy-match - ;; When fuzzy is enabled helm add "-b" option on startup. - (cond ((string-match-p " " pattern) - (when (string-match "\\`locate -b" helm-locate-command) - (setq helm-locate-command - (replace-match "locate" t t helm-locate-command))) - pattern) - (t - (unless (string-match-p "\\`locate -b" helm-locate-command) - (setq helm-locate-command - (replace-regexp-in-string - "\\`locate" "locate -b" helm-locate-command))) - (helm--mapconcat-pattern pattern))) - pattern)) - -(defun helm-locate-find-dbs-in-projects (&optional update) - (let* ((pfn (lambda (candidate directory) - (unless (= (shell-command - (funcall helm-locate-create-db-function - candidate - directory)) - 0) - (error "Failed to create locatedb file `%s'" candidate)))) - (projects (cl-loop for p in helm-locate-project-list - when (file-directory-p p) - collect p))) - (cl-loop for p in projects - for db = (expand-file-name - helm-ff-locate-db-filename - (file-name-as-directory p)) - if (and (null update) (file-exists-p db)) - collect db - else do (funcall pfn db p) - and collect db))) - -;;; Directory completion for hff. -;; -(defclass helm-locate-subdirs-source (helm-source-in-buffer) - ((basedir :initarg :basedir - :initform nil - :custom string) - (subdir :initarg :subdir - :initform nil - :custom 'string) - (data :initform #'helm-locate-init-subdirs) - (group :initform 'helm-locate))) - -(defun helm-locate-init-subdirs () - (let ((cmd (helm-acase helm-locate-recursive-dirs-command - (;; Fd - (guard* (string-match-p "\\`fd" it)) - ;; fd pass path at end. - (format it (helm-get-attr 'subdir) (helm-get-attr 'basedir))) - (;; Es - (guard* (string-match-p "\\`es" it)) - (format it (replace-regexp-in-string - "/" "\\\\\\\\" (helm-get-attr 'basedir)) - (helm-get-attr 'subdir))) - (;; Locate - (guard* (string-match-p "\\`locate" it)) - ;; Try to use a locale DB if some. - (let* ((db (locate-dominating-file - (helm-get-attr 'basedir) - helm-ff-locate-db-filename)) - (lcmd (if (and db (not (string-match-p "-d" it))) - (mapconcat - #'identity - (helm-append-at-nth - (split-string it) - (format "-d %s" - (expand-file-name - helm-ff-locate-db-filename db)) - 1) - " ") - it))) - (format lcmd (helm-get-attr 'basedir) (helm-get-attr 'subdir)))) - ;; Find - (t (format it (helm-get-attr 'basedir) (helm-get-attr 'subdir)))))) - (with-temp-buffer - (call-process-shell-command cmd nil t nil) - (buffer-string)))) - -;;;###autoload -(defun helm-projects-find-files (update) - "Find files with locate in `helm-locate-project-list'. -With a prefix arg refresh the database in each project." - (interactive "P") - (helm-locate-set-command) - (cl-assert (and (string-match-p "\\`locate" helm-locate-command) - (executable-find "updatedb")) - nil "Unsupported locate program") - (let ((dbs (helm-locate-find-dbs-in-projects update))) - (if dbs - (helm-locate-with-db dbs) - (user-error "No projects found, please setup `helm-locate-project-list'")))) - -;;;###autoload -(defun helm-locate (arg) - "Preconfigured `helm' for Locate. -Note: you can add locate options after entering pattern. -See \\='man locate' for valid options and also `helm-locate-command'. - -You can specify a local database with prefix argument ARG. -With two prefix arg, refresh the current local db or create it if -it doesn't exists. - -To create a user specific db, use -\"updatedb -l 0 -o db_path -U directory\". -Where db_path is a filename matched by -`helm-locate-db-file-regexp'." - (interactive "P") - (helm-set-local-variable 'helm-async-outer-limit-hook - (list (lambda () - (when (and helm-locate-fuzzy-match - (not (string-match-p - "\\s-" helm-pattern))) - (helm-redisplay-buffer))))) - (setq helm-ff-default-directory default-directory) - (helm-locate-1 arg nil nil (thing-at-point 'filename))) - -(provide 'helm-locate) - -;;; helm-locate.el ends here diff --git a/elpa/helm-20251212.555/helm-man.el b/elpa/helm-20251212.555/helm-man.el deleted file mode 100644 index 1174a36f..00000000 --- a/elpa/helm-20251212.555/helm-man.el +++ /dev/null @@ -1,176 +0,0 @@ -;;; helm-man.el --- Man and woman UI -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2025 Thierry Volpiatto - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Code: - -(require 'cl-lib) -(require 'helm) -(require 'helm-help) - -(defvar woman-topic-all-completions) -(defvar woman-manpath) -(defvar woman-path) -(defvar woman-expanded-directory-path) -(defvar warning-suppress-log-types) -(declare-function woman-file-name "woman.el" (topic &optional re-cache)) -(declare-function woman-file-name-all-completions "woman.el" (topic)) -(declare-function Man-getpage-in-background "man.el" (topic)) -(declare-function woman-expand-directory-path "woman.el" (path-dirs path-regexps)) -(declare-function woman-topic-all-completions "woman.el" (path)) -(declare-function helm-generic-sort-fn "helm-utils.el" (S1 S2)) -(declare-function helm-comp-read "helm-mode") - -(defgroup helm-man nil - "Man and Woman applications for Helm." - :group 'helm) - -(defcustom helm-man-or-woman-function 'Man-getpage-in-background - "Default command to display a man page." - :group 'helm-man - :type '(radio :tag "Preferred command to display a man page" - (const :tag "Man" Man-getpage-in-background) - (const :tag "Woman" woman))) - -(defcustom helm-man-format-switches (cl-case system-type - ((darwin macos) "%s") - (t "-l %s")) - "Arguments to pass to the `manual-entry' function. -Arguments are passed to `manual-entry' with `format.'" - :group 'helm-man - :type 'string) - -;; Internal -(defvar helm-man--pages nil - "All man pages on system. -Will be calculated the first time you invoke Helm with this -source.") - -(defvar helm-source-man-pages nil) - -(defvar helm-man--tldr-cache nil) - -(defun helm-man-default-action (candidate) - "Default action for jumping to a woman or man page from Helm." - (let ((wfiles (mapcar #'car (woman-file-name-all-completions candidate)))) - (condition-case nil - (let ((file (if (cdr wfiles) - (helm-comp-read "ManFile: " wfiles :must-match t) - (car wfiles)))) - (if (eq helm-man-or-woman-function 'Man-getpage-in-background) - (manual-entry (format helm-man-format-switches file)) - (condition-case nil - (woman-find-file file) - ;; If woman is unable to format correctly - ;; try Man instead. - (error (kill-buffer) - (manual-entry (format helm-man-format-switches file)))))) - ;; If even Man failed with file as argument, try again with Man - ;; but using Topic candidate instead of the file calculated by - ;; woman. - (error (kill-buffer) - (Man-getpage-in-background candidate))))) - -(defun helm-man--init () - "Init caches for helm-man." - (require 'warnings) - (let ((warning-suppress-log-types '((defvaralias)))) - (require 'woman)) - (require 'helm-utils) - (unless helm-man--tldr-cache - (setq helm-man--tldr-cache (helm-man--tldr-cache))) - (unless helm-man--pages - (setq woman-expanded-directory-path - (woman-expand-directory-path woman-manpath woman-path)) - (setq woman-topic-all-completions - (woman-topic-all-completions woman-expanded-directory-path)) - (setq helm-man--pages (mapcar 'car woman-topic-all-completions))) - (helm-init-candidates-in-buffer 'global helm-man--pages)) - -(defun helm-man-popup-info (candidate) - "The popup-info function for `helm-man-pages-class'." - ;; On some systems mandb don't run automatically, in this case whatis or man - ;; -f may return nothing. - (let ((output (shell-command-to-string (format "man -f '%s'" candidate)))) - (when (string-match (format "\\(%s ?([^(]+)\\) *- ?\\(.*\\)\n" candidate) - output) - (match-string 2 output)))) - -(defun helm-man-tldr-render (command) - "Display the output of `tldr' command." - (with-current-buffer-window "*tldr*" '(display-buffer-full-frame) nil - (let ((status (call-process "tldr" nil t nil "--color" "always" command)) - map) - (when (zerop status) - (ansi-color-apply-on-region (point-min) (point-max)) - (goto-char (point-min)) - (setq map (let ((m (make-sparse-keymap))) - (define-key m (kbd "") #'browse-url-at-point) - (define-key m [mouse-1] #'browse-url-at-point) - m)) - (save-excursion - (while (re-search-forward "http[s]://" nil t) - (let* ((pos (bounds-of-thing-at-point 'url)) - (ov (make-overlay (car pos) (cdr pos)))) - (overlay-put ov 'face 'font-lock-keyword-face) - (overlay-put ov 'keymap map) - (overlay-put ov 'mouse-face 'highlight) - (overlay-put ov 'help-echo "mouse-1: Browse url")))) - (local-set-key "q" 'quit-window))))) - -(defun helm-man--tldr-cache () - "Return the output of tldr -l as a list." - (when (executable-find "tldr") - (with-temp-buffer - (call-process "tldr" nil t nil "-l") - (split-string (buffer-string) "\n")))) - -(defun helm-man-action-transformer (actions _candidate) - "The action transformer fn for `helm-man-woman'." - (let ((disp (helm-get-selection nil t))) - (if (member disp helm-man--tldr-cache) - (append actions '(("Tldr" . helm-man-tldr-render))) - actions))) - -(defclass helm-man-pages-class (helm-source-in-buffer) - ((popup-info :initform #'helm-man-popup-info))) - -;;;###autoload -(defun helm-man-woman (arg) - "Preconfigured `helm' for Man and Woman pages. -With a prefix ARG reinitialize the cache. To have a popup -showing a basic description of selected candidate, turn on -`helm-popup-tip-mode'." - (interactive "P") - (when arg (setq helm-man--pages nil - helm-man--tldr-cache nil)) - (unless helm-source-man-pages - (setq helm-source-man-pages - (helm-make-source "Manual Pages" 'helm-man-pages-class - :init #'helm-man--init - :persistent-action #'ignore - :filtered-candidate-transformer - (lambda (candidates _source) - (sort candidates #'helm-generic-sort-fn)) - :action-transformer 'helm-man-action-transformer - :action '(("Display Man page" . helm-man-default-action)) - :group 'helm-man))) - (helm :sources 'helm-source-man-pages - :buffer "*helm man woman*")) - -(provide 'helm-man) - -;;; helm-man.el ends here diff --git a/elpa/helm-20251212.555/helm-misc.el b/elpa/helm-20251212.555/helm-misc.el deleted file mode 100644 index e708e7c5..00000000 --- a/elpa/helm-20251212.555/helm-misc.el +++ /dev/null @@ -1,410 +0,0 @@ -;;; helm-misc.el --- Various functions for helm -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2025 Thierry Volpiatto - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Code: -(require 'cl-lib) -(require 'helm) -(require 'helm-help) -(require 'helm-types) - -(declare-function display-time-world-display "time.el") -(defvar display-time-world-list) -(declare-function LaTeX-math-mode "ext:latex.el") -(declare-function jabber-chat-with "ext:jabber.el") -(declare-function jabber-read-account "ext:jabber.el") -(declare-function helm-comp-read "helm-mode") -(declare-function outline-back-to-heading "outline.el") -(declare-function outline-end-of-heading "outline.el") -(declare-function helm-goto-char "helm-utils") -(declare-function helm-highlight-current-line "helm-utils") - - -(defgroup helm-misc nil - "Various Applications and libraries for Helm." - :group 'helm) - -(defcustom helm-time-zone-home-location "Paris" - "The time zone of your home." - :group 'helm-misc - :type 'string) - -(defcustom helm-timezone-actions - `(("Set timezone env (TZ)" . ,(lambda (candidate) - (setenv "TZ" candidate)))) - "Actions for helm-timezone." - :group 'helm-misc - :type '(alist :key-type string :value-type function)) - -(defface helm-time-zone-current - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :foreground "green")) - "Face used to colorize current time in `helm-world-time'." - :group 'helm-misc) - -(defface helm-time-zone-home - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :foreground "red")) - "Face used to colorize home time in `helm-world-time'." - :group 'helm-misc) - - - -;;; Latex completion -;; -;; Test -;; (setq LaTeX-math-menu '("Math" -;; ["foo" val0 t] -;; ("bar" -;; ["baz" val1 t]) -;; ("aze" -;; ["zer" val2 t]) -;; ("AMS" -;; ("rec" -;; ["fer" val3 t]) -;; ("rty" -;; ["der" val4 t])) -;; ("ABC" -;; ("xcv" -;; ["sdf" val5 t]) -;; ("dfg" -;; ["fgh" val6 t])))) -;; (helm-latex-math-candidates) -;; => -;; (("foo" . val0) -;; ("baz" . val1) -;; ("zer" . val2) -;; ("fer" . val3) -;; ("der" . val4) -;; ("sdf" . val5) -;; ("fgh" . val6)) - -(defvar LaTeX-math-menu) -(defun helm-latex-math-candidates () - (cl-labels ((helm-latex--math-collect (L) - (cond ((vectorp L) - (list (cons (aref L 0) (aref L 1)))) - ((listp L) - (cl-loop for a in L nconc - (helm-latex--math-collect a)))))) - (helm-latex--math-collect LaTeX-math-menu))) - -(defvar helm-source-latex-math - (helm-build-sync-source "Latex Math Menu" - :init (lambda () - (with-helm-current-buffer - (LaTeX-math-mode 1))) - :candidate-number-limit 9999 - :candidates 'helm-latex-math-candidates - :action (lambda (candidate) - (call-interactively candidate)))) - - -;;; Jabber Contacts (jabber.el) -(defun helm-jabber-online-contacts () - "List online Jabber contacts." - (with-no-warnings - (cl-loop for item in (jabber-concat-rosters) - when (get item 'connected) - collect - (if (get item 'name) - (cons (get item 'name) item) - (cons (symbol-name item) item))))) - -(defvar helm-source-jabber-contacts - (helm-build-sync-source "Jabber Contacts" - :init (lambda () (require 'jabber)) - :candidates (lambda () (mapcar 'car (helm-jabber-online-contacts))) - :action (lambda (x) - (jabber-chat-with - (jabber-read-account) - (symbol-name - (cdr (assoc x (helm-jabber-online-contacts)))))))) - -;;; World time -;; -(defvar zoneinfo-style-world-list) -(defvar legacy-style-world-list) - -(defun helm-time-zone-transformer (candidates _source) - (cl-loop for i in candidates - for (z . p) in display-time-world-list - collect - (cons - (cond ((string-match (format-time-string "%H:%M" (current-time)) i) - (propertize i 'face 'helm-time-zone-current)) - ((string-match helm-time-zone-home-location i) - (propertize i 'face 'helm-time-zone-home)) - (t i)) - z))) - -(defvar helm-source-time-world - (helm-build-in-buffer-source "Time World List" - :init (lambda () - (require 'time) - (unless (and display-time-world-list - (listp display-time-world-list)) - ;; adapted from `time--display-world-list' from - ;; emacs-27 for compatibility as - ;; `display-time-world-list' is set by default to t. - (setq display-time-world-list - ;; Determine if zoneinfo style timezones are - ;; supported by testing that America/New York and - ;; Europe/London return different timezones. - (let ((nyt (format-time-string "%z" nil "America/New_York")) - (gmt (format-time-string "%z" nil "Europe/London"))) - (if (string-equal nyt gmt) - legacy-style-world-list - zoneinfo-style-world-list))))) - :data (lambda () - (with-temp-buffer - (display-time-world-display display-time-world-list) - (buffer-string))) - :action 'helm-timezone-actions - :filtered-candidate-transformer 'helm-time-zone-transformer)) - -;;; Minibuffer History -;; -;; -(defvar helm-minibuffer-history-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-map) - (define-key map [remap helm-minibuffer-history] 'undefined) - map)) - -(defcustom helm-minibuffer-history-must-match t - "Allow inserting non matching elements when nil or \\='confirm." - :group 'helm-misc - :type '(choice - (const :tag "Must match" t) - (const :tag "Confirm" confirm) - (const :tag "Always allow" nil))) - -(defcustom helm-minibuffer-history-key "C-r" - "The key `helm-minibuffer-history' is bound to in minibuffer local maps." - :type '(choice (string :tag "Key") (const :tag "no binding")) - :group 'helm-mode) - -(defconst helm-minibuffer-history-old-key - (cl-loop for map in '(minibuffer-local-completion-map - minibuffer-local-filename-completion-map - minibuffer-local-filename-must-match-map ; Emacs 23.1.+ - minibuffer-local-isearch-map - minibuffer-local-map - minibuffer-local-must-match-filename-map ; Older Emacsen - minibuffer-local-must-match-map - minibuffer-local-ns-map) - when (and (boundp map) (symbol-value map)) - collect (cons map (lookup-key (symbol-value map) "\C-r")))) - -;;;###autoload -(define-minor-mode helm-minibuffer-history-mode - "Bind `helm-minibuffer-history-key' in al minibuffer maps. -This mode is enabled by `helm-mode', so there is no need to enable it directly." - :group 'helm-misc - :global t - (if helm-minibuffer-history-mode - (let ((key helm-minibuffer-history-key)) - (dolist (map '(minibuffer-local-completion-map - minibuffer-local-filename-completion-map - minibuffer-local-filename-must-match-map ; Emacs 23.1.+ - minibuffer-local-isearch-map - minibuffer-local-map - minibuffer-local-must-match-filename-map ; Older Emacsen - minibuffer-local-must-match-map - minibuffer-local-ns-map)) - (let ((vmap (and (boundp map) (symbol-value map)))) - (when (keymapp vmap) - (let ((val (and (boundp 'helm-minibuffer-history-key) - (symbol-value 'helm-minibuffer-history-key)))) - (when val - (define-key vmap - (if (stringp val) (read-kbd-macro val) val) - nil))) - (when key - (define-key (symbol-value map) - (if (stringp key) (read-kbd-macro key) key) - 'helm-minibuffer-history)))))) - (dolist (map '(minibuffer-local-completion-map - minibuffer-local-filename-completion-map - minibuffer-local-filename-must-match-map - minibuffer-local-isearch-map - minibuffer-local-map - minibuffer-local-must-match-filename-map - minibuffer-local-must-match-map - minibuffer-local-ns-map)) - (let ((vmap (and (boundp map) (symbol-value map)))) - (when (keymapp vmap) - (let ((val (and (boundp 'helm-minibuffer-history-key) - (symbol-value 'helm-minibuffer-history-key)))) - (when val - (define-key vmap - (if (stringp val) (read-kbd-macro val) val) - (assoc-default map helm-minibuffer-history-old-key))))))))) - - -;;; Helm ratpoison UI -;; -;; -(defvar helm-source-ratpoison-commands - (helm-build-in-buffer-source "Ratpoison Commands" - :init 'helm-ratpoison-commands-init - :action (helm-make-actions - "Execute the command" 'helm-ratpoison-commands-execute) - :display-to-real 'helm-ratpoison-commands-display-to-real - :candidate-number-limit 999999)) - -(defun helm-ratpoison-commands-init () - (unless (helm-candidate-buffer) - (with-current-buffer (helm-candidate-buffer 'global) - ;; with ratpoison prefix key - (save-excursion - (call-process "ratpoison" nil (current-buffer) nil "-c" "help")) - (while (re-search-forward "^\\([^ ]+\\) \\(.+\\)$" nil t) - (replace-match " \\1: \\2")) - (goto-char (point-max)) - ;; direct binding - (save-excursion - (call-process "ratpoison" nil (current-buffer) nil "-c" "help top")) - (while (re-search-forward "^\\([^ ]+\\) \\(.+\\)$" nil t) - (replace-match "\\1: \\2"))))) - -(defun helm-ratpoison-commands-display-to-real (display) - (and (string-match ": " display) - (substring display (match-end 0)))) - -(defun helm-ratpoison-commands-execute (candidate) - (call-process "ratpoison" nil nil nil "-ic" candidate)) - -;;; Helm stumpwm UI -;; -;; -(defvar helm-source-stumpwm-commands - (helm-build-in-buffer-source "Stumpwm Commands" - :init 'helm-stumpwm-commands-init - :action (helm-make-actions - "Execute the command" 'helm-stumpwm-commands-execute) - :candidate-number-limit 999999)) - -(defun helm-stumpwm-commands-init () - (with-current-buffer (helm-candidate-buffer 'global) - (save-excursion - (call-process "stumpish" nil (current-buffer) nil "commands")) - (while (re-search-forward "[ ]*\\([^ ]+\\)[ ]*\n?" nil t) - (replace-match "\n\\1\n")) - (delete-blank-lines) - (sort-lines nil (point-min) (point-max)) - (goto-char (point-max)))) - -(defun helm-stumpwm-commands-execute (candidate) - (call-process "stumpish" nil nil nil candidate)) - -;;;###autoload -(defun helm-world-time () - "Preconfigured `helm' to show world time. -Default action change TZ environment variable locally to emacs." - (interactive) - (helm :sources 'helm-source-time-world :buffer "*helm world time*")) - -;;;###autoload -(defun helm-insert-latex-math () - "Preconfigured helm for latex math symbols completion." - (interactive) - (helm :sources 'helm-source-latex-math :buffer "*helm latex*")) - -;;;###autoload -(defun helm-ratpoison-commands () - "Preconfigured `helm' to execute ratpoison commands." - (interactive) - (helm :sources 'helm-source-ratpoison-commands - :buffer "*helm ratpoison commands*")) - -;;;###autoload -(defun helm-stumpwm-commands() - "Preconfigured helm for stumpwm commands." - (interactive) - (helm :sources 'helm-source-stumpwm-commands - :buffer "*helm stumpwm commands*")) - -;;;###autoload -(defun helm-minibuffer-history () - "Preconfigured `helm' for `minibuffer-history'." - (interactive) - (cl-assert (minibuffer-window-active-p (selected-window)) nil - "Error: Attempt to use minibuffer history outside a minibuffer") - (let* ((enable-recursive-minibuffers t) - (query-replace-p (or (eq last-command 'query-replace) - (eq last-command 'query-replace-regexp))) - (elm (helm-comp-read "Next element matching (regexp): " - (cl-loop for i in - (symbol-value minibuffer-history-variable) - unless (equal "" i) collect i into history - finally return - (if (consp (car history)) - (mapcar 'prin1-to-string history) - history)) - :header-name - (lambda (name) - (format "%s (%s)" name minibuffer-history-variable)) - :buffer "*helm minibuffer-history*" - :must-match helm-minibuffer-history-must-match - :multiline t - :keymap helm-minibuffer-history-map - :allow-nest t))) - ;; Fix Bug#1667 with emacs-25+ `query-replace-from-to-separator'. - (when (and (boundp 'query-replace-from-to-separator) query-replace-p) - (let ((pos (string-match "\0" elm))) - (and pos - (add-text-properties - pos (1+ pos) - `(display ,query-replace-from-to-separator separator t) - elm)))) - (delete-minibuffer-contents) - (insert elm))) - -;;;###autoload -(defun helm-outline (&optional arg) - "Basic helm navigation tool for outline buffers." - (interactive "P") - (require 'outline) - (let ((outline-regexp (if arg (read-regexp "Outline regexp") outline-regexp))) - (helm :sources (helm-build-sync-source "helm outline" - :candidates - (lambda () - (with-helm-current-buffer - (save-excursion - (goto-char (point-min)) - (cl-loop while (re-search-forward outline-regexp nil t) - for beg = (match-beginning 0) - for end = (progn - (outline-end-of-heading) (point)) - collect - (cons (buffer-substring beg end) beg))))) - :action (lambda (pos) - (helm-goto-char pos) - (helm-highlight-current-line))) - :preselect (save-excursion - (when (condition-case _err - (outline-back-to-heading) - (error nil)) - (regexp-quote - (buffer-substring - (point) (progn (outline-end-of-heading) (point)))))) - :buffer "*helm outline*"))) - -(provide 'helm-misc) - -;;; helm-misc.el ends here diff --git a/elpa/helm-20251212.555/helm-mode.el b/elpa/helm-20251212.555/helm-mode.el deleted file mode 100644 index 32a68112..00000000 --- a/elpa/helm-20251212.555/helm-mode.el +++ /dev/null @@ -1,3235 +0,0 @@ -;;; helm-mode.el --- Enable helm completion everywhere. -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2025 Thierry Volpiatto - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Code: - -(require 'cl-lib) -(require 'helm) -(require 'helm-lib) -(require 'helm-files) -(require 'helm-misc) - -(defvar crm-separator) -(defvar ido-everywhere) -(defvar completion-flex-nospace) -(defvar helm-completion--sorting-done) -(defvar helm-mode) -(defvar password-cache) -(defvar package--builtins) -(defvar helm--locate-library-doc-cache) -(defvar helm--locate-library-cache) -(defvar completion-lazy-hilit) ; Emacs-30 only. -(defvar eww-bookmarks) -(defvar helm-info--files-cache) -(defvar helm-info--files-doc-cache) -(defvar Info-current-file) -(defvar helm-M-x-prefix-argument) -(defvar helm-M-x--timer) - -;; No warnings in Emacs built --without-x -(declare-function x-file-dialog "xfns.c") - -(declare-function ido-mode "ido.el") -(declare-function helm-apropos-init "helm-elisp") -(declare-function helm-lisp-completion-persistent-action "helm-elisp") -(declare-function helm-lisp-completion-persistent-help "helm-elisp") -(declare-function help--symbol-class "help-fns.el") -(declare-function helm-get-first-line-documentation "helm-elisp") -(declare-function package-desc-summary "package") -(declare-function package-built-in-p "package") -(declare-function package-desc-status "package") -(declare-function package-get-descriptor "package") -(declare-function print-coding-system-briefly "mul-diag.el") -(declare-function color-rgb-to-hex "color.el") -(declare-function find-library-name "find-func.el") -(declare-function helm-info-file-doc "helm-info") -(declare-function Info-find-file "info") -(declare-function helm-M-x--notify-prefix-arg "helm-command") -(declare-function helm-M-x--unwind-forms "helm-command") -(declare-function helm-M-x--move-selection-after-hook "helm-command") -(declare-function helm-M-x--before-action-hook "helm-command") -(declare-function helm-M-x-persistent-action "helm-command") - -(defgroup helm-mode nil - "Enable helm completion." - :group 'helm) - -(defcustom helm-completing-read-handlers-alist - '((find-tag . helm-completing-read-default-find-tag) - (ggtags-find-tag-dwim . helm-completing-read-default-find-tag) - (tmm-menubar . nil) - (find-file . nil) - (execute-extended-command . nil) - (dired-do-rename . helm-read-file-name-handler-1) - (dired-do-copy . helm-read-file-name-handler-1) - (dired-do-symlink . helm-read-file-name-handler-1) - (dired-do-relsymlink . helm-read-file-name-handler-1) - (dired-do-hardlink . helm-read-file-name-handler-1) - ;; Next two are using completing-read where not needed. - (read-multiple-choice--long-answers . nil) - (dired-do-touch . nil) - (basic-save-buffer . helm-read-file-name-handler-1) - (write-file . (default helm-read-file-name-handler-1)) - (write-region . (default helm-read-file-name-handler-1)) - (all-the-icons-insert . helm-mode-all-the-icons-handler)) - "Completing read functions for specific Emacs commands. - -By default `helm-mode' use `helm-completing-read-default-handler' to -provide helm completion in each `completing-read' or `read-file-name' -found, but other functions can be specified here for specific -commands. This also allows disabling helm completion for some commands -when needed. - -Each entry is a cons cell like (EMACS_COMMAND . COMPLETING-READ_HANDLER) -where key and value are symbols. -However if a command is using in its definition both a `completing-read' AND -a `read-file-name' we may want to specify a handler for both of them, -this can be done by specifying value as a list of two symbols instead of -a single symbol where the 1st element of the list specify the handler for the -`completing-read' and the second the handler for the `read-file-name'. -Special symbol \\='default' means use the default helm handler for either -`completing-read' or `read-file-name'. -e.g. (write-region . (default helm-read-file-name-handler-1)) -means helm will use `helm-completing-read-default-handler' when -`write-region' calls `completing-read' and -`helm-read-file-name-handler-1' when it calls `read-file-name'. - -Each key is an Emacs command that use originaly `completing-read' -or/and `read-file-name'. - -Each value maybe a helm function that takes same arguments as -`completing-read' plus NAME and BUFFER, where NAME is the name of the new -helm source and BUFFER the name of the buffer we will use, but it can -be also a function not using helm, in this case the function should -take the same args as `completing-read' and not be prefixed by \"helm-\". - -`helm' will use the name of the command calling `completing-read' as -NAME and BUFFER will be computed as well with NAME but prefixed with -\"*helm-mode-\". - -This function prefix name must start by \"helm-\" when it uses helm, -otherwise `helm' assumes the function is not a helm function and -expects the same args as `completing-read', this allows you to define a -handler not using helm completion. - -Example: - - (defun foo/test () - (interactive) - (message \"%S\" (completing-read \"test: \" \\='(a b c d e)))) - - (defun helm-foo/test-completing-read-handler (prompt collection - predicate require-match - initial-input hist def - inherit-input-method - name buffer) - (helm-comp-read prompt collection :marked-candidates t - :name name - :buffer buffer)) - - (add-to-list \\='helm-completing-read-handlers-alist - \\='(foo/test . helm-foo/test-completing-read-handler)) - - -We want here to make the regular `completing-read' in `foo/test' -return a list of candidate(s) instead of a single candidate. - -Note that this function will be reused for ALL the `completing-read' -of this command, so it should handle all cases. E.g., -if first `completing-read' completes against symbols and -second `completing-read' should handle only buffer, -your specialized function should handle both. - -If the value of an entry is nil completion will fall back to -Emacs vanilla behaviour. -Example: - -If you want to disable helm completion for `describe-function', use: - - (describe-function . nil) - -Ido is also supported, you can use `ido-completing-read' and -`ido-read-file-name' as value of an entry or just \\='ido. -Example: -Enable ido completion for `find-file': - - (find-file . ido) - -same as - - (find-file . ido-read-file-name) - -Note that you don't need to enable `ido-mode' for this to work, see -`helm-mode' documentation." - :group 'helm-mode - :type '(alist - :key-type symbol - :value-type (choice - function - (list :tag "Specify the completing-read and read-file-name handlers" - (choice - (const :tag "Use default helm completing-read handler" default) - (function :tag "Use this helm completing-read function")) - (function :tag "Use this helm read file name function")) - (other :tag "Disabled" nil)))) - -(defcustom helm-comp-read-case-fold-search helm-case-fold-search - "Default Local setting of `helm-case-fold-search' for `helm-comp-read'. -See `helm-case-fold-search' for more info." - :group 'helm-mode - :type 'symbol) - -(defcustom helm-mode-handle-completion-in-region t - "Whether to replace or not `completion-in-region-function'. -This enables support for `completing-read-multiple' and `completion-at-point' -when non--nil." - :group 'helm-mode - :type 'boolean) - -(defcustom helm-mode-no-completion-in-region-in-modes nil - "A list of modes that do not want helm for `completion-in-region'." - :group 'helm-mode - :type 'boolean) - -(defcustom helm-mode-reverse-history t - "Display history source after current source when non nil. - -Apply only in `helm-mode' handled commands." - :group 'helm-mode - :type 'boolean) - -(defcustom helm-completion-in-region-default-sort-fn - 'helm-completion-in-region-sort-fn - "The default sort function to sort candidates in completion-in-region. - -When nil no sorting is done. -The function is a `filtered-candidate-transformer' function which takes -two args CANDIDATES and SOURCE. -The function must use the flag `helm-completion--sorting-done' and -return CANDIDATES unchanged when the flag is nil. -See default function `helm-completion-in-region-sort-fn' as example. -It will be used only when `helm-completion-style' is either Emacs or -helm, otherwise when helm-fuzzy style is used, the fuzzy sort function -will be used." - :group 'helm-mode - :type 'function) - -(defcustom helm-mode-ignore-diacritics nil - "Ignore diacritics in completing-read." - :group 'helm-mode - :type 'boolean) - -(defcustom helm-completion-mark-suffix t - "Push mark at end of suffix when non nil." - :group 'helm-mode - :type 'boolean) - -(defcustom helm-read-file-name-use-default-arg-behavior nil - "Use emacs vanilla `read-file-name' behavior for default arg. - -The behavior of default arg in `read-file-name' and friends is using -the default arg as default value when initial input is not modified, -even if this initial input is a valid value i.e. an existing file. -We expect generally a default arg to be used if nothing is specified -in the prompt or if what is specified is invalid, but the emacs behavior -here is really weird, so we use this variable to disable this -behavior, letting user specify default if needed with `M-n'. -However we keep the emacs default for `read-file-name' and derived -fns, this variable affecting only `helm-read-file-name'." - :type 'boolean - :group 'helm-mode) - -(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.") - -(defvar helm-comp-read-require-match-overrides '((describe-function . t) - (describe-command . t) - (describe-minor-mode . t) - (load-theme . t) - (describe-theme . t)) - "Allow overriding REQUIRE-MATCH completing-read arg for a specific function.") - -(defcustom helm-completions-detailed t - "Provide detailed completion in several places. -See `helm-completing-read-extra-metadata' and -`helm-completing-read-command-categories'. -Setting `completions-detailed' when available have the same effect." - :type 'boolean - :group 'helm-mode) - -(defvar helm-mode-find-file-target-alist - '(("switch-to-buffer" . helm-buffers-quit-and-find-file-fn)) - "An alist composed of (SOURCE_NAME . FUNCTION) elements. -Where FUNCTION is a function suitable for `helm-quit-and-find-file'.") - -(defface helm-mode-prefix - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - (:background "red" :foreground "black"))) - "Face used for prefix completion." - :group 'helm-mode) - -(defface helm-completion-invalid - '((t :inherit font-lock-property-name-face)) - "Face used to highlight invalid functions." - :group 'helm-mode) - -(defface helm-completions-detailed - '((t :inherit font-lock-warning-face)) - "Face used to highlight completion-detailed informations." - :group 'helm-mode) - -(defface helm-completions-annotations - '((t :inherit font-lock-property-name-face)) - "Face used to highlight annotations in completion." - :group 'helm-mode) - -(defface helm-completions-key-binding - '((t :inherit font-lock-constant-face)) - "Face used to highlight key binding in completion." - :group 'helm-mode) - - -(defvar helm-comp-read-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-map) - (define-key map (kbd "") 'helm-cr-empty-string) - (define-key map (kbd "M-RET") 'helm-cr-empty-string) - map) - "Keymap for `helm-comp-read'.") - -(defvar helm-comp-in-region-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-comp-read-map) - map) - "Keymap for completion-at-point and friends.") - -(defun helm-mode-delete-char-backward-1 () - (interactive) - (condition-case err - (call-interactively 'delete-backward-char) - (text-read-only - (if (with-selected-window (minibuffer-window) - (not (string= (minibuffer-contents) ""))) - (message "Trying to delete prefix completion, next hit will quit") - (user-error "%s" (car err)))))) -(put 'helm-mode-delete-char-backward-1 'helm-only t) - -(defun helm-mode-delete-char-backward-2 () - (interactive) - (condition-case _err - (call-interactively 'delete-backward-char) - (text-read-only - (unless (with-selected-window (minibuffer-window) - (string= (minibuffer-contents) "")) - (with-helm-current-buffer - (run-with-timer 0.1 nil (lambda () - (call-interactively 'delete-backward-char)))) - (helm-keyboard-quit))))) -(put 'helm-mode-delete-char-backward-2 'helm-only t) - -(helm-multi-key-defun helm-mode-delete-char-backward-maybe - "Delete char backward when text is not the prefix helm is completing against. -First call warns user about deleting prefix completion. -Second call deletes backward char in current-buffer and quits helm completion, -letting the user start a new completion with a new prefix." - '(helm-mode-delete-char-backward-1 helm-mode-delete-char-backward-2) 1) - -(defcustom helm-completion-style 'helm - "Style of completion to use in `completion-in-region'. - -This affects only `completion-at-point' and friends, and -the `completing-read' using the default handler -i.e. `helm-completing-read-default-handler'. - -NB: This has nothing to do with `completion-styles', it is independent from -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 are three possible values to use: - -- helm, use multi match regular helm completion. - -- helm-fuzzy, use fuzzy matching. Note that as usual when - entering a space helm switches 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 provides a style called `flex' that can be used - aside `helm' style (see `completion-styles-alist'). When `flex' style - is not available (Emacs<27) helm provides `helm-flex' style which is - similar to `flex' and helm fuzzy matching. - -For a better experience with \\='emacs style, 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 or you want to force using helm-flex -instead of flex (see note above about flex). - -See also `helm-completion-styles-alist' to override -`helm-completion-style' for specific modes and commands. - -Of course when using `helm' or `helm-fuzzy' as `helm-completion-style' -emacs `completion-styles' have no effect. - -Please use custom interface or `customize-set-variable' to set this, -NOT `setq'." - :group 'helm-mode - :type '(choice (const :tag "Emacs" emacs) - (const :tag "Helm" helm) - (const :tag "Helm-fuzzy" helm-fuzzy)) - :set (lambda (var val) - (set var val) - (if (memq val '(helm helm-fuzzy)) - (define-key helm-comp-in-region-map (kbd "DEL") 'helm-mode-delete-char-backward-maybe) - (define-key helm-comp-in-region-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) - ;; See https://github.com/djcb/mu/issues/2181. - (mu4e-compose-mode . emacs) - (wfnames-mode . (emacs helm ,(if (assq 'flex completion-styles-alist) - 'flex 'helm-flex)))) - "Allow configuring `helm-completion-style' per mode or command. - -NOTE: Commands involving `completing-read' specified in -`helm-completing-read-handlers-alist' take precedence on commands -you put here. Specifying a mode instead of a command affect only -completion-in-region and not the completing-read's called in this mode, use -`helm-completing-read-handlers-alist' for this. - -Each entry is a cons cell like (mode_or_command . style) where -style must be a suitable value for `helm-completion-style'. When -specifying emacs as style for a mode or a command, -`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." - :group 'helm-mode - :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 -;; -;; -(defvar helm-comp-read-use-marked nil - "[INTERNAL] When non nil `helm-comp-read' will return marked candidates. - -Use this ONLY in `let', NOT globally, this allows third party packages -to use a list as return value when `helm-mode' is enabled, e.g. - - (let ((helm-comp-read-use-marked t)) - (completing-read \"test: \" \\='(a b c d e f g))) - -") - -(defun helm-cr-empty-string () - "Return empty string." - (interactive) - (with-helm-alive-p - (helm-exit-and-execute-action - (lambda (_candidate) - (identity ""))))) -(put 'helm-cr-empty-string 'helm-only t) - -(defun helm-mode--keyboard-quit () - ;; Use this instead of `keyboard-quit' - ;; to avoid deactivating mark in current-buffer. - (let ((debug-on-quit nil)) - (signal 'quit nil))) - -(defun helm-comp-read-get-candidates (collection - &optional test sort-fn alistp input) - "Convert COLLECTION to list removing elements that don't match TEST. -See `helm-comp-read' about supported COLLECTION arguments. - -SORT-FN is a predicate to sort COLLECTION. - -ALISTP when non--nil will not use `all-completions' to collect -candidates because it doesn't handle alists correctly for helm. -i.e In `all-completions' the car of each pair is used as value. -In helm we want to use the cdr instead like (display . real), -so we return the alist as it is with no transformation by -`all-completions'. - -e.g - -\(setq A \\='((a . 1) (b . 2) (c . 3))) -==>((a . 1) (b . 2) (c . 3)) -\(helm-comp-read \"test: \" A :alistp nil - :exec-when-only-one t - :initial-input \"a\") -==>\"a\" Which is not what we expect. - -\(helm-comp-read \"test: \" A :alistp t - :exec-when-only-one t - :initial-input \"1\") -==>\"1\" - -See docstring of `all-completions' for more info. - -INPUT is the string you want to complete against, defaulting to -`helm-pattern' which is the value of what you enter in minibuffer. -Note that when using a function as COLLECTION this value will be -available with the input argument of the function only when using a -sync source from `helm-comp-read', i.e. not using -`:candidates-in-buffer', otherwise the function is called only once -with an empty string as value for `helm-pattern' because -`helm-pattern' is not yet computed, which is what we want otherwise -data would not be fully collected at init time. - -If COLLECTION is an `obarray', a TEST should be needed. See `obarray'." - (unless input (setq input helm-pattern)) - ;; Ensure COLLECTION is computed from `helm-current-buffer' - ;; because some functions used as COLLECTION work - ;; only in the context of current-buffer (Bug#1030) . - (with-helm-current-buffer - (let ((cands - (cond ((and alistp (hash-table-p collection)) - (cl-loop for k being the hash-keys of collection - using (hash-values v) - collect (cons k v))) - ((vectorp collection) - (all-completions input collection test)) - ((and (symbolp collection) (boundp collection) - ;; Bug#324 history is let-bounded and given - ;; quoted as hist argument of completing-read. - ;; See example in `rcirc-browse-url'. - (symbolp (symbol-value collection))) - nil) - ;; When collection is a symbol, most of the time - ;; it should be a symbol used as a minibuffer-history. - ;; The value of this symbol in this case return a list - ;; of string which maybe are converted later as symbol - ;; in special cases. - ;; we treat here commandp as a special case as it return t - ;; also with a string unless its last arg is provided. - ;; Also, the history collections generally collect their - ;; elements as string, so intern them to call predicate. - ((and (symbolp collection) (boundp collection) test) - (let ((predicate (lambda (elm) - (condition-case _err - (if (eq test 'commandp) - (funcall test (intern elm)) - (funcall test elm)) - (wrong-type-argument - (funcall test (intern elm))))))) - (all-completions input (symbol-value collection) predicate))) - ((and (symbolp collection) (boundp collection)) - (all-completions input (symbol-value collection))) - ;; Normally file completion should not be handled here, - ;; but special cases like `find-file-at-point' do it. - ;; Handle here specially such cases. - ((and (functionp collection) (not (string= input "")) - (or minibuffer-completing-file-name - (eq (completion-metadata-get - (completion-metadata input collection test) - 'category) - 'file))) - (cl-loop for f in (funcall collection input test t) - unless (member f '("./" "../")) - if (string-match helm--url-regexp input) - collect f - else - collect (concat (file-name-as-directory - (helm-basedir input)) - f))) - ((functionp collection) - (funcall collection input test t)) - ((and alistp (null test)) collection) - ;; Next test ensure circular objects are removed - ;; with `all-completions' (Bug#1530). - (t (all-completions input collection test))))) - (if sort-fn (sort cands sort-fn) cands)))) - -(defun helm-cr--pattern-in-candidates-p (candidates &optional pattern) - (unless pattern (setq pattern helm-pattern)) - (or (assoc pattern candidates) - (assoc (concat " " pattern) candidates) - (assq (intern pattern) candidates) - (member pattern candidates) - (member (downcase pattern) candidates) - (member (upcase pattern) candidates))) - -(defun helm-cr-default-transformer (candidates _source) - "Default filter candidate function for `helm-comp-read'." - ;; Annotation and affixation are already handled in completion-in-region and - ;; in helm-completing-read-default-2 when emacs style is in use. - ;; For helm-completing-read-default-1 we handle them in an extra FCT; This - ;; allows extracting annotation and affixation from metadata which is not - ;; accessible from here. - (cl-loop for c in candidates - for cand = (let ((elm (if (stringp c) - (replace-regexp-in-string "\\s\\" "" c) - c))) - (cond ((and (stringp elm) - (string-match "\n" elm)) - (cons (replace-regexp-in-string "\n" "->" elm) c)) - (t c))) - collect cand)) - -(defun helm-cr-default (default cands) - (delq nil - (cond ((and (consp default) (string= helm-pattern "")) - (append (cl-loop for d in default - ;; Don't convert - ;; nil to "nil" (i.e the string) - ;; it will be delq'ed on top. - for str = (if (null d) d (helm-stringify d)) - when (member str cands) - do (setq cands (delete d cands)) - when str collect str) - cands)) - ;; Some functions like debug-on-entry use (symbol-name sym) - ;; without checking if sym is non nil, so the return value become - ;; "nil". - ((and (not (member default '("" "nil"))) - (string= helm-pattern "")) - (cons default (delete (helm-stringify default) - cands))) - (t cands)))) - -;;;###autoload -(cl-defun helm-comp-read (prompt collection - &key - test - initial-input - default - preselect - (buffer "*Helm Completions*") - must-match - fuzzy - reverse-history - (requires-pattern 0) - (history nil shistory) - raw-history - input-history - (case-fold helm-comp-read-case-fold-search) - (persistent-action nil) - (persistent-help "DoNothing") - (mode-line helm-comp-read-mode-line) - help-message - (keymap helm-comp-read-map) - (name "Helm Completions") - header-name - candidates-in-buffer - (get-line #'buffer-substring) - diacritics - match-part - match-dynamic - exec-when-only-one - quit-when-no-cand - (volatile t) - sort - fc-transformer - hist-fc-transformer - (marked-candidates helm-comp-read-use-marked) - nomark - (alistp t) - (candidate-number-limit helm-candidate-number-limit) - multiline - allow-nest - coerce - raw-candidate - (group 'helm) - popup-info) - "Read a string in the minibuffer, with helm completion. - -It is helm `completing-read' equivalent. - -- PROMPT is the prompt name to use. - -- COLLECTION can be a list, alist, vector, obarray or hash-table. - For alists and hash-tables their car are use as real value of - candidate unless ALISTP is non-nil. - It can be also a function that receives three arguments: - the values string, predicate and t. See `all-completions' for more details. - -Keys description: - -- TEST: A predicate called with one arg i.e candidate. - -- INITIAL-INPUT: Same as input arg in `helm'. - -- PRESELECT: See preselect arg of `helm'. - -- DEFAULT: This option is used only for compatibility with regular - Emacs `completing-read' (Same as DEFAULT arg of `completing-read'). - -- BUFFER: Name of helm-buffer. - -- MUST-MATCH: Candidate selected must be one of COLLECTION. - -- FUZZY: Enable fuzzy matching. - -- REVERSE-HISTORY: When non--nil display history source after current - source completion. - -- REQUIRES-PATTERN: Same as helm attribute, default is 0. - -- HISTORY: A symbol where each result will be saved. - If not specified as a symbol an error will popup. - When specified, all elements of HISTORY are displayed in - a special source before or after COLLECTION according to REVERSE-HISTORY. - The main difference with INPUT-HISTORY is that the result of the - completion is saved whereas in INPUT-HISTORY it is the minibuffer - contents which is saved when you exit. - Don't use the same symbol for INPUT-HISTORY and HISTORY. - NOTE: As mentionned above this has nothing to do with - `minibuffer-history-variable', therefore if you want to save this - history persistently, you will have to add this variable to the - relevant variable of your favorite tool for persistent emacs session - i.e. psession, desktop etc... - -- RAW-HISTORY: When non-nil do not remove backslashs if some in - HISTORY candidates. - -- INPUT-HISTORY: A symbol. The minibuffer input history will be - stored there, if nil or not provided, `minibuffer-history' - will be used instead. You can navigate in this history with - `M-p' and `M-n'. - Don't use the same symbol for INPUT-HISTORY and HISTORY. - -- CASE-FOLD: Same as `helm-case-fold-search'. - -- PERSISTENT-ACTION: A function called with one arg i.e candidate. - -- PERSISTENT-HELP: A string to document PERSISTENT-ACTION. - -- MODE-LINE: A string or list to display in mode line. - Default is `helm-comp-read-mode-line'. - -- KEYMAP: A keymap to use in this `helm-comp-read'. - (the keymap will be shared with history source) - -- NAME: The name related to this local source. - -- HEADER-NAME: A function to alter NAME, see `helm'. - -- EXEC-WHEN-ONLY-ONE: Bound `helm-execute-action-at-once-if-one' - to non--nil. (possibles values are t or nil). - -- VOLATILE: Use volatile attribute. - -- SORT: A predicate to give to `sort' e.g `string-lessp' - Use this only on small data as it is inefficient. - If you want to sort faster add a sort function to - FC-TRANSFORMER. - Note that FUZZY when enabled is already providing a sort function. - -- FC-TRANSFORMER: A `filtered-candidate-transformer' function - or a list of functions. - -- HIST-FC-TRANSFORMER: A `filtered-candidate-transformer' - function for the history source. - -- MARKED-CANDIDATES: If non-nil return candidate or marked candidates as a list. - -- NOMARK: When non--nil don't allow marking candidates. - -- ALISTP: - When non-nil (default) pass the value of (DISPLAY . REAL) - candidate in COLLECTION to action when COLLECTION is an alist or a - hash-table, otherwise DISPLAY is always returned as result on exit, - which is the default when using `completing-read'. - See `helm-comp-read-get-candidates'. - -- CANDIDATES-IN-BUFFER: when non--nil use a source build with - `helm-source-in-buffer' which is much faster. - Argument VOLATILE have no effect when CANDIDATES-IN-BUFFER is non--nil. - -- GET-LINE: Specify the :get-line slot of `helm-source-in-buffer', has no effect - when CANDIDATES-IN-BUFFER is nil. - -- MATCH-PART: Allow matching only one part of candidate. - See match-part documentation in `helm-source'. - -- MATCH-DYNAMIC: See match-dynamic in `helm-source-sync' - It has no effect when used with CANDIDATES-IN-BUFFER. - -- ALLOW-NEST: Allow nesting this `helm-comp-read' in a helm session. - See `helm'. - -- MULTILINE: See multiline in `helm-source'. - -- COERCE: See coerce in `helm-source'. - -- RAW-CANDIDATE: Do not unquote the unknown candidate coming from helm-pattern - when non nil. - -- GROUP: See group in `helm-source'. - -Any prefix args passed during `helm-comp-read' invocation will be recorded -in `helm-current-prefix-arg', otherwise if prefix args were given before -`helm-comp-read' invocation, the value of `current-prefix-arg' will be used. -That means you can pass prefix args before or after calling a command -that use `helm-comp-read'. See `helm-M-x' for example." - ;; Handle error with HISTORY: - ;; - ;; Should show helm with one source at first run and save result on - ;; exit, should show the history source along candidates source on - ;; next run as soon as `test-hist' value is feeded. - ;; (setq test-hist nil) - ;; (helm-comp-read "test: " '(a b c d e) - ;; :history 'test-hist) - ;; - ;; Should run normally as long as `test-hist' is bound and nil. As - ;; soon `test-hist' becomes non-nil throw an error. - ;; (helm-comp-read "test: " '(a b c d e) - ;; :history test-hist) - ;; - ;; Should run normally. - ;; (completing-read "test: " '(a b c d e)) - (cl-assert (if shistory - (or (null history) - (and history (symbolp history))) - t) - nil "Error: History should be specified as a symbol") - (when (get-buffer helm-action-buffer) - (kill-buffer helm-action-buffer)) - ;; The value of MUST-MATCH is given to - ;; `helm--set-minibuffer-completion-confirm' which compute it and propagate it - ;; to `minibuffer-completion-confirm' which is then used by - ;; `helm-confirm-and-exit-minibuffer'. - (unless (or (memq must-match '(confirm confirm-after-completion t nil)) - (functionp must-match)) - ;; Fix completing-read's using something else than (confirm - ;; confirm-after-completion t nil) or a function e.g. 1 or - ;; whatever (bug #2527). - (setq must-match t)) - (let ((action-fn `(("Sole action (Identity)" - . ,(lambda (candidate) - (if marked-candidates - (helm-marked-candidates) - (identity candidate))))))) - (let* ((minibuffer-completion-predicate test) - (minibuffer-completion-table - (or minibuffer-completion-table collection)) - (helm-read-file-name-mode-line-string - (replace-regexp-in-string "helm-maybe-exit-minibuffer" - "helm-confirm-and-exit-minibuffer" - helm-read-file-name-mode-line-string)) - (get-candidates - (lambda () - (let ((cands (helm-comp-read-get-candidates - ;; If `helm-pattern' is passed as INPUT - ;; and :alistp is nil INPUT is passed to - ;; `all-completions' which defeat helm - ;; matching functions (multi match, fuzzy - ;; etc...) Bug#2134. - collection test sort alistp - (if (and match-dynamic (null candidates-in-buffer)) - helm-pattern "")))) - (helm-cr-default default cands)))) - (history-get-candidates - (lambda () - (let ((cands (helm-comp-read-get-candidates - history test nil alistp))) - (when cands - (delete "" (helm-cr-default default cands)))))) - (src-hist (helm-build-sync-source (format "%s History" name) - :candidates history-get-candidates - :fuzzy-match fuzzy - :multiline multiline - :match-part match-part - :filtered-candidate-transformer - (append `((lambda (candidates _source) - (if ,raw-history - candidates - (cl-loop for i in candidates - ;; Input is added to history in completing-read's - ;; and may be regexp-quoted, so unquote it - ;; but check if cand is a string (it may be at this stage - ;; a symbol or nil) Bug#1553. - when (stringp i) - collect (replace-regexp-in-string "\\s\\" "" i))))) - (and hist-fc-transformer (helm-mklist hist-fc-transformer))) - :persistent-action persistent-action - :persistent-help persistent-help - :keymap keymap - :must-match must-match - :group group - :popup-info popup-info - :coerce coerce - :mode-line mode-line - :help-message help-message - :action action-fn)) - (dummy-src (helm-build-dummy-source "Unknown candidate" - :must-match must-match - :keymap keymap - :filtered-candidate-transformer - (lambda (_candidates _source) - (let ((pat (if raw-candidate - helm-pattern - (replace-regexp-in-string "\\s\\" "" helm-pattern)))) - (unless (string= pat "") - (list (cons (helm-aand (propertize "[?]" 'face 'helm-ff-prefix) - (propertize " " 'display it 'unknown t) - (concat it pat)) - pat))))) - :action action-fn)) - (src (helm-build-sync-source name - :candidates get-candidates - :popup-info popup-info - :match-part match-part - :multiline multiline - :header-name header-name - :filtered-candidate-transformer - (let ((transformers (helm-mklist fc-transformer))) - (append transformers - (unless (member 'helm-cr-default-transformer transformers) - '(helm-cr-default-transformer)))) - :requires-pattern requires-pattern - :persistent-action persistent-action - :persistent-help persistent-help - :fuzzy-match fuzzy - :diacritics diacritics - :keymap keymap - :must-match must-match - :group group - :coerce coerce - :mode-line mode-line - :match-dynamic match-dynamic - :help-message help-message - :action action-fn - :volatile volatile)) - (src-1 (helm-build-in-buffer-source name - :data get-candidates - :match-part match-part - :get-line get-line - :multiline multiline - :header-name header-name - :filtered-candidate-transformer - (let ((transformers (helm-mklist fc-transformer))) - (append transformers - (unless (member 'helm-cr-default-transformer transformers) - '(helm-cr-default-transformer)))) - :popup-info popup-info - :requires-pattern requires-pattern - :persistent-action persistent-action - :fuzzy-match fuzzy - :diacritics diacritics - :keymap keymap - :must-match must-match - :group group - :coerce coerce - :persistent-help persistent-help - :mode-line mode-line - :help-message help-message - :action action-fn)) - (src-list (list src-hist - (if candidates-in-buffer - src-1 src))) - (helm-execute-action-at-once-if-one exec-when-only-one) - (helm-quit-if-no-candidate quit-when-no-cand) - result) - (when nomark - (setq src-list (cl-loop for src in src-list - collect (cons '(nomark) src)))) - (when reverse-history (setq src-list (nreverse src-list))) - (unless (eq must-match t) - (setq src-list (append src-list (list dummy-src)))) - (when raw-candidate - (cl-loop for src in src-list - do (helm-set-attr 'raw-candidate t src))) - (setq result (helm - :sources src-list - :input initial-input - :default default - :preselect preselect - :prompt prompt - :resume 'noresume - :keymap keymap ;; Needed with empty collection. - :allow-nest allow-nest - :candidate-number-limit candidate-number-limit - :case-fold-search case-fold - :history (and (symbolp input-history) input-history) - :buffer buffer)) - ;; If `history' is a symbol save it, except when it is t. - (when (and result history (symbolp history) (not (eq history t))) - (set history - ;; RESULT may be a a string or a list of strings bug #2461. - (delete-dups (append (mapcar #'substring-no-properties (helm-mklist result)) - (symbol-value history))))) - (or result (helm-mode--keyboard-quit))))) - - -;; Generic completing-read -;; -;; Support also function as collection. -;; e.g M-x man is supported. -;; Support hash-table and vectors as collection. -;; NOTE: -;; Some crap emacs functions may not be supported -;; like ffap-alternate-file (bad use of completing-read) -;; and maybe others. -;; Provide a mode `helm-mode' which turn on -;; helm in all `completing-read' and `read-file-name' in Emacs. -;; -(defvar helm-completion-mode-string " Helm") - -(defvar helm-completion-mode-quit-message - "Helm completion disabled") - -(defvar helm-completion-mode-start-message - "Helm completion enabled") - -;;; Specialized handlers -;; -;; -(defun helm-completing-read-symbols - (prompt _collection test _require-match init - hist default _inherit-input-method name buffer) - "Specialized function for fast symbols completion in `helm-mode'." - (require 'helm-elisp) - (or - (helm - :sources (helm-build-in-buffer-source name - :init (lambda () - (helm-apropos-init (lambda (x) - (and (funcall test x) - (not (keywordp x)))) - (or (car-safe default) default))) - :filtered-candidate-transformer 'helm-apropos-default-sort-fn - :help-message #'helm-comp-read-help-message - :fuzzy-match (eq helm-completion-style 'helm-fuzzy) - :persistent-action - (lambda (candidate) - (helm-lisp-completion-persistent-action - candidate name)) - :persistent-help (helm-lisp-completion-persistent-help)) - :prompt prompt - :buffer buffer - :input init - :history hist - :resume 'noresume - :default (or default "")) - (helm-mode--keyboard-quit))) - - -;;; Extra metadata for completions-detailed -;; -;; -(defvar helm-completing-read-extra-metadata - '((buffer . (metadata - (affixation-function . helm-completing-read-buffer-affixation) - (category . buffer) - (flags . (helm-completing-read--buffer-lgst-mode)))) - (symbol-help . (metadata - (affixation-function . helm-symbol-completion-table-affixation) - (persistent-fn . t) - (category . symbol-help))) - (command-help . (metadata - (prefix-arg . t) - (persistent-fn . t) - (affixation-function . helm-symbol-completion-table-affixation) - (category . symbol-help))) - (eww-help . (metadata ;; Emacs-30 only - (affixation-function . helm-completion-eww-affixation) - (category . eww-help))) - (package . (metadata - (affixation-function . helm-completion-package-affixation) - (category . package))) - (theme . (metadata - (affixation-function . helm-completion-theme-affixation) - (category . theme))) - (coding-system . (metadata - (affixation-function . helm-completion-coding-system-affixation) - (category . coding-system))) - (color . (metadata - (affixation-function . helm-completion-color-affixation) - (category . color))) - (library . (metadata - (affixation-function . helm-completion-library-affixation) - (category . library))) - (charset . (metadata - (affixation-function . helm-completion-charset-affixation) - (category . charset))) - (man . (metadata - (popup-info-function . helm-completion-man-popup-info) - (category . man))) - (info . (metadata - (affixation-function . helm-completion-info-file-affixation) - (category . info))) - (bookmark . (metadata - (affixation-function . helm-completion-bookmark-affixation) - (category . bookmark)))) - "Extra metadatas for completing-read. - -It is used to add `affixation-function' or `annotation-function' if original -metadata doesn't have some or to override existing metadata according to the -category extracted from current metadata. -Helm provides as well an extra property called `popup-info-function' for -categories where it would be too costly to extract informations for all -candidates (See \\='man' category). - -It is an alist composed of (CATEGORY . METADATA) elements. -CATEGORY is a symbol specifying the category according -to the command in use and METADATA is a list composed like this: - - (metadata (affixation-function . fun) - (annotation-function . fun) - (category . category) - (flags . flags)) - -Categories for a specific commands are stored in -`helm-completing-read-command-categories'. - -FLAGS is a list of variables to renitialize to nil when exiting or quitting.") - -(defvar helm-completing-read-command-categories - '(("man" . man) - ("manual-entry" . man) - ("customize-variable" . symbol-help) - ("customize-set-variable" . symbol-help) - ("customize-set-value" . symbol-help) - ("customize-save-variable" . symbol-help) - ("describe-function" . symbol-help); For Emacs-27. - ("describe-variable" . symbol-help); For Emacs-27. - ("describe-symbol" . symbol-help) ; For Emacs-27. - ("describe-command" . symbol-help) ; For Emacs-27. - ("set-variable" . symbol-help) - ("customize-group" . symbol-help) - ("find-function" . symbol-help) - ("find-variable" . symbol-help) - ("trace-function" . symbol-help) - ("trace-function-foreground" . symbol-help) - ("trace-function-background" . symbol-help) - ("describe-minor-mode" . symbol-help) - ("toggle-option" . symbol-help) - ("where-is" . symbol-help) - ("execute-extended-command" . symbol-help) - ("execute-extended-command-for-buffer" . command-help) - ("info-lookup-symbol" . symbol-help) - ("Info-goto-emacs-command-node" . symbol-help) - ("find-library" . library) - ("locate-library" . library) - ("kill-buffer" . buffer) - ("package-install" . package) - ("package-vc-install" . package) - ("package-vc-checkout" . package) - ("package-vc-log-incoming" . package) - ("package-vc-prepare-patch" . package) - ("package-vc-rebuild" . package) - ("package-vc-upgrade" . package) - ("describe-package" . package) - ("load-theme" . theme) - ("describe-theme" . theme) - ("describe-coding-system" . coding-system) - ("set-file-name-coding-system" . coding-system) - ("set-keyboard-coding-system" . coding-system) - ("set-terminal-coding-system" . coding-system) - ("set-process-coding-system" . coding-system) - ("set-buffer-process-coding-system" . coding-system) - ("set-buffer-file-coding-system" . coding-system) - ("set-selection-coding-system" . coding-system) - ("set-next-selection-coding-system" . coding-system) - ("set-clipboard-coding-system" . coding-system) - ("universal-coding-system-argument" . coding-system) - ("read-color" . color) - ("list-charset-chars" . charset) - ("info-display-manual" . info) - ;; Emacs-30 only - ("eww" . eww-help) - ("bookmark-jump" . bookmark)) - "An alist to specify metadata category by command. - -Some commands provide a completion-table with no category -specified in metadata, we allow here specifying the category of -the completion provided by a specific command. The command -should be specified as a string and the category as a symbol.") - -;; We can't reuse the function from helm-man.el because the candidates are here -;; differents e.g. apt vs apt(8). -(defun helm-completion-man-popup-info (candidate) - "Popup-info function for `man' category. -See `helm-completing-read-extra-metadata'." - ;; Man has the stupid habit to use symbol at point as default, try to not - ;; match it. - (let* ((com (if (string-match "\\(.*\\) ?([^()]+)" candidate) - (match-string 1 candidate) - candidate)) - (output (shell-command-to-string (format "man -f '%s'" com)))) - (when (string-match (format "\\(%s ?([^(]+)\\) *- ?\\(.*\\)\n" com) - output) - (match-string 2 output)))) - -(defvar helm-completing-read--buffer-lgst-mode nil) -(defun helm-completing-read-buffer-affixation (completions) - "Affixation function for `buffer' category. -See `helm-completing-read-extra-metadata'." - (let ((len-mode (or helm-completing-read--buffer-lgst-mode - (setq helm-completing-read--buffer-lgst-mode - (cl-loop for bn in completions - maximize (with-current-buffer bn - (length (symbol-name major-mode)))))))) - (lambda (comp) - (let* ((buf (get-buffer comp)) - (fname (buffer-file-name buf)) - (modified (and fname (buffer-modified-p buf))) - (prefix (cond (modified - (propertize - "fm " 'face 'font-lock-comment-face)) - (fname - (propertize - " f " 'face 'helm-completions-annotations)) - (t (propertize "nf " 'face 'font-lock-doc-face)))) - (mode (with-current-buffer comp - (propertize - (symbol-name major-mode) 'face 'helm-completions-detailed))) - (size (helm-buffer-size buf)) - (max-len (helm-acase helm-buffer-max-length - ((guard* (numberp it)) it) - (t 20))) - (bname (truncate-string-to-width - comp max-len nil nil - helm-buffers-end-truncated-string)) - (suffix (format "%s%s%s%s%s `%s'" - (make-string (1+ (- max-len (length bname))) ? ) - (propertize size - 'face 'helm-buffer-size) - (make-string (- 7 (length size)) ? ) - mode - (make-string (1+ (- len-mode (length mode))) ? ) - (helm-aif fname - (propertize - (abbreviate-file-name (file-name-directory it)) - 'face 'font-lock-type-face) - (propertize - (with-current-buffer comp - (abbreviate-file-name default-directory)) - 'face 'font-lock-doc-face))))) - (list (propertize - bname 'face (if fname - 'font-lock-builtin-face - 'font-lock-doc-face)) - (propertize " " 'display prefix) - (propertize " " 'display suffix)))))) - -(defun helm-symbol-completion-table-affixation (_completions) - "Affixation function for `symbol-help' category. -See `helm-completing-read-extra-metadata'. - -Override `help--symbol-completion-table-affixation'. - -Normally affixation functions use COMPLETIONS as arg, and return a list of -modified COMPLETIONS. Now we allow affixations functions to return a -function instead, just like annotation functions. The function should return a -list of three elements like (comp prefix suffix). This increase significantly -the speed avoiding one useless loop on complete list of candidates. - -Returns a function and not a list of completions. - -It affects currently describe-variable/function/command/symbol functions. -It uses `helm-get-first-line-documentation' which allow providing documentation -for `describe-variable' symbols and align properly documentation when helm style -is used." - (lambda (comp) - (require 'help-fns) - (let* ((sym (intern comp)) - ;; When using in-buffer implementation we should have the - ;; longest len to align documentation for free. - ;; Check for style as well in case user switches to emacs - ;; style and a candidate buffer remains (with its local vars - ;; still available). - (max-len (and (memq helm-completion-style '(helm helm-fuzzy)) - (helm-in-buffer-get-longest-candidate))) - (sep (if (or (null max-len) (zerop max-len)) - " -- " ; Default separator. - (helm-make-separator comp max-len))) - (doc (ignore-errors - (helm-get-first-line-documentation sym))) - (symbol-class (with-helm-current-buffer (help--symbol-class sym))) - (group (helm-group-p sym)) - (key (helm-completion-get-key sym))) - (list - ;; Symbol (comp). - (if (or (symbol-function sym) (boundp sym) - (facep sym) group) - comp - ;; Not already defined function. To test add an advice on a non - ;; existing function. - (propertize comp 'face 'helm-completion-invalid)) - ;; Prefixes meaning: (see `help--symbol-class' which returns such strings for a - ;; given symbol). - ;; " c " command - ;; " - " obsolete, 'byte-obsolete-info - ;; " v " var, not a defcustom - ;; " ' " local-variable-if-set-p - ;; " * " not default value if buffer local - ;; " - " 'byte-obsolete-variable - (helm-aand (cond ((and symbol-class group) - (concat "g" symbol-class)) - ((and (not (string= symbol-class "")) - symbol-class)) - (group "g") - (t "i")) ; Not already defined function. - (propertize it 'face 'helm-completions-detailed) - ;; help--symbol-class currently can return at most 8 - ;; characters long symbol class but it is very rare, it is - ;; generally max 4 (bug#2656). - (propertize - ;; (format "%-4s" it) may make spaces inheriting text props - ;; with emacs -nw in emacs<29. - " " 'display (format "%-4s" it))) - ;; Suffix. - (if doc - (helm-aand (propertize doc 'face 'helm-completions-detailed) - (propertize " " 'display (concat sep it key))) - ""))))) - -(defun helm-completion-get-key (sym) - "Return key description on symbol SYM." - (with-helm-current-buffer - (let* ((key (and (commandp sym) (where-is-internal sym nil 'first-only))) - (binding (and key (key-description key)))) - (when binding - (propertize (format " (%s)" binding) 'face 'helm-completions-key-binding))))) - -(defun helm-completion-package-affixation (_completions) - "Affixation function for `package' category. -See `helm-completing-read-extra-metadata'." - (lambda (comp) - (let* ((sym (intern-soft comp)) - (id (package-get-descriptor sym)) - (built-in (package-built-in-p sym)) - (status (and id (package-desc-status id))) - (desc (if built-in - (aref (assoc-default sym package--builtins) 2) - (and id (package-desc-summary id)))) - (sep (helm-make-separator comp))) - (list comp - (propertize - (if status - (format "%s " (substring status 0 1)) - "b ") - 'face 'helm-completions-annotations) - (or (helm-aand desc - (propertize it 'face 'helm-completions-detailed) - (propertize " " 'display (concat sep it))) - ""))))) - -(defun helm-completion-bookmark-affixation (_completions) - "Affixation function for `bookmark' category. -See `helm-completing-read-extra-metadata'." - (lambda (comp) - (let* ((sep (helm-make-separator comp)) - (loc (bookmark-location comp))) - (list (propertize comp 'face 'bookmark-menu-bookmark) - "" - (helm-aand (propertize loc 'face 'helm-completions-detailed) - (propertize " " 'display (concat sep it))))))) - -(defun helm-completion-theme-affixation (_completions) - "Affixation function for `theme' category. -See `helm-completing-read-extra-metadata'." - (lambda (comp) - (let* ((sym (intern-soft comp)) - (sep (helm-make-separator comp)) - (doc (if (custom-theme-p sym) - (helm-get-first-line-documentation sym) - (helm--get-theme-doc-1 sym)))) - (list comp - "" - (helm-aand (propertize doc 'face 'helm-completions-detailed) - (propertize " " 'display (concat sep it))))))) - -(defun helm--get-theme-doc-1 (sym) - (let ((fn (locate-file (concat (symbol-name sym) "-theme.el") - (custom-theme--load-path) - '("" "c"))) - doc) - ;; Avoid loading theme as much as possible. - (when fn - (with-temp-buffer - (insert-file-contents fn) - (helm-awhile (let ((read-circle nil)) - (condition-case nil - (read (current-buffer)) - (end-of-file nil))) - (let ((docstring (nth 2 it))) - (when (and (eq (car-safe it) 'deftheme) docstring) - (cl-return (setq doc (car (split-string docstring "\n"))))))) - (unless doc - (setq doc (helm--get-theme-doc-from-header))))) - doc)) - -(defun helm--get-theme-doc-from-header () - "Extract doc in first line of theme file." - (goto-char (point-min)) - (let (beg end) - (when (re-search-forward "--- " (pos-eol) t) - (setq beg (point))) - (if (re-search-forward " -\\*-" (pos-eol) t) - (setq end (match-beginning 0)) - (setq end (pos-eol))) - (when (and beg end) - (buffer-substring beg end)))) - -(defun helm-completion-coding-system-affixation (_comps) - "Affixation function for `coding-system' category. -See `helm-completing-read-extra-metadata'." - (require 'mule-diag) - (lambda (comp) - (let ((doc (with-output-to-string - (with-current-buffer standard-output - (print-coding-system-briefly (intern comp) 'tightly)))) - (sep (helm-make-separator comp))) - (list comp "" (helm-aand (replace-regexp-in-string "^ *" "" doc) - (replace-regexp-in-string "[\n]" "" it) - (propertize it 'face 'helm-completions-detailed) - (propertize " " 'display (concat sep it))))))) - -(defun helm-completion-charset-affixation (_comps) - "Affixation function for `charset' category. -See `helm-completing-read-extra-metadata'." - (lambda (comp) - (let ((doc (charset-description (intern comp))) - (sep (helm-make-separator comp))) - (list comp "" (helm-aand (propertize doc 'face 'helm-completions-detailed) - (propertize " " 'display (concat sep it))))))) - -(defun helm-completion-color-affixation (_comps) - "Affixation function for `color' category. -See `helm-completing-read-extra-metadata'." - (lambda (comp) - (let ((sep (helm-make-separator comp)) - (rgb (condition-case nil - (helm-acase comp - ("foreground at point" (with-helm-current-buffer - (foreground-color-at-point))) - ("background at point" (with-helm-current-buffer - (background-color-at-point))) - (t - (apply #'color-rgb-to-hex (color-name-to-rgb comp)))) - (error "SAMPLE")))) - (list comp - "" - (helm-aand (propertize rgb 'face `(:background ,rgb - :distant-foreground "black")) - (propertize " " 'display (concat sep it))))))) - -(defun helm-completion-library-affixation (_comps) - "Affixation function for `library' category. -See `helm-completing-read-extra-metadata'." - ;; We share here the same cache as `helm-locate-library'. - (require 'helm-elisp) - (lambda (comp) - ;; Because find-library-include-other-files default to t, we have all the - ;; unrelated files and directories coming in ... Even if this modify the - ;; behavior of find-library-include-other-files remove them for the benefit - ;; of everybody. - (unless (or (string-match "\\(\\.elc\\|/\\)\\'" comp) - (string-match "\\`\\.#" comp)) ; (bug#2526) - (let* ((sep (helm-make-separator comp)) - (path (or (assoc-default comp helm--locate-library-cache) - (let ((p (find-library-name comp))) - (push (cons comp p) helm--locate-library-cache) - p))) - (doc (or (gethash comp helm--locate-library-doc-cache) - (puthash comp (helm-locate-lib-get-summary path) - helm--locate-library-doc-cache)))) - (list comp - "" - (helm-aand (propertize doc 'face 'helm-completions-detailed) - (propertize " " 'display (concat sep it)))))))) - -(defun helm-completion-eww-affixation (_completions) - "Affixation function for `eww-help' category. -See `helm-completing-read-extra-metadata'." - (lambda (comp) - (let* ((title (or (cl-loop for bmk in eww-bookmarks - for title = (plist-get bmk :title) - for url = (plist-get bmk :url) - thereis (and (string= comp url) title)) - "Unknown title")) - (sep (helm-make-separator title 72))) - (list (propertize comp 'display - (truncate-string-to-width comp 72 nil nil t)) - (helm-aand (propertize (truncate-string-to-width title 72) - 'face 'helm-completions-detailed) - (propertize " " 'display (concat it sep))) - "")))) - -(defun helm-completion-info-file-affixation (_completions) - "Affixation function for `info' category. -See `helm-completing-read-extra-metadata'." - ;; We share here the same cache as `helm-info'. - (require 'info) - (require 'helm-info) - (lambda (comp) - (let* ((sep (helm-make-separator comp)) - (prefix "") - (file (or - ;; The `info-display-manual' favours `Info-mode' - ;; buffers. However, each buffer like that may be opened from - ;; a file that has not been installed and is not visible to a - ;; `Info-find-file'. Retrieve the such a file name from the - ;; buffer, and use it to scan for affixation, however don't - ;; cache the result in `helm-info--files-cache' to avoid using - ;; wrong file. For example, the latter can happen after a - ;; development version of info file has been opened. - (let ((manual-re (concat "\\(?:/\\|\\`\\)" comp - "\\(?:\\.\\|\\'\\)")) - (case-fold-search t)) - (cl-loop for buffer in (buffer-list) thereis - (with-current-buffer buffer - (when (and (derived-mode-p 'Info-mode) - (stringp Info-current-file) - (string-match - manual-re Info-current-file)) - (setq prefix "*") - Info-current-file)))) - (assoc-default comp helm-info--files-cache) - (helm-aif (Info-find-file comp t) - (prog1 it (push (cons comp it) helm-info--files-cache))))) - (summary (or (gethash file helm-info--files-doc-cache) - (puthash file (helm-info-file-doc file) - helm-info--files-doc-cache)))) - (list comp - (helm-aand (propertize prefix 'face 'helm-completions-detailed) - (propertize " " 'display (format "%-2s" it))) - (helm-aand (propertize summary 'face 'helm-completions-detailed) - (propertize " " 'display (concat sep it))))))) - - -;;; Completing read handlers -;; -;; -(defun helm-completing-read-default-1 - (prompt collection test require-match - init hist default _inherit-input-method - name buffer &optional cands-in-buffer exec-when-only-one alistp get-line) - "Helm `completing-read' handler not rebuilding its candidates dynamically. - -It is used usually with helm or helm-fuzzy `helm-completion-style'. -Call `helm-comp-read' with same args as `completing-read'. - -Extra optional arg CANDS-IN-BUFFER means use `candidates-in-buffer' -method which is faster. - -EXEC-WHEN-ONLY-ONE allow exiting when COLLECTION contains only one candidate. - -ALISTP is same as `helm-comp-read' :alistp slot. - -When using CANDS-IN-BUFFER, GET-LINE can be specified to exit with candidate -handling properties, see `helm-comp-read'. - -This handler should be used when candidate list doesn't need to be rebuilt -dynamically otherwise use `helm-completing-read-default-2'." - (require 'helm-command) - (let* ((history (or (car-safe hist) hist)) - (initial-input (helm-acase init - ((guard* (stringp it)) it) - ((guard* (consp it)) (car it)))) - (minibuffer-completion-table collection) - (metadata (or (completion-metadata (or initial-input "") collection test) - '(metadata))) - (afun (or (plist-get completion-extra-properties :annotation-function) - (completion-metadata-get metadata 'annotation-function))) - (afix (or (plist-get completion-extra-properties :affixation-function) - (completion-metadata-get metadata 'affixation-function))) - (category (completion-metadata-get metadata 'category)) - (sort-fn (unless (eq helm-completion-style 'helm-fuzzy) - (or - (completion-metadata-get - metadata 'display-sort-function) - (lambda (candidates) - (sort candidates #'helm-generic-sort-fn))))) - popup-info flags pref-arg pers-fn keymap) - (helm-aif (and (null category) - (assoc-default name helm-completing-read-command-categories)) - (setq metadata `(metadata (category . ,it)) - category it)) - (helm-aif (and (or (and (boundp 'completions-detailed) completions-detailed) - helm-completions-detailed) - (assoc-default category helm-completing-read-extra-metadata)) - (progn - (setq metadata it) - (setq afun (completion-metadata-get metadata 'annotation-function) - afix (completion-metadata-get metadata 'affixation-function) - ;; prefix-arg metadata is only in command-help category. - pref-arg (completion-metadata-get metadata 'prefix-arg) - pers-fn (and (completion-metadata-get metadata 'persistent-fn) - (helm-mode--get-persistent-fn name)) - popup-info (completion-metadata-get metadata 'popup-info-function) - flags (completion-metadata-get metadata 'flags)))) - (setq keymap (if pref-arg - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-comp-read-map) - (define-key map (kbd "C-u") 'helm-M-x-universal-argument) - map) - helm-comp-read-map) - prompt (if pref-arg - (concat (helm-acase helm-M-x-prefix-argument - (- "-") - ;; Why &rest? isn't this always a list of one arg? - ((dst* (l &rest args)) - (if (eq l 4) "C-u " (format "%d " l))) - ((guard* (integerp it)) (format "%d " it))) - prompt) - prompt) - helm--mode-line-display-prefarg pref-arg) - (when pref-arg - (setq helm-M-x--timer (run-at-time 1 0.1 #'helm-M-x--notify-prefix-arg)) - (add-hook 'helm-move-selection-after-hook - #'helm-M-x--move-selection-after-hook) - (add-hook 'helm-before-action-hook - #'helm-M-x--before-action-hook) - ;; Notify C-u entered before Hitting M-[xX]. - (setq helm-M-x-prefix-argument current-prefix-arg) - (setq current-prefix-arg nil) - ;; Remove command-execute advice when execute-extended-command exit. - (advice-add 'execute-extended-command :around #'helm--advice-execute-extended-command)) - (unwind-protect - (prog1 - (helm-comp-read - prompt collection - :test test - :keymap keymap - :history history - :reverse-history helm-mode-reverse-history - :input-history history - :must-match require-match - :alistp alistp - :diacritics helm-mode-ignore-diacritics - :help-message #'helm-comp-read-help-message - :persistent-action pers-fn - :persistent-help (if pers-fn (format "Toggle %s" name) "DoNothing") - :name name - :requires-pattern (if (and (stringp default) - (string= default "") - (memq require-match - '(confirm confirm-after-completion))) - 1 0) - :fc-transformer - ;; When afun afix and category are nil - ;; helm-completion--decorate returns - ;; candidates (COMPS) unmodified. - (append (list (lambda (candidates _source) - (helm-completion--decorate - (if (and sort-fn (> (length helm-pattern) 0)) - (funcall sort-fn candidates) - candidates) - afun afix category))) - '(helm-cr-default-transformer)) - :popup-info popup-info - :quit-when-no-cand (eq require-match t) - :nomark (null helm-comp-read-use-marked) - :candidates-in-buffer cands-in-buffer - :get-line (or get-line #'buffer-substring) - :exec-when-only-one exec-when-only-one - :fuzzy (eq helm-completion-style 'helm-fuzzy) - :buffer buffer - ;; If DEF is not provided, fallback to empty string - ;; to avoid `thing-at-point' to be appended on top of list - :default (or default "") - ;; Fail with special characters (e.g in gnus "nnimap+gmail:") - ;; if regexp-quote is not used. - ;; when init is added to history, it will be unquoted by - ;; helm-comp-read. - :initial-input initial-input) - (when pref-arg - (advice-add 'command-execute :around #'helm--advice-command-execute))) - (when pref-arg (helm-M-x--unwind-forms)) - (dolist (f flags) (set f nil))))) - -(defun helm-mode--get-persistent-fn (name) - "Return a lambda to use in symbol-help persistent-action for NAME." - (lambda (candidate) - (helm-elisp--persistent-help - candidate - (helm-acase name - ("describe-symbol" 'helm-describe-symbol) - ("describe-variable" 'helm-describe-variable) - (t 'helm-describe-function))))) - -(defun helm--advice-command-execute (old--fn &rest args) - (helm-M-x--unwind-forms 'done) - ;; `command-execute' is wrapped in a let with `prefix-arg' bound to the argument - ;; PREFIXARG of `execute-extended-command' so set this let-bounded `prefix-arg' - ;; to the value defined during helm completion. We use - ;; helm-M-x-prefix-argument instead of initial PREFIXARG to allow changing the - ;; initial prefix arg during helm completion e.g. C-u M-X foo C-u 2 foo, in - ;; this case the initial C-u is replaced by C-u 2. - (setq prefix-arg (or helm-current-prefix-arg helm-M-x-prefix-argument)) - (apply old--fn args)) - -(defun helm--advice-execute-extended-command (old--fn &rest args) - (prog1 (apply old--fn args) - (advice-remove 'command-execute 'helm--advice-command-execute))) - -(defun helm-completing-read-default-2 - (prompt collection predicate require-match - init hist default _inherit-input-method - name buffer &optional _cands-in-buffer exec-when-only-one) - "Helm `completing-read' handler with dynamic matching. - -Call `helm-comp-read' with same args as `completing-read'. -For the meaning of optional args see `helm-completing-read-default-1'. -This handler uses dynamic matching which allows honouring `completion-styles'." - (let* ((completion-lazy-hilit t) - (history (or (car-safe hist) hist)) - (input (helm-acase init - ((guard* (stringp it)) it) - ((guard* (consp it)) (car it)))) - (completion-flex-nospace t) - (minibuffer-completion-table collection) - ;; (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))) - (afix (or (plist-get completion-extra-properties :affixation-function) - (completion-metadata-get metadata 'affixation-function))) - (category (completion-metadata-get metadata 'category)) - (compfn (lambda (str _predicate _action) - (let* ((completion-ignore-case (helm-set-case-fold-search)) - ;; Use a copy of metadata to avoid accumulation of - ;; adjustment in metadata (This is not needed in - ;; emacs-31+, it has been fixed in emacsbug - ;; #74718). This also avoid the flex adjustment fn - ;; reusing the previous sort fn. - (md (copy-sequence metadata)) - (comps - (completion-all-completions - str ; This is helm-pattern - collection - predicate - (length str) - md)) - (last-data (last comps)) - ;; Helm style sort fn is added to metadata only in - ;; emacs-27 by adjustment , so in 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) - (or - ;; Emacs-27+ - (completion-metadata-get - md 'display-sort-function) - ;; Emacs-26 - (lambda (candidates) - (sort candidates #'helm-generic-sort-fn))))) - all) - (when (cdr last-data) - ;; Remove the last element of - ;; comps by side-effect. - (setcdr last-data nil)) - (setq helm-completion--sorting-done (and sort-fn t)) - (setq all (copy-sequence comps)) - ;; Default is passed here only with helm - ;; h-c-styles, otherwise with emacs style it is - ;; passed with the :default arg of helm-comp-read - ;; and computed in its get-candidates function. - (append (and default - (memq helm-completion-style '(helm helm-fuzzy)) - (list default)) - (if (and sort-fn (> (length str) 0)) - (funcall sort-fn all) - all))))) - (data (if (memq helm-completion-style '(helm helm-fuzzy)) - (funcall compfn (or input "") nil nil) - compfn)) - (helm-completion-in-region-default-sort-fn - (lambda (candidates _source) - (if (or helm-completion--sorting-done - (string= helm-pattern "")) - candidates - (sort candidates 'helm-generic-sort-fn)))) - popup-info flags) - (helm-aif (and (null category) - (assoc-default name helm-completing-read-command-categories)) - (setq metadata `(metadata (category . ,it)) - category it)) - (helm-aif (and (or (and (boundp 'completions-detailed) completions-detailed) - helm-completions-detailed) - (assoc-default category helm-completing-read-extra-metadata)) - (progn - (setq metadata it) - (setq afun (completion-metadata-get metadata 'annotation-function) - afix (completion-metadata-get metadata 'affixation-function) - popup-info (completion-metadata-get metadata 'popup-info-function) - flags (completion-metadata-get metadata 'flags)))) - (unwind-protect - (helm-comp-read - ;; Completion-at-point and friends have no prompt. - prompt - data - :name name - :initial-input input - :buffer buffer - :history history - :nomark (null helm-comp-read-use-marked) - :reverse-history helm-mode-reverse-history - ;; If DEF is not provided, fallback to empty string - ;; to avoid `thing-at-point' to be appended on top of list. - ;; FIXME: default is added first in the collection fn, and then it is - ;; added here and appended to candidates with the get candidates fn of - ;; helm-comp-read, later when sorting default may move somewhere - ;; whereas it has to stay on top. - :default (or default "") - :fc-transformer - ;; When afun afix and category are nil - ;; helm-completion--decorate returns - ;; candidates (COMPS) unmodified and - ;; helm-completion-in-region-default-sort-fn returns - ;; its candidates unmodified when sorting is already done. - (append (list (lambda (candidates source) - (helm-completion--decorate - ;; When `helm-completion-in-region-default-sort-fn' is - ;; nil use CANDIDATES unmodified (bug #2689). - (if helm-completion-in-region-default-sort-fn - (funcall helm-completion-in-region-default-sort-fn - candidates source) - candidates) - afun afix category))) - '(helm-cr-default-transformer)) - :popup-info popup-info - :match-dynamic (eq helm-completion-style 'emacs) - :diacritics helm-mode-ignore-diacritics - :fuzzy (eq helm-completion-style 'helm-fuzzy) - :exec-when-only-one exec-when-only-one - :quit-when-no-cand (eq require-match t) - :must-match require-match) - (setq helm-completion--sorting-done nil) - (dolist (f flags) (set f nil))))) - -(defun helm-mode-all-the-icons-handler (prompt collection test require-match - init hist default inherit-input-method - name buffer) - "Helm `completing-read' handler for `all-the-icons-insert'." - (let* ((max-len 0) - sname - (cands (cl-loop for (desc . str) in collection - ;; When the FAMILY argument is passed to - ;; `all-the-icons-insert' DESC is the name of icon only - ;; otherwise it is "name [family]" with unpredictable - ;; spaces or tab numbers between name and [family]. - for descnp = (substring-no-properties desc) - for sdesc = (if (string-match - "\\(.*\\)[[:blank:]]+\\(\\[.*\\]\\)" descnp) - ;; This is all-the-icons-insert function. - (match-string 1 descnp) - ;; This is one of - ;; all-the-icons-insert- - ;; functions, extract the family name. - (prog1 descnp - (unless sname - (setq sname (plist-get - (get-text-property - 0 'font-lock-face - (get-text-property 0 'display desc)) - :family))))) - for sdesc2 = (match-string 2 descnp) - do (setq max-len (max max-len (string-width sdesc))) - collect (cons (concat sdesc " " str " " sdesc2) desc))) - (fn (lambda () - (with-helm-buffer - (save-excursion - (goto-char (point-min)) - (helm-skip-header-and-separator-line 'next) - (while (re-search-forward "^[[:alnum:]_-]+" nil t) - (insert (make-string (- max-len (current-column)) ? ))))))) - (helm-after-update-hook (append helm-after-update-hook `(,fn)))) - (helm-completing-read-default-1 prompt cands test require-match - init hist default inherit-input-method - (or sname name) buffer t nil t 'buffer-substring))) - -(defun helm-completing-read-default-find-tag - (prompt collection test require-match - init hist default inherit-input-method - name buffer) - "Helm `completing-read' handler for `find-tag'." - ;; Some commands like find-tag may use `read-file-name' from inside - ;; the calculation of collection. in this case it clash with - ;; candidates-in-buffer that reuse precedent data (files) which is wrong. - ;; So (re)calculate collection outside of main helm-session. - (let* ((cands (helm-comp-read-get-candidates - collection test nil nil))) - (helm-completing-read-default-1 prompt cands test require-match - init hist default inherit-input-method - name buffer t))) - -(defun helm-completing-read-sync-default-handler - (prompt collection test require-match - init hist default inherit-input-method - name buffer) - "Helm `completing-read' handler using sync source as backend." - (helm-completing-read-default-1 prompt collection test require-match - init hist default inherit-input-method - name buffer)) - -(defun helm-completing-read-inbuffer-default-handler - (prompt collection test require-match - init hist default inherit-input-method - name buffer) - "Helm `completing-read' handler using inbuffer source as backend." - (helm-completing-read-default-1 prompt collection test require-match - init hist default inherit-input-method - name buffer t)) - -(defun helm-completing-read-default-handler - (prompt collection test require-match - init hist default inherit-input-method - name buffer) - "Default Helm `completing-read' handler. - -Use either `helm-completing-read-default-1' or `helm-completing-read-default-2' -according to `helm-completion-style'." - (let* (;; Standard will be used as CANDS-IN-BUFFER arg. - (standard (and (memq helm-completion-style '(helm helm-fuzzy)) t)) - (fn (if standard - #'helm-completing-read-default-1 - #'helm-completing-read-default-2))) - (funcall fn - prompt collection test require-match - init hist default inherit-input-method name buffer - ;; CANDS-IN-BUFFER - standard))) - -(defun helm-mode--read-buffer-to-switch (prompt) - "[INTERNAL] This is used to advice `read-buffer-to-switch'. -Don't use it directly." - ;; `read-buffer-to-switch' is passing `minibuffer-completion-table' - ;; to `read-buffer' through `minibuffer-setup-hook' which is too - ;; late to be known by `read-buffer-function', in our case - ;; `helm--generic-read-buffer'. It should let bind it to allow us - ;; using it. - (let ((minibuffer-completion-table (internal-complete-buffer-except))) - (read-buffer prompt (other-buffer (current-buffer)) - (confirm-nonexistent-file-or-buffer)))) - -(defun helm--generic-read-buffer (prompt &optional default require-match predicate) - "The `read-buffer-function' for `helm-mode'. -Affects `switch-to-buffer' `kill-buffer' and related." - ;; `read-buffer' is using internally `Vbuffer_alist' which is an - ;; alist with elements like (BUF-NAME . BUF-OBJ), therefore some - ;; predicates in Emacs are working only on such cons cells. - ;; However, helm is transforming COLLECTION in a list of strings and - ;; such predicates are failing because they expect cons cells (see - ;; bug#2506 with `project-switch-to-buffer'), even if they should - ;; handle strings as well according to `read-buffer' - ;; documentation. - (let ((pred (when predicate - (lambda (buffer) - (let ((buf (cons buffer (get-buffer buffer)))) - (condition-case _err - (funcall predicate buffer) - (wrong-type-argument - (funcall predicate buf)))))))) - (helm--completing-read-default - prompt (or minibuffer-completion-table - (internal-complete-buffer "" nil t)) - pred require-match nil nil default))) - -(defun helm-mode--get-default-handler-for (comp-or-file entry) - ;; Use 'comp for completing-read and 'file for 'read-file-name as - ;; COMP-OR-FILE value. - (let ((val (cdr-safe entry)) - (reading-file (eq comp-or-file 'file))) - (if (consp val) - (helm-acase (if reading-file (cadr val) (car val)) - (default (if reading-file - #'helm-read-file-name - #'helm-completing-read-default-handler)) - (t it)) - val))) - -(defun helm-mode--apply-helm-handler (handler arg-list) - "Ensure `minibuffer-complete' is disabled when running HANDLER. -ARG-LIST is a list of arguments to pass to HANDLER." - ;; Some functions are calling `minibuffer-complete' - ;; within `minibuffer-setup-hook' when calling their - ;; `completing-read', like `woman-file-name' (bug #2527). - ;; This defeat Helm which is already - ;; completing minibuffer, so deactivate - ;; minibuffer-complete one time for all [1]. - (cl-letf (((symbol-function 'minibuffer-complete) #'ignore)) - (apply handler arg-list))) - -(cl-defun helm--completing-read-default - (prompt collection &optional - predicate require-match - initial-input hist def - inherit-input-method) - "An helm replacement of `completing-read'. -This function should be used only as a `completing-read-function'. - -Don't use it directly, use instead `helm-comp-read' in your programs. - -See documentation of `completing-read' and `all-completions' for details." - (let* ((current-command (or (helm-this-command) this-command)) - (str-command (if current-command - (helm-symbol-name current-command) - "completing-read")) - (buf-name (format "*helm-mode-%s*" str-command)) - (entry (assq current-command - helm-completing-read-handlers-alist)) - (def-com (helm-mode--get-default-handler-for 'comp entry)) - (str-defcom (and def-com (helm-symbol-name def-com))) - (def-args (list prompt collection predicate - (helm-aif (assq current-command - helm-comp-read-require-match-overrides) - (cdr it) require-match) - initial-input hist def inherit-input-method)) - ;; Append the two extra args needed to set the buffer and source name - ;; in helm specialized functions. - (others-args (append def-args (list str-command buf-name))) - helm-completion-mode-start-message ; Be quiet - helm-completion-mode-quit-message - ;; Be sure this pesty *completion* buffer doesn't popup. - ;; Note: `minibuffer-with-setup-hook' may setup a lambda - ;; calling `minibuffer-completion-help' or other minibuffer - ;; functions we DONT WANT here, in these cases removing the hook - ;; (a symbol) have no effect. Bug#448. - ;; Because `minibuffer-completion-table' and - ;; `minibuffer-completion-predicate' are not bound - ;; anymore here, these functions should have no effect now, - ;; except in some rare cases like in `woman-file-name', - ;; so remove all incompatible functions - ;; from `minibuffer-setup-hook' (Bug#1205, Bug#1240). - ;; otherwise helm have not the time to close its initial session. - (minibuffer-setup-hook - (cl-loop for h in minibuffer-setup-hook - ;; lambdas are no more represented as list in - ;; Emacs-29+ Bug#2666. - unless (or (and (not (symbolp h)) (functionp h)) ; a lambda. - (byte-code-function-p h) - (helm-subr-native-elisp-p h) - (memq h helm-mode-minibuffer-setup-hook-black-list)) - collect h)) - ;; Disable hack that could be used before `completing-read'. - ;; i.e (push ?\t unread-command-events). - unread-command-events - ;; Let-bounding here helm-completion-style according to - ;; helm-completion-styles-alist allow using helm style per commands. - (helm-completion-style (helm-aif (cdr (assq current-command helm-completion-styles-alist)) - (if (cdr-safe it) (car it) it) - (default-value 'helm-completion-style))) - (completion-styles - (helm--prepare-completion-styles current-command)) - (default-handler - ;; If nothing is found in - ;; helm-completing-read-handlers-alist use default - ;; handler which will itself use `helm-completion-style'. - #'helm-completing-read-default-handler)) - (when (eq def-com 'ido) (setq def-com 'ido-completing-read)) - (unless (or (not entry) def-com) - ;; An entry in *read-handlers-alist exists but have - ;; a nil value, so we exit from here, disable `helm-mode' - ;; and run the command again with it original behavior. - ;; `helm-mode' will be restored on exit. - (cl-return-from helm--completing-read-default - (unwind-protect - (progn - (helm-mode -1) - (apply completing-read-function def-args)) - (helm-mode 1)))) - ;; If we use now `completing-read' we MUST turn off `helm-mode' - ;; to avoid infinite recursion and CRASH. It will be reenabled on exit. - (when (or (eq def-com 'completing-read) - ;; All specialized functions are prefixed by "helm" - (and (stringp str-defcom) - (not (string-match "^helm" str-defcom)))) - (helm-mode -1)) - (unwind-protect - (cond (;; An helm specialized function exists, run it. - (and def-com helm-mode) - ;; Disable `minibuffer-complete' for handlers using - ;; helm (bug #2533). - (helm-mode--apply-helm-handler - def-com others-args)) - (;; Try to handle `ido-completing-read' everywhere. - (and def-com (eq def-com 'ido-completing-read)) - (setcar (memq collection def-args) - (all-completions "" collection predicate)) - (apply def-com def-args)) - (;; A non helm function specified in - ;; `helm-completing-read-handlers-alist' use it with - ;; exactly the same args as in `completing-read'. If - ;; we are here `helm-mode' is now disabled. - def-com - (apply def-com def-args)) - (;; Use by default a in-buffer handler unless - ;; COLLECTION is a function. - t - ;; Disable `minibuffer-complete' for handlers using - ;; helm (bug #2533). - (helm-mode--apply-helm-handler - default-handler others-args))) - (helm-mode 1) - ;; When exiting minibuffer, `this-command' is set to - ;; `helm-exit-minibuffer', which is unwanted when starting - ;; on another `completing-read', so restore `this-command' to - ;; initial value when exiting. - (setq this-command current-command)))) - -;;; Generic read-file-name -;; -;; -;;;###autoload -(cl-defun helm-read-file-name - (prompt - &key - (name "Read File Name") - initial-input - (buffer "*Helm file completions*") - test - noret - (case-fold helm-file-name-case-fold-search) - preselect - history - must-match - (fuzzy t) - default - marked-candidates - all-marked - (candidate-number-limit helm-ff-candidate-number-limit) - nomark - (alistp t) - (persistent-action-if 'helm-find-files-persistent-action-if) - (persistent-help "Hit1 Expand Candidate, Hit2 or (C-u) Find file") - (mode-line helm-read-file-name-mode-line-string)) - "Read a file name with helm completion. - -It is helm `read-file-name' emulation. - -Argument PROMPT is the default prompt to use. - -Keys description: - -- NAME: Source name, default to \"Read File Name\". - -- INITIAL-INPUT: Where to start reading file name, - default to `default-directory' or $HOME. - -- BUFFER: `helm-buffer' name, defaults to \"*Helm Completions*\". - -- TEST: A predicate called with one arg \\='candidate'. - -- NORET: Allow disabling helm-ff-RET (have no effect if helm-ff-RET - isn't bound to RET). - -- CASE-FOLD: Same as `helm-case-fold-search'. - -- PRESELECT: helm preselection. - -- HISTORY: Display HISTORY in a special source. - -- MUST-MATCH: Can be \\='confirm, nil, or t. - -- FUZZY: Enable fuzzy matching when non-nil (Enabled by default). - -- MARKED-CANDIDATES: When non--nil return a list of marked candidates - otherwise a single filename is returned. - -- ALL-MARKED: Allow marking several dummy candidates. - -- NOMARK: When non--nil don't allow marking candidates. - -- ALISTP: Don't use `all-completions' in history - (take effect only on history). - -- PERSISTENT-ACTION-IF: a persistent if action function. - -- PERSISTENT-HELP: persistent help message. - -- MODE-LINE: A mode line message, default is - `helm-read-file-name-mode-line-string'." - (require 'tramp) - (unless initial-input - (setq initial-input (or default-directory (getenv "HOME")))) - (when (get-buffer helm-action-buffer) - (kill-buffer helm-action-buffer)) - (mapc (lambda (hook) - (add-hook 'helm-after-update-hook hook)) - '(helm-ff-update-when-only-one-matched - helm-ff-auto-expand-to-home-or-root)) - (let* ((action-fn `(("Sole action (Identity)" - . ,(lambda (candidate) - (if marked-candidates - (helm-marked-candidates - :with-wildcard t :all-sources all-marked) - (identity candidate)))))) - ;; Be sure we don't erase the underlying minibuffer if some. - (helm-ff-auto-update-initial-value - (and helm-ff-auto-update-initial-value - (not (minibuffer-window-active-p (minibuffer-window))))) - helm-follow-mode-persistent - (helm-ff-fuzzy-matching - (and fuzzy - (not (memq helm-mm-matching-method '(multi1 multi3p))))) - (hist (and history (helm-comp-read-get-candidates - history nil nil alistp))) - (helm-ff--RET-disabled noret) - (minibuffer-completion-predicate test) - ;; Since Emacs-30+ `minibuffer-completing-file-name' affect - ;; `file-directory-p' in that it returns `t' when testing e.g. "/ssh" - ;; which is not a directory, as a result we end up with error in - ;; `helm-find-files-get-candidates' when minibuffer contains only - ;; "/ssh" so we use now our own variable - ;; `helm--minibuffer-completing-file-name'. See emacsbug 74191. - (helm--minibuffer-completing-file-name t) - ;; Ensure not being prompted for password each time we - ;; navigate to a directory. - (password-cache t) - (helm--completing-file-name t) - (helm-read-file-name-mode-line-string - (replace-regexp-in-string "helm-maybe-exit-minibuffer" - "helm-confirm-and-exit-minibuffer" - helm-read-file-name-mode-line-string)) - (dummy-src - (unless (eq must-match t) - ;; Non existing file or dir source. - (helm-build-dummy-source "New file or directory" - :keymap helm-read-file-map - :must-match must-match ; Merge must-match-map and helm-read-file-map. - :all-marked all-marked - :nomark nomark - :filtered-candidate-transformer - (lambda (_candidates _source) - (unless (file-exists-p helm-pattern) - (list (helm-ff-filter-candidate-one-by-one - helm-pattern nil t)))) - :action action-fn))) - (src-list - (list - ;; History source. - (helm-build-sync-source (format "%s History" name) - :header-name (lambda (name) - (concat name (substitute-command-keys - helm-find-files-doc-header))) - :mode-line mode-line - :candidates hist - :nohighlight t - :fuzzy-match fuzzy - :persistent-action-if persistent-action-if - :persistent-help persistent-help - :keymap helm-read-file-map - :nomark nomark - :action action-fn) - ;; List files source. - (helm-build-sync-source name - :header-name (lambda (name) - (concat name (substitute-command-keys - helm-find-files-doc-header))) - :init (lambda () - (setq helm-ff-auto-update-flag - helm-ff-auto-update-initial-value) - (setq helm-ff--auto-update-state - helm-ff-auto-update-flag)) - :mode-line mode-line - :help-message 'helm-read-file-name-help-message - :nohighlight helm-ff-nohighlight-matches - :candidate-number-limit 'helm-ff-candidate-number-limit - :candidates - (lambda () - (if test - (cl-loop with hn = (helm-ff--tramp-hostnames) - ;; helm-find-files-get-candidates is - ;; returning a list of cons cells. - for (d . r) in (helm-find-files-get-candidates) - when (or (member r hn) ; A tramp host - (funcall test r)) ; Test ok - collect (cons d r)) - (helm-find-files-get-candidates))) - :update (lambda () - (remhash helm-ff-default-directory - helm-ff--list-directory-cache)) - :match-on-real t - :match (unless helm-find-files-ignore-diacritics - 'helm-mm-3f-match) - :diacritics (and helm-find-files-ignore-diacritics - 'helm-mm-3f-match-on-diacritics) - :filtered-candidate-transformer '(helm-ff-fct - helm-ff-maybe-show-thumbnails - helm-ff-sort-candidates) - :all-marked all-marked - :persistent-action-if persistent-action-if - :persistent-help persistent-help - :volatile t - ;; Because we don't use :must-match in this source, - ;; helm-read-file-map is NOT merged with must-match map, this to - ;; not override helm-ff-RET, so MUST-MATCH == t is handled by - ;; helm-ff-RET, otherwise the dummy source enter in action and - ;; handle the other possible values of MUST-MATCH. - :keymap helm-read-file-map - :cleanup 'helm-find-files-cleanup - :nomark nomark - :action action-fn))) - ;; Helm result. - (result (helm - :sources (append (if helm-mode-reverse-history - (reverse src-list) src-list) - (list dummy-src)) - :input (if (string-match helm-ff-url-regexp initial-input) - initial-input - (expand-file-name initial-input)) - :prompt prompt - :candidate-number-limit candidate-number-limit - :dim-prompt-on-update t - :resume 'noresume - :case-fold-search case-fold - :default default - :buffer buffer - :full-frame nil - :preselect preselect)) - (helm-mm-matching-method 'multi3f)) - (or - (cond ((and result (stringp result) - (string= result "") "")) - ((and result - (stringp result) - (file-equal-p result initial-input) - helm-read-file-name-use-default-arg-behavior - default) - (if (listp default) (car default) default)) - ((and result (listp result)) - (mapcar #'expand-file-name result)) - ((and result (file-directory-p result)) - (file-name-as-directory (expand-file-name result))) - (result (expand-file-name result))) - (helm-mode--keyboard-quit)))) - -(defun helm-mode--default-filename (fname dir initial) - (unless dir (setq dir default-directory)) - (unless (file-name-absolute-p dir) - (setq dir (expand-file-name dir))) - (unless (or fname (consp fname)) - (setq fname (expand-file-name - (or initial buffer-file-name dir) - dir))) - ;; completing-read default maybe a list of defaults. - (if (and fname (consp fname)) - (cl-loop for f in fname - collect (helm-mode--resolve-fname f dir)) - (helm-mode--resolve-fname fname dir))) - -(defun helm-mode--resolve-fname (fname dir) - (if (file-name-absolute-p fname) - (if (file-remote-p fname) - fname - (substitute-in-file-name - (concat (helm-mode-root-dir dir) fname))) - (expand-file-name fname dir))) - -(defun helm-mode-root-dir (dir) - (if (file-remote-p dir) - (let* ((host (file-remote-p dir 'host)) - (method (file-remote-p dir 'method)) - (user (file-remote-p dir 'user))) - (format "/%s:%s@%s:/" method user host)) - "/")) - -(cl-defun helm--generic-read-file-name - (prompt &optional dir default-filename mustmatch initial predicate) - "Generic helm replacement of `read-file-name'. -Don't use it directly, use instead `helm-read-file-name' in your programs." - (let* ((init (or initial dir default-directory)) - (helm-read-file-name-use-default-arg-behavior t) - (current-command (or (helm-this-command) this-command)) - (str-command (if current-command - (helm-symbol-name current-command) - "read-file-name")) - (helm--file-completion-sources - (cons str-command - (remove str-command helm--file-completion-sources))) - (buf-name (format "*helm-mode-%s*" str-command)) - (entry (assq current-command - helm-completing-read-handlers-alist)) - (def-com (helm-mode--get-default-handler-for 'file entry)) - (str-defcom (and def-com (helm-symbol-name def-com))) - ;; Don't modify the original args list for emacs generic functions. - (def-args (list prompt dir default-filename mustmatch initial predicate)) - ;; Append the two extra args needed to set the buffer and source name - ;; in helm specialized functions. - (others-args (append def-args (list str-command buf-name))) - (reading-directory (eq predicate 'file-directory-p)) - (use-dialog (and (next-read-file-uses-dialog-p) - ;; Graphical file dialogs can't handle - ;; remote files. - (not (file-remote-p init)) - use-file-dialog)) - helm-completion-mode-start-message ; Be quiet - helm-completion-mode-quit-message ; Same here - add-to-history fname) - ;; Build `default-filename' with `dir'+`initial' when - ;; `default-filename' is not specified. - ;; See `read-file-name' docstring for more infos. - (setq default-filename (helm-mode--default-filename - default-filename dir initial)) - ;; Some functions that normally call `completing-read' can switch - ;; brutally to `read-file-name' (e.g find-tag), in this case - ;; the helm specialized function will fail because it is build - ;; for `completing-read', so set it to 'incompatible to be sure - ;; we switch to `helm-read-file-name' and don't try to call it - ;; with wrong number of args. - (when (eq def-com 'ido) - (setq def-com 'ido-read-file-name)) - (when (and def-com (> (length (help-function-arglist def-com)) 8)) - (setq def-com 'incompatible)) - (unless (or (not entry) def-com) - (cl-return-from helm--generic-read-file-name - (unwind-protect - (progn - (helm-mode -1) - (apply read-file-name-function def-args)) - (helm-mode 1)))) - ;; If we use now `read-file-name' or dialog we MUST turn off `helm-mode' - ;; to avoid infinite recursion and CRASH. It will be reenabled on exit. - (when (or (memq def-com '(read-file-name ido-read-file-name)) - use-dialog - (and (stringp str-defcom) - (not (string-match "^helm" str-defcom)))) - (helm-mode -1)) - (unwind-protect - (setq fname - (cond (use-dialog - (let ((dialog-mustmatch - (not (memq mustmatch - '(nil confirm confirm-after-completion))))) - ;; Dialogs don't support a list of default fnames. - (when (and default-filename (consp default-filename)) - (setq default-filename - (expand-file-name (car default-filename) init))) - (setq add-to-history t) - (x-file-dialog prompt init default-filename - dialog-mustmatch - reading-directory))) - ;; A specialized function exists, run it - ;; with the two extra args specific to helm. - ;; Note that the helm handler should ensure - ;; :initial-input is not nil i.e. Use init - ;; which fallback to default-directory instead - ;; of INITIAL. - ((and def-com helm-mode - (not (eq def-com 'ido-read-file-name)) - (not (eq def-com 'incompatible)) - ;; The entry in - ;; `helm-completing-read-handlers-alist' is - ;; a cons cell specifying a completing-read - ;; and a read-file-name handler default - ;; e.g. (foo (default default)). - (not (eq def-com 'helm-read-file-name))) - (apply def-com others-args)) - (;; Def-com value is `ido-read-file-name' - ;; run it with default args. - (and def-com (eq def-com 'ido-read-file-name)) - (ido-mode 1) - (apply def-com def-args)) - (;; Def-com value is `read-file-name' - ;; run it with default args. - (eq def-com 'read-file-name) - (apply def-com def-args)) - (t ; Fall back to classic `helm-read-file-name'. - (helm-read-file-name - prompt - :name str-command - :buffer buf-name - :default default-filename - ;; Helm handlers should always have a non nil INITIAL arg. - :initial-input (if (string-match helm-ff-url-regexp init) - init - (if (file-name-absolute-p init) - (if (file-remote-p init) - init - (substitute-in-file-name - (concat (helm-mode-root-dir - (or dir init)) - init))) - (expand-file-name init dir))) - :alistp nil - :nomark (null helm-comp-read-use-marked) - :marked-candidates helm-comp-read-use-marked - :must-match mustmatch - :test predicate - :noret reading-directory)))) - (and ido-mode (ido-mode -1)) - (helm-mode 1) - ;; Same comment as in `helm--completing-read-default'. - (setq this-command current-command)) - (when add-to-history - (add-to-history 'file-name-history - (minibuffer-maybe-quote-filename fname))) - (if (and - ;; Using `read-directory-name'. - reading-directory - ;; `file-name-as-directory' return "./" when FNAME is - ;; empty string. - (not (string= fname ""))) - (file-name-as-directory fname) - fname))) - -;; Read file name handler with history (Bug#1652) -(defun helm-read-file-name-handler-1 (prompt dir default-filename - mustmatch initial predicate - name buffer) - "A `read-file-name' handler with history. -Can be added to `helm-completing-read-handlers-alist' for functions -that need a `read-file-name' function with directory history. -The `helm-find-files' history `helm-ff-history' is used here." - (let ((helm-always-two-windows t) - (helm-split-window-default-side - (if (eq helm-split-window-default-side 'same) - 'below helm-split-window-default-side)) - helm-reuse-last-window-split-state - ;; Helm handlers should always have a non nil INITIAL arg. - (init (or initial dir default-directory))) - (helm-read-file-name - prompt - :name name - :history helm-ff-history - :buffer buffer - :default default-filename - :initial-input (expand-file-name init dir) - :alistp nil - :must-match mustmatch - :test predicate))) - - -;;; Completion in region and Helm style -;; -(defun helm-mode--advice-lisp--local-variables (old--fn &rest args) - (ignore-errors - (apply old--fn args))) - -(defvar helm-completion--sorting-done nil - "Flag that notifies the FCT if sorting has been done in completion function.") -(defun helm-completion-in-region-sort-fn (candidates _source) - "Default sort function for completion-in-region." - (if helm-completion--sorting-done - candidates - (sort candidates 'helm-generic-sort-fn))) - -(defun helm-mode--completion-in-region-initial-input (str) - "Highlight prefix in helm and helm-fuzzy `helm-completion-styles'." - (if (memq helm-completion-style '(helm helm-fuzzy)) - (propertize str 'read-only t 'face 'helm-mode-prefix 'rear-nonsticky t) - str)) - -(defun helm-completion--decorate (comps afun afix category) - "Decorate COMPS with function AFIX or AFUN. - -When CATEGORY is file or library remove dot files from COMPS. - -If both AFUN and AFIX are provided, AFIX takes precedence. - -When AFUN, AFIX are nil and CATEGORY is not file return COMPS unmodified." - ;; Normally COMPS should be a list of - ;; string but in some cases it is given as a list of strings containing a list - ;; of string e.g. ("a" "b" "c" ("d" "e" "f")) ; This happen in rgrep - ;; (bug#2607) and highlight-* fns (bug #2610), so ensure the list is flattened to - ;; avoid e.g. wrong-type argument: stringp '("d" "e" "f") - ;; FIXME: If this create a new bug with completion-in-region, flatten COMPS - ;; directly in the caller i.e. helm-completing-read-default-1. - (when (or afix afun (memq category '(file library))) - (setq comps (helm-fast-remove-dups - (helm-flatten-list comps) - :test 'equal))) - ;; Filter out dot files in file completion. - ;; We were previously exiting directly without handling afix and afun, but - ;; maybe some file completion tables have an afix or afun in their metadata so - ;; let them a chance to run these functions if some. - (when (memq category '(file library)) - (setq comps - (cl-loop for f in comps - unless (string-match "\\`\\.\\{1,2\\}/\\'" f) - collect f))) - (cond (afix - (let ((affixations (funcall afix comps))) - (if (functionp affixations) - (cl-loop for comp in comps - for cand = (funcall affixations comp) - when cand - collect (cons (propertize (concat (nth 1 cand) ;prefix - (nth 0 cand) ;comp - (nth 2 cand)) ;suffix - 'match-part (nth 0 cand)) - comp)) - (cl-loop for (comp prefix suffix) in affixations - collect (cons (propertize - (concat prefix comp suffix) - 'match-part comp) - comp))))) - (afun - ;; Add annotation at end of - ;; candidate if needed, e.g. foo, this happen when - ;; completing against a quoted symbol. - (mapcar (lambda (s) - (let ((ann (funcall afun s))) - (or (helm-aand - ann - (propertize ann 'face 'helm-completions-annotations) - (cons (concat s (propertize " " 'display it)) s)) - s))) - comps)) - (t comps))) - -;;;###autoload -(defun helm-dynamic-completion (collection predicate &optional point metadata nomode styles) - "Build a completion function for `helm-pattern' in COLLECTION. - -Only the elements of COLLECTION that satisfy PREDICATE are considered. - -Argument POINT is the 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 has -to be provided if needed either with an FCT function in source or -by passing the sort function with METADATA -E.g.: \\='((metadata (display-sort-function . foo))). -Candidates can be modified by passing an affixation-function in METADATA. - -If you don't want the sort fn provided by style to kick -in (emacs-27) you can use as metadata value the symbol `nosort'. - -Example: - - (helm :sources (helm-build-sync-source \"test\" - :candidates (helm-dynamic-completion - \\='(foo bar baz foab) - \\='symbolp) - :match-dynamic t) - :buffer \"*helm test*\") - -When argument NOMODE is non nil don't use `completion-styles' as -specified in `helm-completion-styles-alist' for specific modes. - -When STYLES is specified use these `completion-styles', see -`helm--prepare-completion-styles'. - -Also `helm-completion-style' settings have no effect here, -`emacs' being used inconditionally as value." - (lambda () - (let* (;; Force usage of emacs style otherwise - ;; helm--prepare-completion-styles will reset - ;; completion-styles to default value i.e. (basic partial - ;; emacs22). - (helm-completion-style 'emacs) - (completion-styles - (with-helm-current-buffer - (helm--prepare-completion-styles nomode styles))) - (completion-flex-nospace t) - (nosort (eq metadata 'nosort)) - (compsfn (lambda (str pred _action) - (let* ((completion-ignore-case (helm-set-case-fold-search)) - ;; Use a copy of metadata to avoid accumulation of - ;; adjustment in metadata (This is not needed in - ;; emacs-31+, it has been fixed in emacsbug - ;; #74718). This also avoid the flex adjustment fn - ;; reusing the previous sort fn. - (md (copy-sequence metadata)) - (comps (completion-all-completions - str - (if (functionp collection) - (funcall collection str pred t) - collection) - pred - (or point 0) - (or (and (consp md) md) - (setq metadata '(metadata))))) - (last-data (last comps)) - (sort-fn (unless nosort - (completion-metadata-get - md 'display-sort-function))) - (affix (completion-metadata-get - md 'affixation-function)) - all) - (when (cdr last-data) (setcdr last-data nil)) - (setq all (if (and sort-fn (> (length str) 0)) - (funcall sort-fn comps) - comps)) - (if affix - (helm-completion--decorate all nil affix nil) - all))))) - ;; Ensure circular objects are removed. - (complete-with-action t compsfn helm-pattern predicate)))) - -;; Helm multi matching style - -(defun helm-completion-try-completion (string table pred point) - "The try completion function for `completing-styles-alist'. -Currently does nothing." - ;; AFAIU the try-completions style functions - ;; are here to check if what is at point is suitable for TABLE but - ;; there is no way to pass a multiple pattern from what is at point - ;; apart sending STRING in a minibuffer like helm does. Perhaps - ;; minibuffer-complete should benefit of this but for now just do - ;; nothing as this is used nowhere. It is anyway not clear what the - ;; try-completions functions do in emacs so just do nothing for now. - (ignore string table pred point)) - -(defun helm-completion-all-completions (string table pred point) - "The all completions function for `completing-styles-alist'." - (cl-multiple-value-bind (all _pattern prefix _suffix _carbounds) - (helm-completion--multi-all-completions string table pred point) - (when all (nconc all (length prefix))))) - -(defun helm-completion--multi-all-completions-1 (string collection &optional predicate) - "Allow `all-completions' multi matching on its candidates." - ;; Doing an initial call of all-completions on the first element of - ;; STRING speedup completion and fix file completion when CAPF - ;; returns relative paths to initial pattern (eshell and shell). - (let* ((split (helm-mm-split-pattern string)) - (fpat (or (car split) "")) - (file-comp-p (or minibuffer-completing-file-name - (eq - (completion-metadata-get - (completion-metadata string collection predicate) - 'category) - 'file))) - (all (and file-comp-p - (or (cdr split) - (and (not (cdr split)) - ;; Kickin when STRING is a simple string. - ;; Handle as well "foo " (space at end). - (not (string= fpat ""))) - (string= string "")) - (not (string-match "\\`!" fpat)) - ;; all-completions should return nil if FPAT is a - ;; regexp, it is what we expect. - (all-completions fpat collection - (lambda (x &optional _y) - (let ((elm (if (listp x) (car x) x))) - (funcall (or predicate #'identity) elm)))))) - (pattern (helm-aand all (string-match " " string) - ;; Returns the part of STRING after space - ;; e.g. "foo bar baz" => "bar baz". - (substring string (1+ it))))) - (if (or (and all (not (cdr split))) - (equal pattern "")) ; e.g. STRING == "foo ". - all - (all-completions "" (or all collection) - (lambda (x &optional _y) - ;; Second arg _y is needed when - ;; COLLECTION is a hash-table (Bug#2231) - ;; (C-x 8 RET). - ;; Elements of COLLECTION may be - ;; lists or alists, in this case consider the - ;; car of element (Bug#2219 org-refile). - (let ((elm (if (listp x) (car x) x))) - ;; PREDICATE have been already called in - ;; initial all-completions, no need to call - ;; it a second time, thus ALL is now a list - ;; of strings maybe not supported by - ;; PREDICATE (e.g. symbols vs strings). - (if (and predicate (null all)) - (and (funcall predicate elm) - ;; ALL is nil so use whole STRING - ;; against COLLECTION. - (helm-mm-match (helm-stringify elm) string)) - (helm-mm-match (helm-stringify elm) - (or (and all pattern) string))))))))) - -(defun helm-completion--multi-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))) - (all (helm-completion--multi-all-completions-1 - ;; Using `regexp-quote' on STRING fixes bug#2355 but - ;; breaks regexp matching in multi match, currently with - ;; Helm-3.7.1 and emacs-27+ it seems using plain STRING - ;; works for both so use it. - ;;(regexp-quote string) - string table pred))) - (list all string prefix suffix point))) - -;; 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 - (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) - ,@(cl-loop for (elm . val) in (cdr metadata) - unless (memq elm '(display-sort-function cycle-sort-function)) - collect (cons elm val)))))) -(put 'helm 'completion--adjust-metadata 'helm-completion--adjust-metadata) - -;; Helm-flex style. -;; This is more or less the same as emacs-27 flex style. -(defun helm-flex-completion-try-completion (string table pred point) - "The try completion function for `completing-styles-alist'." - ;; It is needed here to make minibuffer-complete work in emacs-26, - ;; e.g. with regular M-x. - (unless (string-match-p " " string) - (cl-multiple-value-bind (all pattern prefix suffix _carbounds) - (helm-completion--flex-all-completions string table pred point) - (when minibuffer-completing-file-name - (setq all (completion-pcm--filename-try-filter all))) - (completion-pcm--merge-try pattern all prefix suffix)))) - -(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. - (unless (string-match-p " " string) - (cl-multiple-value-bind (all pattern prefix _suffix _carbounds) - (helm-completion--flex-all-completions - string table pred point - #'helm-completion--flex-transform-pattern) - (let ((regexp (completion-pcm--pattern->regex pattern 'group))) - (when all (nconc (helm-flex-add-score-as-prop all regexp) - (length prefix))))))) - -;; Same as emacs-27 completion-substring--all-completions. -(defun helm-completion--flex-all-completions - (string table pred point &optional transform-pattern-fn) - "Match the presumed substring STRING to the entries in TABLE. -Respect PRED and POINT. The pattern used is a PCM-style substring -pattern, but it will be massaged by TRANSFORM-PATTERN-FN, if that -is non-nil." - (let* ((beforepoint (substring string 0 point)) - (afterpoint (substring string point)) - (bounds (completion-boundaries beforepoint table pred afterpoint)) - (suffix (substring afterpoint (cdr bounds))) - (prefix (substring beforepoint 0 (car bounds))) - (basic-pattern (completion-basic--pattern - beforepoint afterpoint bounds)) - (pattern (if (not (stringp (car basic-pattern))) - basic-pattern - (cons 'prefix basic-pattern))) - (pattern (if transform-pattern-fn - (funcall transform-pattern-fn pattern) - pattern)) - (all (completion-pcm--all-completions prefix pattern table pred))) - (list all pattern prefix suffix (car bounds)))) - -(defun helm-completion-in-region--selection () - (with-helm-buffer - (setq helm-saved-selection (helm-get-selection nil 'withprop)))) - -;; Completion-in-region-function - -(defvar helm--completing-region nil - "[INTERNAL] flag let-bounded to nil when completing in region.") - -(defun helm--completion-in-region (origfun start end collection &optional predicate) - "Helm replacement of `completion--in-region'. - -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." - ;; This error may happen when user hits quickly twice e.g. TAB for - ;; completion-at-point which start a second time this function because the - ;; first helm-buffer with its keymap is not ready yet (this happen when helm is - ;; displayed in a frame which is slower to popup than a window). FIXME: Should - ;; I prevent this at a lower level as well? - (cl-assert (not (get-buffer-window helm-buffer 'visible)) nil - "Error: Trying to run helm while a helm session is already running") - (if (memq major-mode helm-mode-no-completion-in-region-in-modes) - (funcall origfun start end collection predicate) - (advice-add - 'lisp--local-variables - :around #'helm-mode--advice-lisp--local-variables) - (let ((old--helm-completion-style helm-completion-style) - (exit-fun (plist-get completion-extra-properties :exit-function)) - ;; 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))) - (current-command (or (helm-this-command) - this-command - ;; Some backends are async and - ;; use a callback, in those - ;; cases, we can't retrieve from - ;; frames the last interactive - ;; command, so fallback to - ;; `last-command' which may be - ;; the one that called the callback. - last-command)) - string) - (helm-aif (cdr (or (assq major-mode helm-completion-styles-alist) - (assq current-command helm-completion-styles-alist))) - (customize-set-variable 'helm-completion-style - (if (cdr-safe it) (car it) it))) - ;; This hook force usage of the display part of candidate with - ;; its properties, this is needed for lsp-mode in its - ;; :exit-function see Bug#2265. - (add-hook 'helm-before-action-hook 'helm-completion-in-region--selection) - (unwind-protect - (let* ((enable-recursive-minibuffers t) - (completion-flex-nospace t) - (helm--completing-region t) - (completion-styles (helm--prepare-completion-styles)) - (input (buffer-substring-no-properties start end)) - (prefix (and (eq helm-completion-style 'emacs) initial-input)) - (point (point)) - (crm (eq current-command 'crm-complete)) - (str-command (helm-symbol-name current-command)) - (buf-name (format "*helm-mode-%s*" str-command)) - ;; If we have a minibuffer use `minibuffer-completion-confirm' - ;; otherwise assume we use `completion-at-point' and use `t'. - (require-match (if crm minibuffer-completion-confirm t)) - (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 " where foo is a function. - ;; See Bug#407. - (afun (or (plist-get completion-extra-properties :annotation-function) - (completion-metadata-get metadata 'annotation-function))) - ;; Not sure if affixations are provided in - ;; completion-in-region, try anyway never know. - (afix (or (plist-get completion-extra-properties :affixation-function) - (completion-metadata-get metadata 'affixation-function))) - (docsig (plist-get completion-extra-properties :company-docsig)) - (helm-truncate-lines (and docsig helm-popup-tip-mode)) - (category (or (eq (completion-metadata-get metadata 'category) 'file) - (eq (plist-get completion-extra-properties :category) 'file))) - (file-comp-p (or (eq category 'file) - (helm-guess-filename-at-point))) - ;; `completion-all-completions' store the base-size in the last `cdr', - ;; so data looks like this: '(a b c d . 0) and (last data) == (d . 0). - base-size - (compfn (lambda (str _predicate _action) - (let* ((completion-lazy-hilit t) - (completion-ignore-case (helm-set-case-fold-search)) - ;; Use a copy of metadata to avoid accumulation of - ;; adjustment in metadata (This is not needed in - ;; emacs-31+, it has been fixed in emacsbug - ;; #74718). This also avoid the flex adjustment fn - ;; reusing the previous sort fn. - (md (copy-sequence metadata)) - (comps - (completion-all-completions - str ; This is helm-pattern - collection - predicate - ;; Use prefix length at first call to - ;; allow styles matching - ;; "prefix*suffix" to kick in. - (length (or prefix str)) - md)) - (last-data (last comps)) - (bs (helm-aif (cdr last-data) - (prog1 it - ;; Remove the last element of - ;; comps by side-effect. - (setcdr last-data nil)) - 0)) - ;; Helm style sort fn is added to metadata only in - ;; emacs-27 by adjustment , so in 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) - (or - ;; Emacs-27+ - (completion-metadata-get - md '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 - ;; args-out-of-range error). - (and prefix (setq prefix nil)) - ;; base-size needs to be set only once at - ;; first call. - (unless base-size (setq base-size bs)) - (setq helm-completion--sorting-done (and sort-fn t)) - (setq all (copy-sequence comps)) - (if (and sort-fn (> (length str) 0)) - (funcall sort-fn all) - all)))) - (data (if (memq helm-completion-style '(helm helm-fuzzy)) - (funcall compfn input nil nil) - compfn)) - (result (if (stringp data) - data - (helm-comp-read - ;; Completion-at-point and friends have no prompt, - ;; we have a prompt only with CRM, in this case - ;; reuse it. Handle the case where user switched out - ;; of minibuffer, leaving an active minibuffer open. - (or (and (minibufferp (current-buffer)) - (minibuffer-prompt)) - "Pattern: ") - data - :name str-command - :nomark (null crm) - :marked-candidates crm - :initial-input - (cond ((and file-comp-p - (not (string-match "/\\'" initial-input))) - (helm-mode--completion-in-region-initial-input - (if (memq helm-completion-style '(helm helm-fuzzy)) - (helm-basename initial-input) - initial-input))) - ((string-match "/\\'" initial-input) - (and (eq helm-completion-style 'emacs) initial-input)) - (t (helm-mode--completion-in-region-initial-input initial-input))) - :buffer buf-name - :fc-transformer - ;; When afun afix and category are nil - ;; helm-completion--decorate returns - ;; candidates (COMPS) unmodified and - ;; helm-completion-in-region-default-sort-fn returns - ;; its candidates unmodified when sorting is already done. - (append (list (lambda (candidates source) - (helm-completion--decorate - ;; Magit is disabling sorting in its - ;; `magit-completing-read-multiple' by let binding - ;; `helm-completion-in-region-default-sort-fn' to - ;; nil to prevent modifying candidates order (bug #2689). - (if helm-completion-in-region-default-sort-fn - (funcall helm-completion-in-region-default-sort-fn - candidates source) - candidates) - afun afix category))) - '(helm-cr-default-transformer)) - :popup-info docsig - :match-dynamic (eq helm-completion-style 'emacs) - :fuzzy (eq helm-completion-style 'helm-fuzzy) - :exec-when-only-one t - :keymap helm-comp-in-region-map - :quit-when-no-cand - (lambda () - ;; Delay message to overwrite "Quit". - (run-with-timer - 0.01 nil - (lambda () - (message "[No matches]"))) - t) ; exit minibuffer immediately. - :must-match require-match)))) - ;; `helm-completion-in-region--insert-result' is stripping - ;; out properties on RESULT by side-effect (perhaps - ;; `choose-completion-string'?) so make a copy of STRING - ;; to not loose props. - (setq string (copy-sequence result)) - (helm-completion-in-region--insert-result - result start point end base-size)) - ;; Allow running extra property `:exit-function' (Bug#2265, - ;; Bug#2356). Function is called with 'exact if the return value of - ;; `try-completion' is a string ending with / (possibly a directory - ;; Bug#2274), otherwise it is always called with 'finished. However it - ;; is still not clear what to use, the documentation on this beeing - ;; really bad (see bug#2646). - (when (and (stringp string) exit-fun) - (funcall exit-fun string - (helm-acase (try-completion initial-input collection predicate) - ((guard* (and (stringp it) - (or (string-match "/\\'" it) - ;; Fix bug#2669. - (string-match "/\\'" string)))) - 'exact) - (t 'finished)))) - (remove-hook 'helm-before-action-hook 'helm-completion-in-region--selection) - (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))))) - -(defvar helm-crm-default-separator "," - "Default separator for `completing-read-multiple'. - -`crm-separator' will take precedence on this when it is a string composed -of a single character. -If used globally, it is a string composed of a single character, -if let-bounded, it can be also nil or a symbol which mean no -separator. Don't set this to a string composed of more than one -character. -Be sure to know what you are doing when modifying this.") -(defun helm-completion-in-region--insert-result (result start point end base-size) - (cond ((stringp result) - ;; When RESULT have annotation, annotation is displayed - ;; in it with a display property attached to a space - ;; added at end of string, take care of removing this - ;; space (Bug#2360). However keep RESULT intact to - ;; pass it to `:exit-function' i.e. Don't store the - ;; modified string in STRING. - (choose-completion-string - (replace-regexp-in-string " \\'" "" result) - (current-buffer) - (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 (or (and - ;; If `crm-separator' is a string of length 1 - ;; assume it can be used as separator (Bug#2298), - ;; otherwise it is a regexp and use the value - ;; it matches or default to "," if no match. - (eq (length crm-separator) 1) - crm-separator) - (and (stringp crm-separator) - (or (get-text-property 0 'separator crm-separator) - (string-replace "[ \t]*" "" crm-separator))) - helm-crm-default-separator))) - ;; Try to find a default separator. If `crm-separator' is a - ;; regexp use the string the regexp is matching. - ;; If SEP is not a string, it have been probably bound to a - ;; symbol or nil through `helm-crm-default-separator' that serve - ;; as a flag to say "Please no separator" (Bug#2353 with - ;; `magit-completing-read-multiple'). - (if (stringp sep) - (save-excursion - (goto-char beg) - (when (looking-back crm-separator (1- (point))) - (setq sep (match-string 0)))) - (setq sep nil)) - (when (> emacs-major-version 29) - (add-function :override (local 'completion-list-insert-choice-function) - #'helm--crm-insert-fn)) - (funcall completion-list-insert-choice-function - beg end (mapconcat 'identity (append result '("")) sep)))) - (t nil))) - -(defun helm--crm-insert-fn (_start _end choice) - ;; Fix Emacs bug~76461. - (let* ((beg (save-excursion - (if (and (re-search-backward crm-separator nil t) - ;; Matches end of prompt (:) when sep is ":". - (not (field-at-pos (point)))) - (1+ (point)) - (minibuffer-prompt-end)))) - (end (save-excursion - (if (re-search-forward crm-separator nil t) - (1- (point)) - (point-max))))) - (completion--replace beg end choice))) - -(defun helm-mode--disable-ido-maybe (&optional from-hook) - (when (and (boundp 'ido-everywhere) ido-everywhere) - (remove-function read-file-name-function #'ido-read-file-name) - (remove-function read-buffer-function #'ido-read-buffer) - (setq ido-everywhere nil) - (if from-hook - (user-error "Unable to turn on Ido-everywhere while Helm-mode is enabled") - (user-error "Helm-mode enabled (Ido-everywhere is incompatible with Helm-mode, disabling it)")))) - -(defun helm-mode--ido-everywhere-hook () - ;; Called only when user calls directly ido-everywhere - ;; and helm-mode is enabled. - (when helm-mode - (helm-mode--disable-ido-maybe t))) - -;;;###autoload -(define-minor-mode helm-mode - "Toggle generic helm completion. - -All functions in Emacs that use `completing-read', -`read-file-name', `completion-in-region' and friends will use helm -interface when this mode is turned on. - -However you can modify this behavior for functions of your choice -with `helm-completing-read-handlers-alist'. - -Called with a positive arg, turn on unconditionally, with a -negative arg turn off. -You can toggle it with M-x `helm-mode'. - -About `ido-mode': -DO NOT enable `ido-everywhere' when using `helm-mode'. Instead of -using `ido-mode', add the commands where you want to use ido to -`helm-completing-read-handlers-alist' with `ido' as value. - -Note: This mode is incompatible with Emacs23." - :group 'helm-mode - :global t - :lighter helm-completion-mode-string - (cl-assert (boundp 'completing-read-function) nil - "`helm-mode' not available, upgrade to Emacs-24") - (if helm-mode - (progn - (add-function :override completing-read-function - #'helm--completing-read-default) - (add-function :override read-file-name-function - #'helm--generic-read-file-name) - (add-function :override read-buffer-function - #'helm--generic-read-buffer) - (when helm-mode-handle-completion-in-region - (add-function :around completion-in-region-function - #'helm--completion-in-region)) - ;; If user have enabled ido-everywhere BEFORE enabling - ;; helm-mode disable it and warn user about its - ;; incompatibility with helm-mode (Bug#2085). - (helm-mode--disable-ido-maybe) - ;; If ido-everywhere is not enabled yet anticipate and - ;; disable it if user attempt to enable it while helm-mode - ;; is running (Bug#2085). - (add-hook 'ido-everywhere-hook #'helm-mode--ido-everywhere-hook) - (when (fboundp 'ffap-read-file-or-url-internal) - ;; `ffap-read-file-or-url-internal' have been removed in - ;; emacs-27 and `ffap-read-file-or-url' is fixed, so no need - ;; to advice it. - (advice-add 'ffap-read-file-or-url :override #'helm-advice--ffap-read-file-or-url)) - (advice-add 'read-buffer-to-switch :override #'helm-mode--read-buffer-to-switch) - (helm-minibuffer-history-mode 1)) - (progn - (remove-function completing-read-function #'helm--completing-read-default) - (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) - (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)) - (advice-remove 'read-buffer-to-switch #'helm-mode--read-buffer-to-switch) - (helm-minibuffer-history-mode -1)))) - -(provide 'helm-mode) - -;;; helm-mode.el ends here diff --git a/elpa/helm-20251212.555/helm-net.el b/elpa/helm-20251212.555/helm-net.el deleted file mode 100644 index 0540c828..00000000 --- a/elpa/helm-20251212.555/helm-net.el +++ /dev/null @@ -1,469 +0,0 @@ -;;; helm-net.el --- helm browse url and search web. -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2025 Thierry Volpiatto - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Code: - -(require 'cl-lib) -(require 'helm) -(require 'helm-help) -(require 'url) -(require 'xml) -(require 'browse-url) - -(declare-function helm-comp-read "helm-mode") - - -(defgroup helm-net nil - "Net related applications and libraries for Helm." - :group 'helm) - -(defcustom helm-google-suggest-default-browser-function nil - "The browse url function you prefer to use with Google suggest. -When nil, use the first browser function available -See `helm-browse-url-default-browser-alist'." - :group 'helm-net - :type 'symbol) - -(defcustom helm-home-url "https://www.google.com" - "Default url to use as home url." - :group 'helm-net - :type 'string) - -(defcustom helm-surfraw-default-browser-function nil - "The browse url function you prefer to use with surfraw. -When nil, fallback to `browse-url-browser-function'." - :group 'helm-net - :type 'symbol) - -(defcustom helm-google-suggest-url - "https://encrypted.google.com/complete/search?output=toolbar&q=%s" - "URL used for looking up Google suggestions. -This is a format string, don't forget the `%s'." - :type 'string - :group 'helm-net) - -(defcustom helm-google-suggest-search-url - "https://encrypted.google.com/search?ie=utf-8&oe=utf-8&q=%s" - "URL used for Google searching. -This is a format string, don't forget the `%s'." - :type 'string - :group 'helm-net) - -(defvaralias 'helm-google-suggest-use-curl-p 'helm-net-prefer-curl) -(make-obsolete-variable 'helm-google-suggest-use-curl-p 'helm-net-prefer-curl "1.7.7") - -(defcustom helm-net-prefer-curl nil - "When non--nil use CURL external program to fetch data. -Otherwise `url-retrieve-synchronously' is used." - :type 'boolean - :group 'helm-net) - -(defcustom helm-surfraw-duckduckgo-url - "https://duckduckgo.com/lite/?q=%s&kp=1" - "The Duckduckgo url. -This is a format string, don't forget the `%s'. -If you have personal settings saved on duckduckgo you should have -a personal url, see your settings on duckduckgo." - :type 'string - :group 'helm-net) - -(defcustom helm-search-suggest-action-wikipedia-url - "https://en.wikipedia.org/wiki/Special:Search?search=%s" - "The Wikipedia search url. -This is a format string, don't forget the `%s'." - :type 'string - :group 'helm-net) - -(defcustom helm-search-suggest-action-youtube-url - "https://www.youtube.com/results?aq=f&search_query=%s" - "The Youtube search url. -This is a format string, don't forget the `%s'." - :type 'string - :group 'helm-net) - -(defcustom helm-search-suggest-action-imdb-url - "http://www.imdb.com/find?s=all&q=%s" - "The IMDb search url. -This is a format string, don't forget the `%s'." - :type 'string - :group 'helm-net) - -(defcustom helm-search-suggest-action-google-maps-url - "https://maps.google.com/maps?f=q&source=s_q&q=%s" - "The Google Maps search url. -This is a format string, don't forget the `%s'." - :type 'string - :group 'helm-net) - -(defcustom helm-search-suggest-action-google-news-url - "https://www.google.com/search?safe=off&prmd=nvlifd&source=lnms&tbs=nws:1&q=%s" - "The Google News search url. -This is a format string, don't forget the `%s'." - :type 'string - :group 'helm-net) - -(defcustom helm-google-suggest-actions - (helm-make-actions - "Google Search" 'helm-google-suggest-action - "Wikipedia" (lambda (candidate) - (helm-search-suggest-perform-additional-action - helm-search-suggest-action-wikipedia-url - candidate)) - "Youtube" (lambda (candidate) - (helm-search-suggest-perform-additional-action - helm-search-suggest-action-youtube-url - candidate)) - "IMDb" (lambda (candidate) - (helm-search-suggest-perform-additional-action - helm-search-suggest-action-imdb-url - candidate)) - "Google Maps" (lambda (candidate) - (helm-search-suggest-perform-additional-action - helm-search-suggest-action-google-maps-url - candidate)) - "Google News" (lambda (candidate) - (helm-search-suggest-perform-additional-action - helm-search-suggest-action-google-news-url - candidate))) - "List of actions for google suggest sources." - :group 'helm-net - :type '(alist :key-type string :value-type function)) - -(defcustom helm-browse-url-firefox-new-window "--new-tab" - "Allow choosing to browse url in new window or new tab. -Can be \"--new-tab\" (default), \"--new-window\" or \"--private-window\"." - :group 'helm-net - :type '(radio - (const :tag "New tab" "--new-tab") - (const :tag "New window" "--new-window") - (const :tag "New private window" "--private-window"))) - -(defcustom helm-net-curl-switches '("-s" "-L") - "Arguments list passed to curl when using `helm-net-prefer-curl'." - :group 'helm-net - :type '(repeat string)) - -;;; Additional actions for search suggestions -;; -;; -;; Internal -(defvar helm-net-curl-log-file (expand-file-name "helm-curl.log" user-emacs-directory)) -(defun helm-search-suggest-perform-additional-action (url query) - "Perform the search via URL using QUERY as input." - (browse-url (format url (url-hexify-string query)))) - -(defun helm-net--url-retrieve-sync (request parser) - (if helm-net-prefer-curl - (with-temp-buffer - (apply #'call-process "curl" - nil `(t ,helm-net-curl-log-file) nil request helm-net-curl-switches) - (funcall parser)) - (with-current-buffer (url-retrieve-synchronously request) - (funcall parser)))) - - -;;; Google Suggestions -;; -;; -(defun helm-google-suggest-parser () - (cl-loop - with result-alist = (xml-get-children - (car (xml-parse-region - (point-min) (point-max))) - 'CompleteSuggestion) - for i in result-alist collect - (cdr (cl-caadr (assq 'suggestion i))))) - -(defun helm-google-suggest-fetch (input) - "Fetch suggestions for INPUT from XML buffer." - (let ((request (format helm-google-suggest-url - (url-hexify-string input)))) - (helm-net--url-retrieve-sync - request #'helm-google-suggest-parser))) - -(defun helm-google-suggest-set-candidates (&optional request-prefix) - "Set candidates with result and number of Google results found." - (let ((suggestions (helm-google-suggest-fetch - (or (and request-prefix - (concat request-prefix - " " helm-pattern)) - helm-pattern)))) - (if (member helm-pattern suggestions) - suggestions - ;; if there is no suggestion exactly matching the input then - ;; prepend a Search on Google item to the list - (append - suggestions - (list (cons (format "Search for '%s' on Google" helm-input) - helm-input)))))) - -(defun helm-ggs-set-number-result (num) - (if num - (progn - (and (numberp num) (setq num (number-to-string num))) - (cl-loop for i in (reverse (split-string num "" t)) - for count from 1 - append (list i) into C - when (= count 3) - append (list ",") into C - and do (setq count 0) - finally return - (replace-regexp-in-string - "^," "" (mapconcat 'identity (reverse C) "")))) - "?")) - -(defun helm-google-suggest-action (candidate) - "Default action to jump to a Google suggested candidate." - (let ((arg (format helm-google-suggest-search-url - (url-hexify-string candidate)))) - (helm-aif helm-google-suggest-default-browser-function - (funcall it arg) - (helm-browse-url arg)))) - -(defvar helm-google-suggest-default-function - 'helm-google-suggest-set-candidates - "Default function to use in `helm-google-suggest'.") - -(defvar helm-source-google-suggest - (helm-build-sync-source "Google Suggest" - :candidates (lambda () - (funcall helm-google-suggest-default-function)) - :action 'helm-google-suggest-actions - :match-dynamic t - :keymap helm-map - :requires-pattern 3)) - -(defun helm-google-suggest-emacs-lisp () - "Try to emacs lisp complete with Google suggestions." - (helm-google-suggest-set-candidates "emacs lisp")) - - -;;; Web browser functions. -;; -;; -;; If default setting of `w3m-command' is not -;; what you want and you modify it, you will have to reeval -;; also `helm-browse-url-default-browser-alist'. - -(defvar helm-browse-url-chromium-program "chromium-browser") -(defvar helm-browse-url-brave-program "brave-browser") -(defvar helm-browse-url-uzbl-program "uzbl-browser") -(defvar helm-browse-url-nyxt-program "nyxt") -(defvar helm-browse-url-conkeror-program "conkeror") -(defvar helm-browse-url-opera-program "opera") -(defvar helm-browse-url-w3m-program (or (and (boundp 'w3m-command) w3m-command) - (executable-find "w3m"))) -(defvar helm-browse-url-default-browser-alist - '((helm-browse-url-w3m-program . w3m-browse-url) - (browse-url-firefox-program . browse-url-firefox) - (helm-browse-url-chromium-program . helm-browse-url-chromium) - (helm-browse-url-brave-program . helm-browse-url-brave) - (helm-browse-url-conkeror-program . helm-browse-url-conkeror) - (helm-browse-url-opera-program . helm-browse-url-opera) - (helm-browse-url-uzbl-program . helm-browse-url-uzbl) - (helm-browse-url-nyxt-program . helm-browse-url-nyxt) - (browse-url-kde-program . browse-url-kde) - (browse-url-gnome-moz-program . browse-url-gnome-moz) - (browse-url-mozilla-program . browse-url-mozilla) - (browse-url-galeon-program . browse-url-galeon) - (browse-url-netscape-program . browse-url-netscape) - (browse-url-xterm-program . browse-url-text-xterm) - ("emacs" . eww-browse-url)) - "Alist of (browse_url_variable . function) to try to find a suitable url browser.") - -(defun helm-generic-browser (url cmd-name &rest args) - "Browse URL with NAME browser." - (let ((proc (concat cmd-name " " url))) - (message "Starting %s..." cmd-name) - (apply 'start-process proc nil cmd-name - (append args (list url))) - (set-process-sentinel - (get-process proc) - (lambda (process event) - (when (string= event "finished\n") - (message "%s process %s" process event)))))) - -(defun helm-browse-url-detached (cmd url &optional new-tab) - "Browse URL with browser CMD and detach it from Emacs. - -NEW-TAB is the command line argument supported by CMD e.g. \"--new-tab\". - -So when you quit Emacs you can keep your browser session open and -not be prompted to kill the browser process. - -NOTE: Probably not supported on some systems (e.g., Windows)." - (setq url (browse-url-encode-url url)) - (setq new-tab (if (stringp new-tab) - (concat " " (replace-regexp-in-string - " " "" new-tab)) - "")) - (let ((process-environment (browse-url-process-environment))) - (call-process-shell-command - (format "(%s%s %s &)" cmd new-tab (shell-quote-argument url))))) - -;;;###autoload -(defun helm-browse-url-firefox (url &optional _ignore) - "Same as `browse-url-firefox' but detach from Emacs. - -So when you quit Emacs you can keep your Firefox session open and -not be prompted to kill the Firefox process. - -NOTE: Probably not supported on some systems (e.g., Windows)." - (interactive (list (read-string "URL: " (browse-url-url-at-point)) - nil)) - (helm-browse-url-detached browse-url-firefox-program url - helm-browse-url-firefox-new-window)) - -;;;###autoload -(defun helm-browse-url-opera (url &optional _ignore) - "Browse URL with Opera browser and detach from Emacs. - -So when you quit Emacs you can keep your Opera session open and -not be prompted to kill the Opera process. - -NOTE: Probably not supported on some systems (e.g., Windows)." - (interactive (list (read-string "URL: " (browse-url-url-at-point)) - nil)) - (helm-browse-url-detached helm-browse-url-opera-program url)) - -;;;###autoload -(defun helm-browse-url-chromium (url &optional _ignore) - "Same as `browse-url-chromium' but detach from emacs. - -So when you quit Emacs you can keep your Chromium session open and -not be prompted to kill the Chromium process. - -NOTE: Probably not supported on some systems (e.g., Windows)." - (interactive (list (read-string "URL: " (browse-url-url-at-point)) - nil)) - (helm-browse-url-detached - helm-browse-url-chromium-program url)) - -;;;###autoload -(defun helm-browse-url-brave (url &optional _ignore) - "Browse URL with Brave browser and detach from emacs. - -Brave browser executable is determined by `helm-browse-url-brave-program'. - -So when you quit Emacs you can keep your Opera session open and -not be prompted to kill the Opera process. - -NOTE: Probably not supported on some systems (e.g., Windows)." - (interactive (list (read-string "URL: " (browse-url-url-at-point)) - nil)) - (helm-browse-url-detached - helm-browse-url-brave-program url "--new-tab")) - -;;;###autoload -(defun helm-browse-url-uzbl (url &optional _ignore) - "Browse URL with uzbl browser." - (interactive "sURL: ") - (helm-generic-browser url helm-browse-url-uzbl-program "-u")) - -;;;###autoload -(defun helm-browse-url-conkeror (url &optional _ignore) - "Browse URL with conkeror browser." - (interactive "sURL: ") - (helm-generic-browser url helm-browse-url-conkeror-program)) - -;;;###autoload -(defun helm-browse-url-nyxt (url &optional _ignore) - "Browse URL with nyxt browser." - (interactive "sURL: ") - (helm-generic-browser url helm-browse-url-nyxt-program)) - -(defun helm-browse-url-default-browser (url &rest args) - "Find the first available browser and ask it to load URL." - (let ((default-browser-fn - (cl-loop for (var . fn) in helm-browse-url-default-browser-alist - for exe = (if (stringp var) - var - (and (boundp var) (symbol-value var))) - thereis (and exe (executable-find exe) (fboundp fn) fn)))) - (if default-browser-fn - (apply default-browser-fn url args) - (error "No usable browser found")))) - -(defun helm-browse-url (url &rest args) - "Default command to browse URL." - (if browse-url-browser-function - (browse-url url args) - (helm-browse-url-default-browser url args))) - - -;;; Surfraw -;; -;; Need external program surfraw. -;; - -;; Internal -(defvar helm-surfraw-engines-history nil) -(defvar helm-surfraw-input-history nil) -(defvar helm-surfraw--elvi-cache nil) - -(defun helm-build-elvi-list () - "Return list of all engines and descriptions handled by surfraw." - (or helm-surfraw--elvi-cache - (setq helm-surfraw--elvi-cache - (cdr (with-temp-buffer - (call-process "surfraw" nil t nil "-elvi") - (split-string (buffer-string) "\n")))))) - -;;;###autoload -(defun helm-surfraw (pattern engine) - "Preconfigured `helm' to search PATTERN with search ENGINE." - (interactive - (list - (let* ((default (if (use-region-p) - (buffer-substring-no-properties - (region-beginning) (region-end)) - (thing-at-point 'symbol))) - (prompt (if default - (format "SearchFor (default %s): " default) - "SearchFor: "))) - (read-string prompt nil 'helm-surfraw-input-history default)) - (helm-comp-read - "Engine: " - (helm-build-elvi-list) - :must-match t - :name "Surfraw Search Engines" - :history 'helm-surfraw-engines-history))) - (let* ((engine-nodesc (car (split-string engine))) - (url (if (string= engine-nodesc "duckduckgo") - ;; "sr duckduckgo -p foo" is broken, workaround. - (format helm-surfraw-duckduckgo-url - (url-hexify-string pattern)) - (with-temp-buffer - (apply 'call-process "surfraw" nil t nil - (append (list engine-nodesc "-p") (split-string pattern))) - (replace-regexp-in-string - "\n" "" (buffer-string))))) - (browse-url-browser-function (or helm-surfraw-default-browser-function - browse-url-browser-function))) - (if (string= engine-nodesc "W") - (helm-browse-url helm-home-url) - (helm-browse-url url)))) - -;;;###autoload -(defun helm-google-suggest () - "Preconfigured `helm' for Google search with Google suggest." - (interactive) - (helm :sources 'helm-source-google-suggest :buffer "*helm google*")) - -(provide 'helm-net) - -;;; helm-net.el ends here diff --git a/elpa/helm-20251212.555/helm-occur.el b/elpa/helm-20251212.555/helm-occur.el deleted file mode 100644 index f523b0f1..00000000 --- a/elpa/helm-20251212.555/helm-occur.el +++ /dev/null @@ -1,937 +0,0 @@ -;;; helm-occur.el --- Incremental Occur for Helm. -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2025 Thierry Volpiatto - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - - -;;; Code: - -(require 'cl-lib) -(require 'helm) -(require 'helm-help) -(require 'helm-utils) - -(declare-function helm-buffers-get-visible-buffers "helm-buffers") -(declare-function helm-buffer-list "helm-buffers") -(declare-function helm-grep-split-line "helm-grep") -(declare-function helm-grep-highlight-match "helm-grep") -(declare-function helm-grep-ag-1 "helm-grep") -(declare-function helm-grep--ag-command "helm-grep") -(declare-function helm-comp-read "helm-mode") - -(defvar helm-current-error) - -;;; Internals -;; -(defvar helm-source-occur nil - "This will be the name of the source related to `current-buffer'. -Don't use it as it value changes always.") -(defvar helm-source-moccur nil - "This is just a flag to add to `helm-sources-using-default-as-input'. -Don't set it to any value, it will have no effect.") -(defvar helm-occur--buffer-list nil) -(defvar helm-occur--buffer-tick nil) -(defvar helm-occur-history nil) -(defvar helm-occur--search-buffer-regexp "\\`\\([0-9]*\\)\\s-\\(.*\\)\\'" - "The regexp matching candidates in helm-occur candidate buffer.") -(defvar helm-occur-mode--last-pattern nil) -(defvar helm-occur--initial-pos 0) - -(defvar helm-occur-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-map) - (define-key map (kbd "C-c o") 'helm-occur-run-goto-line-ow) - (define-key map (kbd "C-c C-o") 'helm-occur-run-goto-line-of) - (define-key map (kbd "C-x C-s") 'helm-occur-run-save-buffer) - (define-key map (kbd "C-s") 'helm-run-occur-grep-ag-buffer-directory) - map) - "Keymap used in occur source.") - -(defgroup helm-occur nil - "Regexp related Applications and libraries for Helm." - :group 'helm) - -(defcustom helm-occur-actions - '(("Go to Line" . helm-occur-goto-line) - ("Goto line other window (C-u vertically)" . helm-occur-goto-line-ow) - ("Goto line new frame" . helm-occur-goto-line-of) - ("Save buffer" . helm-occur-save-results)) - "Actions for helm-occur." - :type '(alist :key-type string :value-type function)) - -(defcustom helm-occur-use-ioccur-style-keys nil - "Similar to `helm-grep-use-ioccur-style-keys' but for multi occur. - -Note that if you define this variable with `setq' your change will -have no effect, use customize instead." - :type 'boolean - :set (lambda (var val) - (set var val) - (if val - (progn - (define-key helm-occur-map (kbd "") 'helm-occur-right) - (define-key helm-occur-map (kbd "") 'helm-occur-run-default-action)) - (define-key helm-occur-map (kbd "") nil) - (define-key helm-occur-map (kbd "") nil)))) - -(defcustom helm-occur-always-search-in-current nil - "Helm multi occur always search in current buffer when non--nil." - :type 'boolean) - -(defcustom helm-occur-truncate-lines t - "Truncate lines in occur buffer when non nil." - :type 'boolean) - -(defcustom helm-occur-auto-update-on-resume nil - "Allow auto updating helm-occur buffer when outdated. -noask => Always update without asking -nil => Don't update but signal buffer needs update -never => Never update and do not signal buffer needs update -Any other non--nil value update after confirmation." - :type '(radio :tag "Allow auto updating helm-occur buffer when outdated." - (const :tag "Always update without asking" noask) - (const :tag "Never update and do not signal buffer needs update" never) - (const :tag "Don't update but signal buffer needs update" nil) - (const :tag "Update after confirmation" t))) - -(defcustom helm-occur-candidate-number-limit 99999 - "Value of `helm-candidate-number-limit' for helm-occur." - :type 'integer) - -(defcustom helm-occur-buffer-substring-fn-for-modes - '((mu4e-headers-mode . buffer-substring)) - "Function used to display buffer contents per major-mode. - -Use this to display lines with their text properties in helm-occur -buffer. Can be one of `buffer-substring' or `buffer-substring-no-properties'. -See `helm-occur-buffer-substring-default-mode' to setup this globally. - -Note that when using `buffer-substring' initialization will be slower." - :type '(alist :key-type (symbol :tag "Mode") - :value-type (radio (const :tag "With text properties" - buffer-substring) - (const :tag "Without text properties" - buffer-substring-no-properties)))) - -(defcustom helm-occur-buffer-substring-default-mode - 'buffer-substring-no-properties - "Function used to display buffer contents in helm-occur buffer. - -Default mode for major modes not defined in -`helm-occur-buffer-substring-fn-for-modes'. -Can be one of `buffer-substring' or `buffer-substring-no-properties'. - -Note that when using `buffer-substring' initialization will be -slower. If buffer-substring, all buffers with the modes not -defined in helm-occur-buffer-substring-fn-for-modes will be -displayed with colors and properties in the helm-occur buffer" - :type '(radio - (const :tag "With text properties" buffer-substring) - (const :tag "Without text properties" buffer-substring-no-properties))) - -(defcustom helm-occur-keep-closest-position t - "When non nil select closest candidate from point after update. -This happen only in `helm-source-occur' which is always related to -`current-buffer'." - :type 'boolean) - -(defcustom helm-occur-ignore-diacritics nil - "When non nil helm-occur will ignore diacritics in patterns." - :type 'boolean) - -(defcustom helm-occur-match-shorthands nil - "Transform pattern according to `read-symbol-shorthands' when non nil." - :type 'boolean) - -(defface helm-moccur-buffer - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :foreground "DarkTurquoise" :underline t)) - "Face used to highlight occur buffer names.") - -(defface helm-resume-need-update - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :background "red")) - "Face used to flash occur buffer when it needs update.") - - -(defun helm-occur--select-closest-candidate () - ;; Prevent error with `with-helm-window' when switching to help. - (unless (or (not (get-buffer-window helm-buffer 'visible)) - (string-equal helm-pattern "")) - (with-helm-window - (let ((lst '()) - ;; `helm-source-occur' name is "Helm occur" when using `helm-occur' - ;; command (searching and starting from current-buffer), whereas it - ;; has the name of current-buffer when using `helm-multi-occur-1'. - (name (helm-get-attr 'name helm-source-occur)) - closest beg end) - (while-no-input - (goto-char (point-min)) - (cond ((string= name "Helm occur") - (setq beg (point) - end (point-max))) - ;; The source corresponding to helm-current-buffer should be - ;; always on top, so no need to search for it by looping in - ;; helm-buffer. - ((string= name (buffer-substring-no-properties - (pos-bol) (pos-eol))) - (forward-line 1) - (setq beg (point) - end (or (helm-get-next-header-pos) (point-max))))) - (save-excursion - (when (and beg end) - (goto-char beg) - (while (re-search-forward "^[0-9]+" end t) - (push (string-to-number (match-string 0)) lst)) - (setq closest (helm-closest-number-in-list - helm-occur--initial-pos lst)))) - (when (and closest (re-search-forward (format "^%s" closest) end t)) - (helm-mark-current-line) - (goto-char (overlay-start - helm-selection-overlay)))))))) - -;;;###autoload -(defun helm-occur () - "Preconfigured helm for searching lines matching pattern in `current-buffer'. - -When `helm-source-occur' is member of -`helm-sources-using-default-as-input' which is the default, -symbol at point is searched at startup. - -When a region is marked search only in this region by narrowing. - -To search in multiples buffers start from one of the commands listing -buffers (i.e. a helm command using `helm-source-buffers-list' like -`helm-mini') and use the multi occur buffers action. - -This is the helm implementation that collect lines matching pattern -like vanilla Emacs `occur' but have nothing to do with it, the search -engine beeing completely different and also much faster." - (interactive) - (setq helm-source-occur - (car (helm-occur-build-sources (list (current-buffer)) "Helm occur"))) - (helm-set-local-variable 'helm-occur--buffer-list (list (current-buffer)) - 'helm-occur--buffer-tick - (list (buffer-chars-modified-tick (current-buffer)))) - (helm-set-attr 'header-name (lambda (_name) - (format "HO [%s]" - (buffer-name helm-current-buffer))) - helm-source-occur) - (when helm-occur-keep-closest-position - (setq helm-occur--initial-pos (line-number-at-pos)) - (add-hook 'helm-after-update-hook 'helm-occur--select-closest-candidate)) - (save-restriction - (let ((helm-sources-using-default-as-input - (unless (> (buffer-size) 2000000) - helm-sources-using-default-as-input)) - def pos) - (when (use-region-p) - ;; When user mark defun with `mark-defun' with intention of - ;; using helm-occur on this region, it is relevant to use the - ;; thing-at-point located at previous position which have been - ;; pushed to `mark-ring', if it's within the active region. - (let ((beg (region-beginning)) - (end (region-end)) - (prev-pos (car mark-ring))) - (when (and prev-pos (>= prev-pos beg) (< prev-pos end)) - (setq def (save-excursion - (goto-char (setq pos prev-pos)) - (helm-aif (thing-at-point 'symbol) (regexp-quote it))))) - (narrow-to-region beg end))) - (unwind-protect - (helm :sources 'helm-source-occur - :buffer "*helm occur*" - :history 'helm-occur-history - :default (or def (helm-aif (thing-at-point 'symbol) - (regexp-quote it))) - :preselect (and (memq 'helm-source-occur - helm-sources-using-default-as-input) - (format "^%d:" (line-number-at-pos - (or pos (point))))) - :truncate-lines helm-occur-truncate-lines) - (deactivate-mark t) - (remove-hook 'helm-after-update-hook 'helm-occur--select-closest-candidate))))) - -;;;###autoload -(defun helm-occur-visible-buffers () - "Run helm-occur on all visible buffers in frame." - (interactive) - (require 'helm-buffers) - (if (or (one-window-p) (region-active-p)) - (call-interactively #'helm-occur) - (let ((buffers (helm-buffers-get-visible-buffers))) - (helm-multi-occur-1 (mapcar 'get-buffer buffers))))) - -(defun helm-occur-transformer (candidates source) - "Return CANDIDATES prefixed with line number." - (cl-loop with buf = (helm-get-attr 'buffer-name source) - for c in candidates - for bfname = (buffer-file-name (get-buffer buf)) - for disp-linum = (when (string-match helm-occur--search-buffer-regexp c) - (let ((linum (match-string 1 c)) - (disp (match-string 2 c))) - (list - linum - (format "%s:%s" - (propertize - linum - 'face 'helm-grep-lineno - 'help-echo bfname - 'helm-grep-fname bfname) - disp)))) - for linum = (car disp-linum) - for disp = (cadr disp-linum) - when (and disp (not (string= disp ""))) - collect (cons disp (string-to-number linum)))) - -(defvar helm-occur--gshorthands nil) -(defun helm-occur-symbol-shorthands-pattern-transformer (pattern buffer gshorthands) - "Maybe transform PATTERN to its `read-symbol-shorthands' counterpart in BUFFER. - -GSHORTHANDS is the concatenation of all `read-symbol-shorthands' value found in -all buffers i.e. `buffer-list'. -When GSHORTHANDS is nil use PATTERN unmodified." - (if gshorthands - (let* ((lshorthands (buffer-local-value 'read-symbol-shorthands buffer)) - (prefix (cl-loop for (k . v) in gshorthands - if (string-match (concat "\\`" k) pattern) - return k - else - if (string-match (concat "\\`" v) pattern) - return v)) - (lgstr (cdr (or (assoc prefix gshorthands) - (rassoc prefix gshorthands))))) - (if (and lgstr lshorthands) - (concat (car (rassoc lgstr lshorthands)) - (replace-regexp-in-string prefix "" pattern)) - pattern)) - pattern)) - -(defclass helm-moccur-class (helm-source-in-buffer) - ((buffer-name :initarg :buffer-name - :initform nil) - (moccur-buffers :initarg :moccur-buffers - :initform nil) - (find-file-target :initform #'helm-occur-quit-an-find-file-fn))) - -(defun helm-occur-build-sources (buffers &optional source-name) - "Build sources for `helm-occur' for each buffer in BUFFERS list." - (require 'helm-grep) - (setq helm-occur--gshorthands nil) - (and helm-occur-match-shorthands - (setq helm-occur--gshorthands - (cl-loop for b in (buffer-list) - for rss = (buffer-local-value - 'read-symbol-shorthands - b) - when rss append rss))) - (let (sources) - (dolist (buf buffers) - (let ((bname (buffer-name buf))) - (push (helm-make-source (or source-name bname) - 'helm-moccur-class - :header-name (lambda (name) - (format "HO [%s]" (if (string= name "Helm occur") - bname name))) - :buffer-name bname - :match-part - (lambda (candidate) - ;; The regexp should match what is in candidate buffer, - ;; not what is displayed in helm-buffer e.g. "12 foo" - ;; and not "12:foo". - (when (string-match helm-occur--search-buffer-regexp - candidate) - (match-string 2 candidate))) - :diacritics helm-occur-ignore-diacritics - :search (lambda (pattern) - (when (string-match "\\`\\^\\(.*\\)" pattern) - (setq pattern (concat "^[0-9]*\\s-" (match-string 1 pattern)))) - (condition-case _err - (re-search-forward pattern nil t) - (invalid-regexp nil))) - :pattern-transformer (lambda (pattern) - (helm-occur-symbol-shorthands-pattern-transformer - pattern buf helm-occur--gshorthands)) - :init (lambda () - (with-current-buffer buf - (let* ((bsfn (or (cdr (assq - major-mode - helm-occur-buffer-substring-fn-for-modes)) - helm-occur-buffer-substring-default-mode)) - (contents (funcall bsfn (point-min) (point-max)))) - (helm-set-attr 'get-line bsfn) - (with-current-buffer (helm-candidate-buffer 'global) - (insert contents) - (goto-char (point-min)) - (let ((linum 1)) - (insert (format "%s " linum)) - (while (re-search-forward "\n" nil t) - (cl-incf linum) - (insert (format "%s " linum)))))))) - :filtered-candidate-transformer 'helm-occur-transformer - :help-message 'helm-moccur-help-message - :nomark t - :migemo t - ;; Needed for resume. - :history 'helm-occur-history - :candidate-number-limit helm-occur-candidate-number-limit - :action (append helm-occur-actions - (helm-make-actions - (lambda () - (when helm-grep-ag-command - (format "%s grep buffer directory" - (upcase (helm-grep--ag-command))))) - 'helm-occur-grep-ag-buffer-directory)) - :requires-pattern 2 - :follow 1 - :group 'helm-occur - :keymap helm-occur-map - :resume 'helm-occur-resume-fn - :moccur-buffers buffers) - sources))) - (nreverse sources))) - -(defun helm-multi-occur-1 (buffers &optional input default) - "Run `helm-occur' on a list of buffers. -Each buffer's result is displayed in a separated source. -Arg INPUT if specified will be inserted as initial input in minibuffer. -Arg DEFAULT if specified will be inserted in minibuffer with M-n. -Arg INPUT takes precedence on DEFAULT if both are specified. -If `helm-source-moccur' is member of `helm-sources-using-default-as-input' -helm-occur will start immediately with DEFAULT as INPUT. -Always prefer using DEFAULT instead of INPUT, they have the same effect but -DEFAULT keep the minibuffer empty, allowing the user to write immediately -without having to delete its contents before." - (let* ((curbuf (get-buffer (if helm-alive-p - ;; We are starting from a helm session listing - ;; buffers, presumably helm-buffers-list or - ;; helm-mini. If we don't check for - ;; helm-alive-p and helm-multi-occur-1 is - ;; launched from e.g. isl or isearch we may - ;; reuse a old helm-current-buffer value from - ;; last helm-session. - helm-current-buffer - (current-buffer)))) - (bufs (if (or helm-occur-always-search-in-current - (memql curbuf buffers)) - (cons curbuf (remove curbuf buffers)) - buffers)) - (helm-sources-using-default-as-input - (unless (cl-loop with total_size = 0 - for b in bufs - do (setq total_size (buffer-size b)) - finally return (> total_size 2000000)) - helm-sources-using-default-as-input)) - (sources (helm-occur-build-sources bufs (and (eql curbuf (car bufs)) - (not (cdr bufs)) - "Helm occur"))) - (helm-maybe-use-default-as-input - (not (null (memq 'helm-source-moccur - helm-sources-using-default-as-input))))) - (helm-set-local-variable 'helm-occur--buffer-list bufs - 'helm-occur--buffer-tick - (cl-loop for b in bufs collect - (buffer-chars-modified-tick - (get-buffer b)))) - (when (and (eql (car bufs) curbuf) - helm-occur-keep-closest-position) - (setq helm-source-occur - (cl-loop for s in sources - when (eql helm-current-buffer - (get-buffer (helm-get-attr 'buffer-name s))) - return s)) - (setq helm-occur--initial-pos (line-number-at-pos)) - (add-hook 'helm-after-update-hook 'helm-occur--select-closest-candidate)) - (unwind-protect - (helm :sources sources - :buffer "*helm moccur*" - :history 'helm-occur-history - :default (or default - (helm-aif (thing-at-point 'symbol) - (regexp-quote it))) - :input input - :truncate-lines helm-occur-truncate-lines) - (remove-hook 'helm-after-update-hook 'helm-occur--select-closest-candidate)))) - -;;; Actions -;; -(defun helm-occur-action (lineno &optional method) - "Jump to line number LINENO with METHOD. -METHOD can be one of buffer, buffer-other-window, buffer-other-frame." - (require 'helm-grep) - (unless method (setq method 'buffer)) - (let ((buf (if (eq major-mode 'helm-occur-mode) - (get-text-property (point) 'buffer-name) - (helm-get-attr 'buffer-name))) - (split-pat (helm-mm-split-pattern helm-input))) - (cl-case method - (buffer (switch-to-buffer buf)) - (buffer-other-window (helm-window-show-buffers (list buf) t)) - (buffer-other-frame (switch-to-buffer-other-frame buf))) - (with-current-buffer buf - (helm-goto-line lineno) - ;; Move point to the nearest matching regexp from bol. - (cl-loop for str in split-pat - for reg = (helm-occur-symbol-shorthands-pattern-transformer - str (get-buffer buf) helm-occur--gshorthands) - when (save-excursion - (condition-case _err - (if helm-migemo-mode - (helm-mm-migemo-forward reg (pos-eol) t) - (re-search-forward reg (pos-eol) t)) - (invalid-regexp nil))) - collect (match-beginning 0) into pos-ls - finally (when pos-ls (goto-char (apply #'min pos-ls))))))) - -(defun helm-occur-goto-line (candidate) - "From multi occur, switch to buffer and CANDIDATE line." - (helm-occur-action - candidate 'buffer)) - -(defun helm-occur-goto-line-ow (candidate) - "Go to CANDIDATE line in other window. -Same as `helm-occur-goto-line' but go in other window." - (helm-occur-action - candidate 'buffer-other-window)) - -(defun helm-occur-goto-line-of (candidate) - "Go to CANDIDATE line in new frame. -Same as `helm-occur-goto-line' but go in new frame." - (helm-occur-action - candidate 'buffer-other-frame)) - -(helm-make-command-from-action helm-occur-run-goto-line-ow - "Run goto line other window action from `helm-occur'." - 'helm-occur-goto-line-ow) - -(helm-make-command-from-action helm-occur-run-goto-line-of - "Run goto line new frame action from `helm-occur'." - 'helm-occur-goto-line-of) - -(helm-make-command-from-action helm-occur-run-default-action - "Goto matching line from helm-occur buffer." - 'helm-occur-goto-line) - -(helm-make-command-from-action helm-occur-run-save-buffer - "Run moccur save results action from `helm-moccur'." - 'helm-occur-save-results) - -(defun helm-occur-right () - "`helm-occur' action for right arrow. -This is used when `helm-occur-use-ioccur-style-keys' is enabled. -If follow is enabled (default) go to next source, otherwise execute -persistent action." - (interactive) - (if (helm-aand (helm-get-attr 'follow) (> it 0)) - (helm-next-source) - (helm-execute-persistent-action))) -(put 'helm-occur-right 'helm-only t) - -(defun helm-occur-quit-an-find-file-fn (source) - (let* ((sel (helm-get-selection nil nil source)) - (occur-fname (helm-aand (numberp sel) - (helm-get-attr 'buffer-name) - (buffer-file-name (get-buffer it))))) - (when (and occur-fname (file-exists-p occur-fname)) - (expand-file-name occur-fname)))) - -(defun helm-occur-grep-ag-buffer-directory (_candidate) - "Start helm-grep-ag in the `default-directory' of currently searched buffer." - (let* ((src (with-helm-buffer - ;; Search from current source or fallback to the first - ;; source if helm-buffer is empty, if only one source - ;; we are right in either cases. - (or (helm-get-current-source) - (car helm-sources)))) - (buf (helm-get-attr 'buffer-name src)) - (directory (with-current-buffer buf - default-directory)) - (input helm-pattern)) - (helm-grep-ag-1 directory nil input))) - -(helm-make-command-from-action helm-run-occur-grep-ag-buffer-directory - "Ag grep buffer directory." 'helm-occur-grep-ag-buffer-directory) - -;;; helm-occur-mode -;; -;; -(defvar helm-occur-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "RET") 'helm-occur-mode-goto-line) - (define-key map (kbd "C-o") 'helm-occur-mode-goto-line-ow) - (define-key map (kbd "") 'helm-occur-mode-goto-line-ow-forward) - (define-key map (kbd "") 'helm-occur-mode-goto-line-ow-backward) - (define-key map (kbd "") 'helm-gm-next-file) - (define-key map (kbd "") 'helm-gm-precedent-file) - (define-key map (kbd "M-n") 'helm-occur-mode-goto-line-ow-forward) - (define-key map (kbd "M-p") 'helm-occur-mode-goto-line-ow-backward) - (define-key map (kbd "M-N") 'helm-gm-next-file) - (define-key map (kbd "M-P") 'helm-gm-precedent-file) - (define-key map (kbd "C-c b") 'helm-occur-mode-resume-session) - map)) - -(defun helm-occur-mode-goto-line () - (interactive) - (setq next-error-last-buffer (current-buffer)) - (setq-local helm-current-error (point-marker)) - (helm-aif (get-text-property (point) 'helm-realvalue) - (progn (helm-occur-goto-line it) (helm-match-line-cleanup-pulse)))) - -(defun helm-occur-mode-goto-line-ow () - (interactive) - (setq next-error-last-buffer (current-buffer)) - (setq-local helm-current-error (point-marker)) - (helm-aif (get-text-property (point) 'helm-realvalue) - (progn (helm-occur-goto-line-ow it) (helm-match-line-cleanup-pulse)))) - -(defun helm-occur-mode-goto-line-ow-forward-1 (arg) - (condition-case nil - (progn - (when (or (eq last-command 'helm-occur-mode-goto-line-ow-forward) - (eq last-command 'helm-occur-mode-goto-line-ow-backward)) - (forward-line arg)) - (save-selected-window - (helm-occur-mode-goto-line-ow) - (recenter))) - (error nil))) - -(defun helm-occur-mode-goto-line-ow-forward (arg) - (interactive "p") - (helm-occur-mode-goto-line-ow-forward-1 arg)) - -(defun helm-occur-mode-goto-line-ow-backward (arg) - (interactive "p") - (helm-occur-mode-goto-line-ow-forward-1 (- arg))) - -(defun helm-occur-save-results (_candidate) - "Save helm moccur results in a `helm-moccur-mode' buffer." - (let ((buf "*hmoccur*") - new-buf) - (when (get-buffer buf) - (setq new-buf (helm-read-string "OccurBufferName: " buf)) - (cl-loop for b in (helm-buffer-list) - when (and (string= new-buf b) - (not (y-or-n-p - (format "Buffer `%s' already exists overwrite? " - new-buf)))) - do (setq new-buf (helm-read-string - "OccurBufferName: " "*hmoccur "))) - (setq buf new-buf)) - (with-current-buffer (get-buffer-create buf) - (kill-all-local-variables) - (setq buffer-read-only t) - (buffer-disable-undo) - (let ((inhibit-read-only t) - (map (make-sparse-keymap)) - buf-name) - (erase-buffer) - (insert "-*- mode: helm-occur -*-\n\n" - (format "Occur Results for `%s':\n\n" helm-input)) - (save-excursion - (insert (with-current-buffer helm-buffer - (goto-char (point-min)) - (forward-line 1) - (buffer-substring (point) (point-max))))) - (save-excursion - (forward-line -2) - (while (not (eobp)) - (if (helm-pos-header-line-p) - (let ((beg (pos-bol)) - (end (pos-eol))) - (set-text-properties beg (1+ end) nil) - (delete-region (1- beg) end)) - (helm-aif (setq buf-name (assoc-default - 'buffer-name - (get-text-property (point) 'helm-cur-source))) - (progn - (insert (propertize (concat it ":") - 'face 'helm-moccur-buffer - 'helm-realvalue (get-text-property (point) 'helm-realvalue))) - (add-text-properties - (pos-bol) (pos-eol) - `(buffer-name ,buf-name)) - (add-text-properties - (pos-bol) (pos-eol) - `(keymap ,map - help-echo ,(concat - (buffer-file-name - (get-buffer buf-name)) - "\nmouse-1: set point\nmouse-2: jump to selection") - mouse-face highlight - invisible nil)) - (define-key map [mouse-1] 'mouse-set-point) - (define-key map [mouse-2] 'helm-occur-mode-mouse-goto-line) - (define-key map [mouse-3] 'ignore)))) - (forward-line 1)))) - (buffer-enable-undo) - (helm-occur-mode)) - (pop-to-buffer buf) - (setq next-error-last-buffer (get-buffer buf)) - (message "Helm occur Results saved in `%s' buffer" buf))) - -(defun helm-occur-mode-mouse-goto-line (event) - (interactive "e") - (let* ((window (posn-window (event-end event))) - (pos (posn-point (event-end event)))) - (with-selected-window window - (when (eq major-mode 'helm-occur-mode) - (goto-char pos) - (helm-occur-mode-goto-line))))) -(put 'helm-moccur-mode-mouse-goto-line 'helm-only t) - -(defun helm-occur-mode-resume-session () - (interactive) - (cl-assert (eq major-mode 'helm-occur-mode) nil "Helm command called in wrong context") - (helm-multi-occur-1 helm-occur--buffer-list helm-occur-mode--last-pattern)) - -(defun helm-occur-buffer-substring-with-linums () - "Return current-buffer contents as a string with all lines -numbered. The property \\='buffer-name is added to the whole string." - (let ((bufstr (buffer-substring-no-properties (point-min) (point-max))) - (bufname (buffer-name))) - (with-temp-buffer - (save-excursion - (insert bufstr)) - (let ((linum 1)) - (insert (format "%s " linum)) - (while (re-search-forward "\n" nil t) - (cl-incf linum) - (insert (format "%s " linum))) - (add-text-properties (point-min) (point-max) `(buffer-name ,bufname))) - (buffer-string)))) - -(defun helm-occur-mode--revert-buffer-function (&optional _ignore-auto _noconfirm) - "The `revert-buffer-function' for `helm-occur-mode'." - (goto-char (point-min)) - (let (pattern) - (when (re-search-forward "^Occur Results for `\\(.*\\)'" nil t) - (setq pattern (match-string 1)) - (forward-line 0) - (when (re-search-forward "^$" nil t) - (forward-line 1)) - (let ((inhibit-read-only t) - (buffer (current-buffer)) - (buflst helm-occur--buffer-list)) - (delete-region (point) (point-max)) - (message "Reverting buffer...") - (save-excursion - (with-temp-buffer - (insert - "\n" - (cl-loop for buf in buflst - for bufstr = (or (and (buffer-live-p (get-buffer buf)) - (with-current-buffer buf - (helm-occur-buffer-substring-with-linums))) - "") - concat bufstr) - "\n") - (goto-char (point-min)) - (cl-loop with linum - with mpart - ;; Bind helm-pattern used by `helm-grep-split-line'. - with helm-pattern = pattern - while (helm-mm-search pattern) ; point is at eol. - ;; Calculate line number (linum) and extract real - ;; part of line (mpart). - do (when (save-excursion - ;; `helm-mm-search' puts point at eol. - (forward-line 0) - (re-search-forward "^\\([0-9]*\\)\\s-\\{1\\}\\(.*\\)$" - (pos-eol) t)) - (setq linum (string-to-number (match-string 1)) - mpart (match-string 2))) - ;; Match part after line number. - when (and mpart (helm-mm-match mpart pattern)) - for line = (format "%s:%d:%s" - (get-text-property (point) 'buffer-name) - linum - mpart) - when line - do (with-current-buffer buffer - (insert - (propertize - (car (helm-occur-filter-one-by-one line)) - 'helm-realvalue linum) - "\n")))) - (when (fboundp 'wgrep-cleanup-overlays) - (wgrep-cleanup-overlays (point-min) (point-max))) - (message "Reverting buffer done") - (when executing-kbd-macro (sit-for 1))))))) - -(defun helm-occur-filter-one-by-one (candidate) - "`filter-one-by-one' function for `helm-source-moccur'." - (require 'helm-grep) - (let* ((split (helm-grep-split-line candidate)) - (buf (car split)) - (lineno (nth 1 split)) - (str (nth 2 split)) - (bfname (buffer-file-name (get-buffer buf)))) - (cons (concat (propertize - buf - 'face 'helm-moccur-buffer - 'help-echo bfname - 'helm-grep-fname bfname - 'buffer-name buf) - ":" - (propertize lineno 'face 'helm-grep-lineno) - ":" - (helm-grep-highlight-match str)) - candidate))) - -(define-derived-mode helm-occur-mode - special-mode "helm-moccur" - "Major mode to provide actions in helm moccur saved buffer. - -Special commands: -\\{helm-occur-mode-map}" - (set (make-local-variable 'helm-occur--buffer-list) - (with-helm-buffer helm-occur--buffer-list)) - (set (make-local-variable 'revert-buffer-function) - #'helm-occur-mode--revert-buffer-function) - (set (make-local-variable 'helm-occur-mode--last-pattern) - helm-input) - (set (make-local-variable 'next-error-function) - #'helm-occur-next-error) - (set (make-local-variable 'helm-current-error) nil)) -(put 'helm-moccur-mode 'helm-only t) - -(defun helm-occur-next-error (&optional argp reset) - "Goto ARGP position from a `helm-occur-mode' buffer. -RESET non-nil means rewind to the first match. -This is the `next-error-function' for `helm-occur-mode'." - (interactive "p") - (goto-char (cond (reset (point-min)) - ((and (< argp 0) helm-current-error) - (line-beginning-position)) - ((and (> argp 0) helm-current-error) - (line-end-position)) - ((point)))) - (let ((fun (if (> argp 0) - #'next-single-property-change - #'previous-single-property-change))) - (helm-aif (funcall fun (point) 'buffer-name) - (progn - (goto-char it) - (forward-line 0) - ;; `helm-current-error' is set in - ;; `helm-occur-mode-goto-line'. - (helm-occur-mode-goto-line)) - (user-error "No more matches")))) - -;;; Resume -;; -(defun helm-occur-resume-fn () - (with-helm-buffer - (let (new-tick-ls buffer-is-modified) - (set (make-local-variable 'helm-occur--buffer-list) - (cl-loop for b in helm-occur--buffer-list - when (buffer-live-p (get-buffer b)) - collect b)) - (setq buffer-is-modified (/= (length helm-occur--buffer-list) - (length (helm-get-attr 'moccur-buffers)))) - (helm-set-attr 'moccur-buffers helm-occur--buffer-list) - (setq new-tick-ls (cl-loop for b in helm-occur--buffer-list - collect (buffer-chars-modified-tick - (get-buffer b)))) - (when buffer-is-modified - (setq helm-occur--buffer-tick new-tick-ls)) - (cl-assert (> (length helm-occur--buffer-list) 0) nil - "helm-resume error: helm-(m)occur buffer list is empty") - (unless (eq helm-occur-auto-update-on-resume 'never) - (when (or buffer-is-modified - (cl-loop for b in helm-occur--buffer-list - for new-tick = (buffer-chars-modified-tick - (get-buffer b)) - for tick in helm-occur--buffer-tick - thereis (/= tick new-tick))) - (helm-aif helm-occur-auto-update-on-resume - (when (or (eq it 'noask) - (y-or-n-p "Helm (m)occur Buffer outdated, update? ")) - (run-with-idle-timer - 0.1 nil (lambda () - (with-helm-buffer - (helm-force-update) - (message "Helm (m)occur Buffer have been udated") - (sit-for 1) (message nil)))) - (unless buffer-is-modified (setq helm-occur--buffer-tick - new-tick-ls))) - (run-with-idle-timer - 0.1 nil - (lambda () - (with-helm-buffer - (let ((ov (make-overlay (save-excursion - (goto-char (point-min)) - (forward-line 1) - (point)) - (point-max)))) - (overlay-put ov 'face 'helm-resume-need-update) - (sit-for 0) - (delete-overlay ov) - (message "[Helm occur Buffer outdated (C-c C-u to update)]"))))) - (unless buffer-is-modified - (with-helm-after-update-hook - (setq helm-occur--buffer-tick new-tick-ls) - (message "Helm (m)occur Buffer have been udated"))))))))) - -;;; Helm occur from isearch -;; -;;;###autoload -(defun helm-occur-from-isearch () - "Invoke `helm-occur' from isearch. - -To use this bind it to a key in `isearch-mode-map'." - (interactive) - (let ((input (if isearch-regexp - isearch-string - (regexp-quote isearch-string))) - (bufs (list (current-buffer))) - ;; Use `helm-occur-always-search-in-current' as a flag for - ;; `helm-occur--select-closest-candidate'. - (helm-occur-always-search-in-current t)) - (isearch-exit) - (helm-multi-occur-1 bufs input))) - -;;;###autoload -(defun helm-multi-occur-from-isearch () - "Invoke `helm-multi-occur' from isearch. - -With a prefix arg, reverse the behavior of -`helm-moccur-always-search-in-current'. -The prefix arg can be set before calling -`helm-multi-occur-from-isearch' or during the buffer selection. - -To use this bind it to a key in `isearch-mode-map'." - (interactive) - (let (buf-list - helm-moccur-always-search-in-current - (input (if isearch-regexp - isearch-string - (regexp-quote isearch-string)))) - (isearch-exit) - (setq buf-list (mapcar 'get-buffer - (helm-comp-read "Buffers: " - (helm-buffer-list) - :name "Occur in buffer(s)" - :marked-candidates t))) - (setq helm-moccur-always-search-in-current - (if (or current-prefix-arg - helm-current-prefix-arg) - (not helm-moccur-always-search-in-current) - helm-moccur-always-search-in-current)) - (helm-multi-occur-1 buf-list input))) - -(provide 'helm-occur) - -;;; helm-occur.el ends here diff --git a/elpa/helm-20251212.555/helm-packages.el b/elpa/helm-20251212.555/helm-packages.el deleted file mode 100644 index e0e8af5d..00000000 --- a/elpa/helm-20251212.555/helm-packages.el +++ /dev/null @@ -1,620 +0,0 @@ -;;; helm-packages.el --- helm interface to manage packages -*- lexical-binding: t; -*- - -;; Copyright (C) 2012 ~ 2025 Thierry Volpiatto - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - - -;;; Code: - -(require 'cl-lib) -(require 'helm) -(require 'package) -(require 'finder) -(require 'helm-utils) ; For with-helm-display-marked-candidates. -(require 'async-package) - -(declare-function dired-async-mode-line-message "ext:dired-async.el") - - -;; Urls for cloning. -(defvar helm-packages-recipes-alist '(("melpa" . "https://melpa.org/packages/elpa-packages.eld") - ("gnu" . "https://elpa.gnu.org/packages/elpa-packages.eld") - ("nongnu" . "https://elpa.nongnu.org/nongnu/elpa-packages.eld")) - "Adresses where to find recipes or urls for packages.") - -;; Caches for recipes (elpa-packages.eld contents). -(defvar helm-packages--gnu-elpa-recipes-cache nil) -(defvar helm-packages--nongnu-elpa-recipes-cache nil) -(defvar helm-packages--melpa-recipes-cache nil) - -;; EmacsMirror -(defvar helm-packages-fallback-url-for-cloning "https://github.com/emacsmirror/%s") - - -(defgroup helm-packages nil - "Helm interface for package.el." - :group 'helm) - -(defclass helm-packages-class (helm-source-in-buffer) - ((coerce :initform #'helm-symbolify) - (find-file-target :initform #'helm-packages-quit-an-find-file) - (filtered-candidate-transformer - :initform - `(helm-packages-transformer - ,(lambda (candidates _source) - (sort candidates #'helm-generic-sort-fn)))) - (update :initform #'helm-packages--refresh-contents)) - "A class to define `helm-packages' sources.") - -(defcustom helm-packages-async t - "Install packages async when non nil." - :type 'boolean) - -(defcustom helm-package-install-upgrade-built-in - (bound-and-true-p package-install-upgrade-built-in) - "Allow upgrading builtin packages when non nil." - :type 'boolean) - -(defcustom helm-packages-isolate-fn (if (fboundp 'package-isolate) - #'package-isolate - #'helm-packages-isolate-1) - "The function to isolate package. -`package-isolate' is available only in emacs-30+." - :type 'function) - -(defcustom helm-packages-default-clone-directory nil - "Default directory where to clone packages." - :type 'string) - -(defcustom helm-packages-clone-after-hook nil - "Hook that run after cloning a package. -It is called with two args respectively PACKAGE as a string and DIRECTORY." - :type 'hook) - -;;; Actions -;; -;; -(defun helm-packages-upgrade (_candidate) - "Helm action for upgrading marked packages." - (let ((mkd (helm-marked-candidates)) - (error-file (expand-file-name - "helm-packages-upgrade-error.txt" - temporary-file-directory))) - (with-helm-display-marked-candidates - helm-marked-buffer-name - (mapcar #'symbol-name mkd) - (when (y-or-n-p (format "Upgrade %s packages? " (length mkd))) - (if helm-packages-async - (async-package-do-action 'upgrade mkd error-file) - (mapc #'package-upgrade mkd)))))) - -(defun helm-packages-describe (candidate) - "Helm action for describing package CANDIDATE." - (describe-package candidate)) - -(defun helm-packages-get-homepage-url (candidate) - "Get package CANDIDATE home page url." - (let* ((id (package-get-descriptor candidate)) - (extras (package-desc-extras id))) - (and (listp extras) (cdr-safe (assoc :url extras))))) - -(defun helm-packages-visit-homepage (candidate) - "Helm action for visiting package CANDIDATE home page." - (let ((url (helm-packages-get-homepage-url candidate))) - (if (stringp url) - (browse-url url) - (message "Package `%s' has no homepage" candidate)))) - -(defun helm-packages-package-reinstall (_candidate) - "Helm action for reinstalling marked packages." - (let ((mkd (helm-marked-candidates)) - (error-file (expand-file-name - "helm-packages-reinstall-error.txt" - temporary-file-directory))) - (with-helm-display-marked-candidates - helm-marked-buffer-name - (mapcar #'symbol-name mkd) - (when (y-or-n-p (format "Reinstall %s packages? " (length mkd))) - (if helm-packages-async - (async-package-do-action 'reinstall mkd error-file) - (mapc #'package-reinstall mkd)))))) - -(defun helm-packages-delete-1 (packages &optional force) - "Run `package-delete' on PACKAGES. -If FORCE is non nil force deleting packages." - (mapc (lambda (x) - (package-delete (package-get-descriptor x) force)) - packages)) - -(defun helm-packages-uninstall (_candidate) - "Helm action for uninstalling marked packages. -Unlike `helm-packages-delete' this will refuse to delete packages when they are -needed by others packages as dependencies." - (let ((mkd (helm-marked-candidates))) - (with-helm-display-marked-candidates - helm-marked-buffer-name - (mapcar #'symbol-name mkd) - (when (y-or-n-p (format "Uninstall %s packages? " (length mkd))) - (helm-packages-delete-1 mkd))))) - -(defun helm-packages-delete (_candidate) - "Helm action for deleting marked packages. -Unlike `helm-packages-uninstall' this delete packages even when they are needed -as dependencies." - (let ((mkd (helm-marked-candidates))) - (with-helm-display-marked-candidates - helm-marked-buffer-name - (mapcar #'symbol-name mkd) - (when (y-or-n-p (format "Delete %s packages? " (length mkd))) - (helm-packages-delete-1 mkd 'force))))) - -(defun helm-packages-recompile (_candidate) - "Helm action for recompiling marked packages." - (let ((mkd (helm-marked-candidates))) - (with-helm-display-marked-candidates - helm-marked-buffer-name - (mapcar #'symbol-name mkd) - (when (y-or-n-p (format "Recompile %s packages? " (length mkd))) - (mapc #'package-recompile mkd))))) - -(defun helm-packages-install--sync (packages) - (condition-case err - (mapc #'package-install packages) - (error "%S:\n Please refresh package list before installing" err))) - -(defun helm-packages-install (_candidate) - "Helm action for installing marked packages." - (let ((mkd (helm-marked-candidates)) - (error-file (expand-file-name - "helm-packages-install-error.txt" - temporary-file-directory))) - (with-helm-display-marked-candidates - helm-marked-buffer-name - (mapcar #'symbol-name mkd) - (when (y-or-n-p (format "Install %s packages? " (length mkd))) - (if helm-packages-async - (async-package-do-action 'install mkd error-file) - (helm-packages-install--sync mkd)))))) - -(defun helm-packages--get-deps (pkg) - "Recursively find PKG dependencies." - (let ((desc (cadr (assq pkg package-archive-contents)))) - (when desc - (cl-loop for req in (package-desc-reqs desc) ; (foo (1 2 3)) - for sym = (car req) - nconc (cons sym (helm-packages--get-deps sym)) into pkgs - finally return (helm-fast-remove-dups pkgs))))) - -(defun helm-packages-isolate-1 (packages &optional _ignore) - "Start an Emacs with only PACKAGES loaded. -Arg PACKAGES is a list of strings." - (let* ((name (concat "package-isolate-" (mapconcat #'identity packages "_"))) - (deps (cl-loop for p in packages - for sym = (intern p) - nconc (helm-packages--get-deps sym)))) - (apply #'start-process name nil - (list (expand-file-name invocation-name invocation-directory) - "-Q" "--debug-init" - (format "--eval=%S" - `(progn - (require 'package) - (setq package-load-list - ',(append (mapcar (lambda (p) (list (intern p) t)) - packages) - (mapcar (lambda (p) (list p t)) deps)) - package-user-dir ,package-user-dir - package-directory-list ',package-directory-list) - (package-initialize))))))) - -(defun helm-packages-isolate (_candidate) - "Start a new Emacs with only marked packages loaded." - (let* ((mkd (helm-marked-candidates)) - (pkg-names (mapcar #'symbol-name mkd))) - (with-helm-display-marked-candidates - helm-marked-buffer-name - pkg-names - (when (y-or-n-p "Start a new Emacs with only package(s)? ") - (funcall helm-packages-isolate-fn pkg-names helm-current-prefix-arg))))) - -(defun helm-packages-quit-an-find-file (source) - "`find-file-target' function for `helm-packages'." - (let* ((sel (helm-get-selection nil nil source)) - (pkg (package-get-descriptor (intern sel)))) - (if (and pkg (package-installed-p pkg)) - (expand-file-name (package-desc-dir pkg)) - package-user-dir))) - -;;; Cloning packages -;; -(defun helm-packages-fetch-recipe (url) - "Fetch package recipes from URL. -They are generally contained in a file named elpa-packages.eld on remote which -contains the urls needed for cloning packages, each entry is like -\(foo :url \"somewhere\") and may contain as well :branch." - (with-temp-buffer - (url-insert-file-contents url) - (goto-char (point-min)) - (let ((data (read (current-buffer)))) - ;; Recipes do not have the same form depending from - ;; where we fetch them, they may be like - ;; ((foo :url "somewhere") - ;; (bar :url "somewhere")) - ;; or - ;; (((foo :url "somewhere") - ;; (bar :url "somewhere")) - ;; :version "1" :else "") - (if (keywordp (cadr data)) (car data) data)))) - -(defun helm-packages-get-package-url (package provider) - "Get PACKAGE url from PROVIDER's recipe. -Returns a plist like (:url :branch ). -PROVIDER can be one of \"melpa\", \"gnu\" or \"nongnu\"." - (let* ((address (assoc-default provider helm-packages-recipes-alist)) - (cache (helm-acase provider - ("gnu" 'helm-packages--gnu-elpa-recipes-cache) - ("nongnu" 'helm-packages--nongnu-elpa-recipes-cache) - ("melpa" 'helm-packages--melpa-recipes-cache))) - (recipe (or (symbol-value cache) - (set cache (helm-packages-fetch-recipe address)))) - (package-recipe (assq package recipe)) - (core (plist-get (cdr package-recipe) :core)) - (url (or (plist-get (cdr package-recipe) :url) - ;; Assume that when :url = nil the package is maintained in - ;; elpa or nongnu. When recipe is fetched from package-archives - ;; addresses the url is always specified or the package if not - ;; clonable not present at all e.g. cond-star. - (helm-acase provider - ("gnu" "https://git.sv.gnu.org/git/emacs/elpa.git") - ("nongnu" "https://git.sv.gnu.org/git/emacs/nongnu.git")))) - (branch (plist-get (cdr package-recipe) :branch))) - (cl-assert package-recipe nil (format "Couldn't find package '%s'" package)) - (cl-assert (null core) nil - (format "Package '%s' already provided in Emacs at '%s'" - package core)) - (unless (stringp url) - ;; Sometimes the recipe for a package refers to the same url as another - ;; package by setting :url to the name of this package (symbol) e.g. - ;; In nongnu recipe, we have: - ;; (helm :url "https://...") and (helm-core :url helm) - (setq url (and url (plist-get (cdr (assq url recipe)) :url)))) - `(:url ,url :branch ,branch))) - -(defun helm-packages-get-provider (package) - (let ((desc (assq package package-archive-contents))) - (package-desc-archive (cadr desc)))) - -(defun helm-packages-get-recipe-for-cloning (package) - (let ((provider (helm-packages-get-provider package))) - (helm-packages-get-package-url package provider))) - -(defun helm-packages-clone-package (package) - "Git clone PACKAGE." - (let* ((name (symbol-name package)) - (directory (read-directory-name - "Clone in directory: " - helm-packages-default-clone-directory nil t)) - (recipe (helm-packages-get-recipe-for-cloning package)) - (url (plist-get recipe :url)) - (branch (plist-get recipe :branch)) - (fix-url (if (or (string-match "\\.git\\'" url) - ;; For git-remote-hg. - (string-match "\\`hg::" url)) - url - (concat url ".git"))) - ;; In gnu archive all packages maintained on Elpa are pointing to - ;; "https://git.sv.gnu.org/git/emacs/elpa.git", to be able to clone a - ;; package from such url we have to use: - ;; git clone --single-branch -b externals/ URL PACKAGE-NAME. - ;; This create a directory named PACKAGE-NAME with only PACKAGE inside. - ;; If PACKAGE-NAME is ommited this create a repo named elpa which clash if - ;; such a dir already exists. Another case is packages coming either - ;; from nongnu or melpa giving the nongnu url as :url and specifying a - ;; branch, example: - ;; (ws-butler :url "https://git.savannah.gnu.org/git/emacs/nongnu.git" - ;; :branch "elpa/ws-butler") - (switches (append - (if (string-match "\\(elpa\\|nongnu\\)\\.git\\'" url) - `("clone" "--single-branch" - "-b" ,(or branch (format "externals/%s" package))) - (delq nil `("clone" ,(and branch "-b") ,branch))) - `(,fix-url ,name)))) - (cl-assert (not (file-directory-p (expand-file-name name directory))) - nil (format "Package already exists in %s" directory)) - (with-helm-default-directory directory - (let* (process-connection-type - (proc (apply #'start-process - "git" "*helm packages clone*" - "git" switches))) - (save-selected-window - (display-buffer (process-buffer proc) - '(display-buffer-below-selected - (window-height . fit-window-to-buffer) - (preserve-size . (nil . t))))) - (set-process-filter proc #'helm-packages--clone-filter-process) - (set-process-sentinel - proc (lambda (proc event) - (let ((status (process-exit-status proc))) - (if (string= event "finished\n") - (message "Cloning package %s done" package) - (message "Cloning package %s failed" package)) - (when (= status 0) - (quit-window t (get-buffer-window (process-buffer proc))) - (run-hook-with-args - 'helm-packages-clone-after-hook - (symbol-name package) directory))))) - (message "Cloning package %s..." package))))) - -(defun helm-packages--clone-filter-process (proc string) - (when (buffer-live-p (process-buffer proc)) - (with-current-buffer (process-buffer proc) - (erase-buffer) - (insert (car (split-string string " ")))))) - -;;; Transformers -;; -;; -(defun helm-packages-transformer (candidates _source) - "Transformer function for `helm-packages'." - (cl-loop with lgst_arch = (cl-loop for (arch . _) in package-archives - maximize (length arch)) - for c in candidates - for sym = (intern-soft c) - for archive = (assq sym package-archive-contents) - for id = (package-get-descriptor sym) - for provider = (if archive - (package-desc-archive (cadr archive)) - (and (assq sym package--builtins) "emacs")) - for status = (if id - (package-desc-status id) - (and (assq sym package--builtins) "Built-in")) - for version = (if id - (mapconcat #'number-to-string (package-desc-version id) ".") - (or (helm-aand (assq sym package--builtins) - (aref (cdr it) 0) - (package-version-join it)) - "---")) - for description = (if id - (package-desc-summary id) - (helm-aand (assq sym package--builtins) - (aref (cdr it) 2))) - for disp = (format "%s%s%s%s%s%s%s%s%s" - ;; Package name. - (propertize - c - 'face - (helm-acase status - ("dependency" 'font-lock-type-face) - ("disabled" 'default) - (t 'font-lock-keyword-face)) - 'match-part c) - ;; Separator. - (helm-make-separator c) - ;; Package status. - (propertize - (or status "") - 'face (helm-acase status - ("dependency" 'bold-italic) - ("disabled" 'font-lock-property-name-face) - (t 'default))) - ;; Separator. - (helm-make-separator status 10) - ;; Package provider. - (or provider "") - ;; Separator. - (helm-make-separator provider lgst_arch) - ;; Package version. - (or version "") - ;; Separator. - (helm-make-separator version 20) - ;; Package description. - (if description - (propertize description 'face 'font-lock-warning-face) - "")) - collect (cons disp c))) - -(defun helm-packages-transformer-1 (candidates _source) - "Transformer function for `helm-packages' upgrade and delete sources." - (cl-loop for c in candidates - collect (cons (propertize c 'face 'font-lock-keyword-face) c))) - -(defvar helm-packages--updated nil) -(defun helm-packages--refresh-contents () - (unless helm-packages--updated - (setq helm-packages--gnu-elpa-recipes-cache nil - helm-packages--nongnu-elpa-recipes-cache nil - helm-packages--melpa-recipes-cache nil) - (setq package-menu--old-archive-contents package-archive-contents) - (setq package-menu--new-package-list nil) - (package-refresh-contents) - (package-menu--populate-new-package-list)) - (helm-set-local-variable 'helm-packages--updated t)) - -(defun helm-finder--list-matches (key) - (let* ((id (intern key)) - (built-in (gethash id finder-keywords-hash)) - (exts (cl-loop for p in package-archive-contents - for sym = (car p) - when (package--has-keyword-p - (package-get-descriptor sym) - (list key)) - collect sym))) - (unless (or exts built-in) - (error "No packages matching key `%s'" key)) - (nconc exts built-in))) - -(defun helm-finder-packages-from-keyword (candidate) - (if (string-match "\\.el$" candidate) - (finder-commentary candidate) - (helm :sources - (helm-make-source "packages" 'helm-packages-class - :header-name (lambda (name) (format "%s (%s)" name candidate)) - :init (lambda () - (helm-init-candidates-in-buffer - 'global (helm-fast-remove-dups - (helm-finder--list-matches candidate)))) - :filtered-candidate-transformer - `(helm-packages-transformer - ,(lambda (candidates _source) - (sort candidates #'helm-generic-sort-fn))) - :action-transformer - (lambda (actions candidate) - (if (package-installed-p candidate) - actions - (append actions - '(("Install packages(s)" - . helm-packages-install))))) - :action '(("Describe package" . helm-packages-describe) - ("Visit homepage" . helm-packages-visit-homepage) - ("Clone package" . helm-packages-clone-package))) - :buffer "*helm finder results*"))) - -(defun helm-package--upgradeable-packages (&optional include-builtins) - ;; Initialize the package system to get the list of package - ;; symbols for completion. - (package--archives-initialize) - (let ((pkgs (if include-builtins - (append package-alist - (cl-loop for (sym . vec) in package--builtins - when (not (assq sym package-alist)) - nconc (list (list sym (package--from-builtin - (cons sym vec)))))) - package-alist))) - (cl-loop for (sym desc) in pkgs - for pkg = (assq sym package-archive-contents) - for cversion = (and pkg (package-desc-version desc)) - for available = (and pkg (not (package-disabled-p sym cversion)) pkg) - ;; Exclude packages installed with package-vc (issue#2692). - when (and available - (not (package-vc-p desc)) - (or (and include-builtins (not cversion)) - (and cversion - (version-list-< - cversion - (package-desc-version (cadr available)))))) - collect sym))) - -;;;###autoload -(defun helm-packages (&optional arg) - "Helm interface to manage packages. - -With a prefix arg ARG refresh package list. - -When installing or upgrading ensure to refresh the package list -to avoid errors with outdated packages no more availables." - (interactive "P") - (package-initialize) - (when arg (helm-packages--refresh-contents)) - (let ((upgrades (helm-package--upgradeable-packages - helm-package-install-upgrade-built-in)) - (removables (package--removable-packages)) - (standard-actions '(("Describe package" . helm-packages-describe) - ("Visit homepage" . helm-packages-visit-homepage) - ("Install packages(s)" . helm-packages-install) - ("Clone package" . helm-packages-clone-package)))) - (helm :sources (list - (helm-make-source "Availables for upgrade" 'helm-packages-class - :init (lambda () - (helm-init-candidates-in-buffer 'global upgrades)) - :filtered-candidate-transformer #'helm-packages-transformer-1 - :action '(("Upgrade package(s)" - . helm-packages-upgrade))) - (helm-make-source "Packages to delete" 'helm-packages-class - :init (lambda () - (helm-init-candidates-in-buffer 'global removables)) - :filtered-candidate-transformer #'helm-packages-transformer-1 - :action '(("Delete package(s)" . helm-packages-delete))) - (helm-make-source "Installed packages" 'helm-packages-class - :init (lambda () - (helm-init-candidates-in-buffer 'global - (mapcar #'car package-alist))) - :action '(("Describe package" . helm-packages-describe) - ("Visit homepage" . helm-packages-visit-homepage) - ("Reinstall package(s)" - . helm-packages-package-reinstall) - ("Recompile package(s)" . helm-packages-recompile) - ("Uninstall package(s)" . helm-packages-uninstall) - ("Isolate package(s)" . helm-packages-isolate) - ("Clone package" . helm-packages-clone-package))) - (helm-make-source "New packages" 'helm-packages-class - :data (lambda () - (cl-loop for p in package-archive-contents - for sym = (car p) - for id = (package-get-descriptor sym) - for status = (and id (package-desc-status id)) - when (equal status "new") - nconc (list (car p)))) - :action standard-actions) - (helm-make-source "Available external packages" 'helm-packages-class - :data (lambda () - (cl-loop for p in package-archive-contents - for sym = (car p) - for id = (package-get-descriptor sym) - for status = (package-desc-status id) - unless (or (and id (member - status - '("new" "installed" - "dependency" "source"))) - (and id (assoc sym package--builtins))) - nconc (list (car p)))) - :action standard-actions) - (helm-make-source "Available built-in packages" 'helm-packages-class - :data (lambda () - (cl-loop for p in package--builtins - ;; Show only builtins that are available as - ;; well on (m)elpa. Other builtins don't - ;; have a package-descriptor, the format is - ;; (sym . [version reqs summary]). - when (package-desc-p (package-get-descriptor (car p))) - collect (car p))) - :action (remove (assoc "Clone package" standard-actions) - standard-actions))) - :buffer "*helm packages*"))) - -;;;###autoload -(defun helm-finder (&optional arg) - "Helm interface to find packages by keywords with `finder'. -To have more actions on packages, use `helm-packages'." - (interactive "P") - (package-initialize) - (when arg (helm-packages--refresh-contents)) - (helm :sources - (helm-build-in-buffer-source "helm finder" - :data (cl-loop for p in package-archive-contents - for sym = (car p) - for desc = (package-get-descriptor sym) - nconc (copy-sequence (package-desc--keywords desc)) into keywords - finally return (helm-fast-remove-dups keywords :test 'equal)) - :filtered-candidate-transformer - (list - (lambda (candidates _source) - (cl-loop for cand in candidates - for desc = (or (assoc-default (intern-soft cand) finder-known-keywords) - cand) - for sep = (helm-make-separator cand) - for disp = (helm-aand (propertize desc 'face 'font-lock-warning-face) - (propertize " " 'display (concat sep it)) - (concat cand it)) - collect (cons disp cand))) - (lambda (candidates _source) - (sort candidates #'helm-generic-sort-fn))) - :action (helm-make-actions - "Packages from keyword" 'helm-finder-packages-from-keyword) - :persistent-action 'ignore - :persistent-help "Do nothing") - :buffer "*helm finder*")) - -(provide 'helm-packages) - -;;; helm-packages.el ends here diff --git a/elpa/helm-20251212.555/helm-pkg.el b/elpa/helm-20251212.555/helm-pkg.el deleted file mode 100644 index f7d8822a..00000000 --- a/elpa/helm-20251212.555/helm-pkg.el +++ /dev/null @@ -1,11 +0,0 @@ -;; -*- no-byte-compile: t; lexical-binding: nil -*- -(define-package "helm" "20251212.555" - "Helm is an Emacs incremental and narrowing framework." - '((helm-core "4.0.6") - (wfnames "1.2")) - :url "https://emacs-helm.github.io/helm/" - :commit "08fb63fab625e90b699999151dada80232a7c81b" - :revdesc "08fb63fab625" - :keywords '("helm" "convenience" "files" "buffers" "grep" "completion" "lisp" "matching" "tools" "help") - :authors '(("Thierry Volpiatto" . "thievol@posteo.net")) - :maintainers '(("Thierry Volpiatto" . "thievol@posteo.net"))) diff --git a/elpa/helm-20251212.555/helm-regexp.el b/elpa/helm-20251212.555/helm-regexp.el deleted file mode 100644 index 767e883c..00000000 --- a/elpa/helm-20251212.555/helm-regexp.el +++ /dev/null @@ -1,132 +0,0 @@ -;;; helm-regexp.el --- In buffer regexp searching and replacement for helm. -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2025 Thierry Volpiatto - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Code: - -(require 'cl-lib) -(require 'helm) -(require 'helm-help) -(require 'helm-utils) - -(declare-function helm-mm-split-pattern "helm-multi-match") - - -(defgroup helm-regexp nil - "Regexp related Applications and libraries for Helm." - :group 'helm) - - - -;; History vars -(defvar helm-build-regexp-history nil) - -(defun helm-query-replace-regexp (_candidate) - "Query replace regexp from `helm-regexp'. -With a prefix arg replace only matches surrounded by word boundaries, -i.e. don't replace inside a word, regexp is surrounded with \\bregexp\\b." - (let ((regexp helm-input)) - (apply 'query-replace-regexp - (helm-query-replace-args regexp)))) - -(defun helm-kill-regexp-as-sexp (_candidate) - "Kill regexp in a format usable in lisp code." - (helm-regexp-kill-new - (prin1-to-string helm-input))) - -(defun helm-kill-regexp (_candidate) - "Kill regexp as it is in `helm-pattern'." - (helm-regexp-kill-new helm-input)) - -(defun helm-query-replace-args (regexp) - "Create arguments of `query-replace-regexp' action in `helm-regexp'." - (let ((region-only (helm-region-active-p))) - (list - regexp - (query-replace-read-to regexp - (format "Query replace %sregexp %s" - (if helm-current-prefix-arg "word " "") - (if region-only "in region " "")) - t) - helm-current-prefix-arg - (when region-only (region-beginning)) - (when region-only (region-end))))) - -(defvar helm-source-regexp - (helm-build-in-buffer-source "Regexp Builder" - :init (lambda () - (helm-init-candidates-in-buffer - 'global (with-temp-buffer - (insert-buffer-substring helm-current-buffer) - (buffer-string)))) - :get-line #'helm-regexp-get-line - :persistent-action #'helm-regexp-persistent-action - :persistent-help "Show this line" - :multiline t - :multimatch nil - :requires-pattern 2 - :group 'helm-regexp - :mode-line "Press TAB to select action." - :action '(("Kill Regexp as sexp" . helm-kill-regexp-as-sexp) - ("Query Replace Regexp (C-u Not inside word.)" - . helm-query-replace-regexp) - ("Kill Regexp" . helm-kill-regexp)))) - -(defun helm-regexp-get-line (s e) - (let ((matches (match-data)) - (line (buffer-substring s e))) - (propertize - (cl-loop with ln = (format "%5d: %s" (1- (line-number-at-pos s)) line) - for i from 0 to (1- (/ (length matches) 2)) - if (match-string i) - concat (format "\n%s%s'%s'" - (make-string 10 ? ) (format "Group %d: " i) it) - into ln1 - finally return (concat ln ln1)) - 'helm-realvalue s))) - -(defun helm-regexp-persistent-action (pt) - (helm-goto-char pt) - (helm-highlight-current-line)) - -(defun helm-regexp-kill-new (input) - (kill-new (substring-no-properties input)) - (message "Killed: %s" input)) - - -;;; Predefined commands -;; -;; - -;;;###autoload -(defun helm-regexp () - "Preconfigured helm to build regexps. -`query-replace-regexp' can be run from there against found regexp." - (interactive) - (save-restriction - (when (and (helm-region-active-p) - ;; Don't narrow to region if buffer is already narrowed. - (not (helm-current-buffer-narrowed-p (current-buffer)))) - (narrow-to-region (region-beginning) (region-end))) - (helm :sources helm-source-regexp - :buffer "*helm regexp*" - :prompt "Regexp: " - :history 'helm-build-regexp-history))) - - -(provide 'helm-regexp) - -;;; helm-regexp.el ends here diff --git a/elpa/helm-20251212.555/helm-ring.el b/elpa/helm-20251212.555/helm-ring.el deleted file mode 100644 index 4431d371..00000000 --- a/elpa/helm-20251212.555/helm-ring.el +++ /dev/null @@ -1,644 +0,0 @@ -;;; helm-ring.el --- kill-ring, mark-ring, and register browsers for helm. -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2025 Thierry Volpiatto - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Code: - -(require 'cl-lib) -(require 'helm) -(require 'helm-utils) -(require 'helm-help) -(require 'helm-elisp) - -(declare-function undo-tree-restore-state-from-register "ext:undo-tree.el" (register)) -(declare-function kmacro--keys "kmacro.el") -(declare-function frameset-register-p "frameset") - -(defgroup helm-ring nil - "Ring related Applications and libraries for Helm." - :group 'helm) - -(defcustom helm-kill-ring-threshold 3 - "Minimum length of a candidate to be listed by `helm-source-kill-ring'." - :type 'integer - :group 'helm-ring) - -(defcustom helm-kill-ring-max-offset 400 - "Max number of chars displayed per candidate in kill-ring browser. -When `t', don't truncate candidate, show all. -By default it is approximatively the number of bits contained in five lines -of 80 chars each, i.e. 80*5. -Note that if you set this to nil multiline will be disabled, i.e. you -will not have separators between candidates any more." - :type '(choice (const :tag "Disabled" t) - (integer :tag "Max candidate offset")) - :group 'helm-ring) - -(defcustom helm-kill-ring-actions - '(("Yank marked" . helm-kill-ring-action-yank) - ("Delete marked" . helm-kill-ring-action-delete) - ("Search from candidate" . helm-kill-ring-search-from-string)) - "List of actions for kill ring source." - :group 'helm-ring - :type '(alist :key-type string :value-type function)) - -(defcustom helm-kill-ring-separator "\n" - "The separator used to separate marked candidates when yanking." - :group 'helm-ring - :type 'string) - -(defcustom helm-register-max-offset 160 - "Max size of string register entries before truncating." - :group 'helm-ring - :type 'integer) - -;;; Kill ring -;; -;; -(defvar helm-kill-ring-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-map) - (define-key map (kbd "M-y") 'helm-next-line) - (define-key map (kbd "M-u") 'helm-previous-line) - (define-key map (kbd "M-D") 'helm-kill-ring-delete) - (define-key map (kbd "C-s") 'helm-kill-ring-run-search-from-string) - (define-key map (kbd "C-]") 'helm-kill-ring-toggle-truncated) - (define-key map (kbd "C-c C-k") 'helm-kill-ring-kill-selection) - (define-key map (kbd "C-c d") 'helm-kill-ring-run-persistent-delete) - map) - "Keymap for `helm-show-kill-ring'.") - -(defvar helm-source-kill-ring - (helm-build-sync-source "Kill Ring" - :init (lambda () - (helm-set-attr 'last-command last-command) - (helm-set-attr 'multiline helm-kill-ring-max-offset)) - :candidates #'helm-kill-ring-candidates - :filtered-candidate-transformer #'helm-kill-ring-transformer - :action 'helm-kill-ring-actions - :persistent-action 'ignore - :help-message 'helm-kill-ring-help-message - :persistent-help "DoNothing" - :keymap helm-kill-ring-map - :migemo t - :multiline 'helm-kill-ring-max-offset - :group 'helm-ring) - "Source for browse and insert contents of kill-ring.") - -(defun helm-kill-ring-candidates () - (cl-loop with cands = (helm-fast-remove-dups kill-ring :test 'equal) - for kill in (if (eq (helm-get-attr 'last-command) 'yank) - (cdr cands) - cands) - unless (or (< (length kill) helm-kill-ring-threshold) - (string-match "\\`[\n[:blank:]]+\\'" kill)) - collect kill)) - -(defun helm-kill-ring-transformer (candidates _source) - "Ensure CANDIDATES are not read-only." - (cl-loop for i in candidates - when (get-text-property 0 'read-only i) - do (set-text-properties 0 (length i) '(read-only nil) i) - collect i)) - -(defvar helm-kill-ring--truncated-flag nil) -(defun helm-kill-ring-toggle-truncated () - "Toggle truncated view of candidates in helm kill-ring browser." - (interactive) - (with-helm-alive-p - (setq helm-kill-ring--truncated-flag (not helm-kill-ring--truncated-flag)) - (let* ((cur-cand (helm-get-selection)) - (presel-fn (lambda () - (helm-kill-ring--preselect-fn cur-cand))) - helm-display-source-at-screen-top) - (helm-set-attr 'multiline - (if helm-kill-ring--truncated-flag - 15000000 - helm-kill-ring-max-offset)) - (helm-update presel-fn)))) -(put 'helm-kill-ring-toggle-truncated 'helm-only t) - -(defun helm-kill-ring-kill-selection () - "Store the real value of candidate in kill-ring. -Same as `helm-kill-selection-and-quit' called with a prefix arg." - (interactive) - (helm-kill-selection-and-quit t)) -(put 'helm-kill-ring-kill-selection 'helm-only t) - -(defun helm-kill-ring--preselect-fn (candidate) - "Internal, used to preselect CANDIDATE when toggling truncated view." - ;; Preselection by regexp may not work if candidate is huge, so walk - ;; the helm buffer until selection is on CANDIDATE. - (helm-awhile (condition-case-unless-debug nil - (and (not (helm-pos-header-line-p)) - (helm-get-selection)) - (error nil)) - (if (string= it candidate) - (cl-return) - (helm-next-line)))) - -(defun helm-kill-ring-action-yank (_str) - "Insert concatenated marked candidates in current-buffer. - -When two prefix args are given prompt to choose separator, otherwise -use `helm-kill-ring-separator' as default." - (let ((marked (helm-marked-candidates)) - (sep (if (equal helm-current-prefix-arg '(16)) - (read-string "Separator: ") - helm-kill-ring-separator))) - (helm-kill-ring-action-yank-1 - (cl-loop for c in (butlast marked) - concat (concat c sep) into str - finally return (concat str (car (last marked))))))) - -(defun helm-kill-ring-action-yank-1 (str) - "Insert STR in `kill-ring' and set STR to the head. - -When called with a prefix arg, point and mark are exchanged -without activating region. -If this action is executed just after `yank', replace with STR as -yanked string." - (let ((yank-fn (lambda (&optional before yank-pop) - (insert-for-yank str) - ;; Set the window start back where it was in - ;; the yank command, if possible. - (when yank-pop - (set-window-start (selected-window) yank-window-start t)) - (when (or (equal helm-current-prefix-arg '(4)) before) - ;; Same as exchange-point-and-mark but without - ;; activating region. - (goto-char (prog1 (mark t) - (set-marker (mark-marker) - (point) - helm-current-buffer))))))) - ;; Prevent inserting and saving highlighted items. - (set-text-properties 0 (length str) nil str) - (with-helm-current-buffer - (unwind-protect - (progn - (setq kill-ring (delete str kill-ring)) - ;; Adding a `delete-selection' property - ;; to `helm-kill-ring-action' is not working - ;; because `this-command' will be `helm-maybe-exit-minibuffer', - ;; so use this workaround (Bug#1520). - (when (and (region-active-p) delete-selection-mode) - (delete-region (region-beginning) (region-end))) - (if (not (eq (helm-get-attr 'last-command helm-source-kill-ring) 'yank)) - (progn - ;; Ensure mark is at beginning of inserted text. - (push-mark) - ;; When yanking in a helm minibuffer we need a small - ;; delay to detect the mark in previous minibuffer. [1] - (run-with-timer 0.01 nil yank-fn)) - ;; from `yank-pop' - (let ((inhibit-read-only t) - (before (< (point) (mark t)))) - (if before - (funcall (or yank-undo-function 'delete-region) (point) (mark t)) - (funcall (or yank-undo-function 'delete-region) (mark t) (point))) - (setq yank-undo-function nil) - (set-marker (mark-marker) (point) helm-current-buffer) - ;; Same as [1] but use the same mark and point as in - ;; the initial yank according to BEFORE even if no - ;; prefix arg is given. - (run-with-timer 0.01 nil yank-fn before 'pop)))) - (kill-new str))))) -(define-obsolete-function-alias 'helm-kill-ring-action 'helm-kill-ring-action-yank "2.4.0") - -(defun helm-kill-ring-search-from-string (candidate) - (let ((str (car (split-string candidate "\n")))) - (helm-multi-occur-1 - (list (current-buffer)) - (regexp-quote (substring-no-properties str))))) - -(helm-make-command-from-action helm-kill-ring-run-search-from-string - "Run helm-occur from kill ring." - 'helm-kill-ring-search-from-string) - -(defun helm-kill-ring-action-delete (_candidate) - "Delete marked candidates from `kill-ring'." - (cl-loop for c in (helm-marked-candidates) - do (setq kill-ring - (delete c kill-ring)))) - -(defun helm-kill-ring-persistent-delete (_candidate) - (unwind-protect - (cl-loop for c in (helm-marked-candidates) - do (progn - (helm-preselect (format "^%s" (regexp-quote c))) - (setq kill-ring (delete c kill-ring)) - (helm-delete-current-selection) - (helm--remove-marked-and-update-mode-line c))) - (with-helm-buffer - (setq helm-marked-candidates nil - helm-visible-mark-overlays nil)) - (helm-force-update (helm-aif (helm-get-selection nil t) (regexp-quote it))))) - -(helm-make-persistent-command-from-action helm-kill-ring-run-persistent-delete - "Delete current candidate without quitting." - 'quick-delete 'helm-kill-ring-persistent-delete) - -(helm-make-command-from-action helm-kill-ring-delete - "Delete marked candidates from `kill-ring'." - 'helm-kill-ring-action-delete) - - -;;;; -;; DO NOT use these sources with other sources use -;; the commands `helm-mark-ring', `helm-global-mark-ring' or -;; `helm-all-mark-rings' instead. - -(defun helm-mark-ring-line-string-at-pos (pos) - "Return line string at position POS." - (save-excursion - (goto-char pos) - (forward-line 0) - (let ((line (car (split-string (thing-at-point 'line) "[\n\r]")))) - (remove-text-properties 0 (length line) '(read-only) line) - (if (string= "" line) - "" - line)))) - -(defun helm-mark-ring-get-candidates () - (with-helm-current-buffer - (cl-loop with marks = (if (mark t) - (cons (mark-marker) mark-ring) - mark-ring) - for marker in marks - with max-line-number = (line-number-at-pos (point-max)) - with width = (length (number-to-string max-line-number)) - for m = (format (concat "%" (number-to-string width) "d: %s") - (line-number-at-pos marker) - (helm-mark-ring-line-string-at-pos marker)) - unless (and recip (assoc m recip)) - collect (cons m marker) into recip - finally return recip))) - -(defun helm-mark-ring-default-action (candidate) - (let ((target (copy-marker candidate))) - (helm-aif (marker-buffer candidate) - (progn - (switch-to-buffer it) - (with-selected-window (get-buffer-window it) - (unless helm-in-persistent-action - (helm-log-run-hook - "helm-mark-ring-default-action" 'helm-goto-line-before-hook)) - (helm-match-line-cleanup) - (unless helm-yank-point (setq helm-yank-point (point))) - (helm-goto-char target) - (helm-highlight-current-line))) - ;; marker points to no buffer, no need to dereference it, just - ;; delete it. - (setq mark-ring (delete target mark-ring)) - (error "Marker points to no buffer")))) - -(defvar helm-source-mark-ring - (helm-build-sync-source "mark-ring" - :candidates #'helm-mark-ring-get-candidates - :action '(("Goto line" . helm-mark-ring-default-action)) - :persistent-help "Show this line" - :group 'helm-ring)) - -;;; Global-mark-ring -(defvar helm-source-global-mark-ring - (helm-build-sync-source "global-mark-ring" - :candidates #'helm-global-mark-ring-get-candidates - :action '(("Goto line" . helm-mark-ring-default-action)) - :persistent-help "Show this line" - :group 'helm-ring)) - -(defun helm-global-mark-ring-format-buffer (marker) - (with-current-buffer (marker-buffer marker) - (goto-char marker) - (forward-line 0) - (let ((line (helm-acase (thing-at-point 'line) - ((guard* (and (stringp it) - (not (string-match-p "\\`\n?\\'" it)))) - (car (split-string it "[\n\r]"))) - (t "")))) - (remove-text-properties 0 (length line) '(read-only) line) - (format "%7d:%s: %s" - (line-number-at-pos) (marker-buffer marker) line)))) - -(defun helm-global-mark-ring-get-candidates () - (let ((marks global-mark-ring)) - (when marks - (cl-loop for marker in marks - for mb = (marker-buffer marker) - for gm = (unless (or (string-match "^ " (format "%s" mb)) - (null mb)) - (helm-global-mark-ring-format-buffer marker)) - when (and gm (not (assoc gm recip))) - collect (cons gm marker) into recip - finally return recip)))) - -;;;; -;;; Insert from register -(defvar helm-source-register - (helm-build-sync-source "Registers" - :candidates #'helm-register-candidates - :action-transformer #'helm-register-action-transformer - :persistent-help "" - :multiline t - :action '(("Delete Register(s)" . - (lambda (_candidate) - (cl-loop for candidate in (helm-marked-candidates) - for register = (car candidate) - do (setq register-alist - (delq (assoc register register-alist) - register-alist)))))) - :group 'helm-ring) - "See (info \"(emacs)Registers\")") - -(defun helm-register-candidates () - "Collecting register contents and appropriate commands." - (require 'frameset) - (cl-loop for (char . rval) in register-alist - for key = (single-key-description char) - for e27 = (registerv-p rval) - for val = (if e27 ; emacs-27 - (registerv-data rval) - rval) - for string-actions = - (cond - ((numberp val) - (list (int-to-string val) - 'insert-register - 'increment-register)) - ((markerp val) - (let ((buf (marker-buffer val))) - (if (null buf) - (list "a marker in no buffer") - (list (concat - "a buffer position:" - (buffer-name buf) - ", position " - (int-to-string (marker-position val))) - 'jump-to-register - 'insert-register)))) - ((and (consp val) (window-configuration-p (car val))) - (list (if (fboundp 'describe-register-1) - (describe-register-1 char) "window configuration.") - 'jump-to-register)) - ((and (vectorp val) - (fboundp 'undo-tree-register-data-p) - (undo-tree-register-data-p (if e27 val (elt val 1)))) - (list - "Undo-tree entry." - 'undo-tree-restore-state-from-register)) - ((or (and (vectorp val) (eq 'registerv (aref val 0))) - (and (consp val) (frame-configuration-p (car val))) - (or (frame-configuration-p val) - (frameset-register-p val))) - (list (if (fboundp 'describe-register-1) - (describe-register-1 char) "Frame configuration") - 'jump-to-register)) - ((and (consp val) (eq (car val) 'file)) - (list (concat "file:" - (prin1-to-string (cdr val)) - ".") - 'jump-to-register)) - ((and (consp val) (eq (car val) 'buffer)) - (list (concat "buffer:" - (prin1-to-string (cdr val)) - ".") - 'jump-to-register)) - ((and (consp val) (eq (car val) 'file-query)) - (list (concat "file:a file-query reference: file " - (car (cdr val)) - ", position " - (int-to-string (car (cdr (cdr val)))) - ".") - 'jump-to-register)) - ((consp val) - (let ((lines (format "%4d" (length val)))) - (list (format "%s: %s\n" lines - (truncate-string-to-width - (mapconcat 'identity (list (car val)) - "^J") - (- (window-width) 15))) - 'insert-register))) - ((stringp val) - (list - (concat (substring-no-properties - val 0 (min (length val) helm-register-max-offset)) - (if (> (length val) helm-register-max-offset) - "[...]" "")) - 'insert-register - 'kill-new - 'append-to-register - 'prepend-to-register))) - unless (null string-actions) ; Fix Bug#1107. - collect (cons (format "Register %3s:\n %s" key (car string-actions)) - (cons char (cdr string-actions))))) - -(defun helm-register-action-transformer (actions register-and-functions) - "Decide actions by the contents of register." - (cl-loop with func-actions = - '((insert-register - "Insert Register" . - (lambda (c) (insert-register (car c)))) - (kill-new - "Kill Register" . - (lambda (c) (with-temp-buffer - (insert-register (car c)) - (kill-new (buffer-string))))) - (jump-to-register - "Jump to Register" . - (lambda (c) (jump-to-register (car c)))) - (append-to-register - "Append Region to Register" . - (lambda (c) (append-to-register - (car c) (region-beginning) (region-end)))) - (prepend-to-register - "Prepend Region to Register" . - (lambda (c) (prepend-to-register - (car c) (region-beginning) (region-end)))) - (increment-register - "Increment Prefix Arg to Register" . - (lambda (c) (increment-register - helm-current-prefix-arg (car c)))) - (undo-tree-restore-state-from-register - "Restore Undo-tree register" . - (lambda (c) (and (fboundp 'undo-tree-restore-state-from-register) - (undo-tree-restore-state-from-register (car c)))))) - for func in (cdr register-and-functions) - when (assq func func-actions) - collect (cdr it) into transformer-actions - finally return (append transformer-actions actions))) - -;;;###autoload -(defun helm-mark-ring () - "Preconfigured `helm' for `helm-source-mark-ring'." - (interactive) - (helm :sources 'helm-source-mark-ring - :resume 'noresume - :buffer "*helm mark*")) - -;;;###autoload -(defun helm-global-mark-ring () - "Preconfigured `helm' for `helm-source-global-mark-ring'." - (interactive) - (helm :sources 'helm-source-global-mark-ring - :resume 'noresume - :buffer "*helm global mark*")) - -;;;###autoload -(defun helm-all-mark-rings () - "Preconfigured `helm' for mark rings. -Source used are `helm-source-global-mark-ring' and -`helm-source-mark-ring'." - (interactive) - (helm :sources '(helm-source-mark-ring - helm-source-global-mark-ring) - :resume 'noresume - :buffer "*helm mark ring*")) - -;;;###autoload -(defun helm-register () - "Preconfigured `helm' for Emacs registers." - (interactive) - (helm :sources 'helm-source-register - :resume 'noresume - :buffer "*helm register*")) - -;;;###autoload -(defun helm-show-kill-ring () - "Preconfigured `helm' for `kill-ring'. -It is drop-in replacement of `yank-pop'. - -First call open the kill-ring browser, next calls move to next line." - (interactive) - (setq helm-kill-ring--truncated-flag nil) - (let ((enable-recursive-minibuffers t)) - (helm :sources helm-source-kill-ring - :buffer "*helm kill ring*" - ;; :display-source-at-screen-top nil - :resume 'noresume - :allow-nest t))) - -;;;###autoload -(defun helm-execute-kmacro () - "Preconfigured helm for keyboard macros. -Define your macros with `f3' and `f4'. -See (info \"(emacs) Keyboard Macros\") for detailed infos." - (interactive) - (let ((helm-quit-if-no-candidate - (lambda () (message "No kbd macro has been defined")))) - (helm :sources - (helm-build-sync-source "Kmacro" - :candidates (lambda () - (delq nil - (helm-fast-remove-dups - (cons (kmacro-ring-head) - kmacro-ring) - :test 'equal))) - - :multiline t - :candidate-transformer - (lambda (candidates) - (cl-loop for c in candidates - for keys = (if (functionp c) - ;; Emacs-29+ (Oclosure). - (kmacro--keys c) - ;; Emacs-28 and below (list). - (car c)) - collect (propertize (help-key-description keys nil) - 'helm-realvalue c))) - :persistent-action 'ignore - :persistent-help "Do nothing" - :help-message 'helm-kmacro-help-message - :action - (helm-make-actions - "Execute kmacro (`C-u ' to execute times)" - 'helm-kbd-macro-execute - "Concat marked macros" - 'helm-kbd-macro-concat-macros - "Delete marked macros" - 'helm-kbd-macro-delete-macro - "Edit marked macro" - 'helm-kbd-macro-edit-macro - "Insert kbd macro" - 'helm-kbd-macro-insert-macro) - :group 'helm-ring) - :buffer "*helm kmacro*"))) - -(defun helm-kbd-macro-make-current (candidate) - "Make CANDIDATE macro the current one." - (setq kmacro-ring (delete candidate kmacro-ring)) - (kmacro-push-ring) - (kmacro-split-ring-element candidate)) - -(defun helm-kbd-macro-insert-macro (candidate) - "Insert macro at point in `helm-current-buffer'." - (let ((desc (read-string "Describe macro briefly: ")) - name key) - (while (fboundp (setq name (intern (read-string "New name for macro: ")))) - (message "Symbol `%s' already exists, choose another name" name) - (sit-for 1.5)) - (helm-kbd-macro-make-current candidate) - (kmacro-name-last-macro name) - (when (y-or-n-p "Bind macro to a new key?") - (helm-awhile (key-binding - (setq key (read-key-sequence-vector "Bind macro to key: "))) - (message "`%s' already run command `%s', choose another one" - (help-key-description key nil) it) - (sit-for 1.5)) - (global-set-key key name)) - (with-helm-current-buffer - (insert (format ";; %s%s\n" - desc - (and key (format " (bound to `%s')" - (help-key-description key nil))))) - (insert-kbd-macro name (not (null key)))))) - -(defun helm-kbd-macro-execute (candidate) - ;; Move candidate on top of list for next use. - (helm-kbd-macro-make-current candidate) - (kmacro-exec-ring-item - candidate helm-current-prefix-arg)) - -(defun helm-kbd-macro-concat-macros (_candidate) - (let ((mkd (helm-marked-candidates))) - (when (cdr mkd) - (kmacro-push-ring) - (setq last-kbd-macro - (cl-loop for km in mkd - for keys = (if (functionp km) - (kmacro--keys km) - (helm-acase (car km) - ((guard* (vectorp it)) it) - ((guard* (stringp it)) - (kmacro--to-vector it)))) - vconcat keys))))) - -(defun helm-kbd-macro-delete-macro (_candidate) - (let ((mkd (helm-marked-candidates)) - (head (kmacro-ring-head))) - (cl-loop for km in mkd - do (setq kmacro-ring (delete km kmacro-ring))) - (when (member head mkd) - (kmacro-delete-ring-head)))) - -(defun helm-kbd-macro-edit-macro (candidate) - (kmacro-push-ring) - (setq kmacro-ring (delete candidate kmacro-ring)) - (kmacro-split-ring-element candidate) - (kmacro-edit-macro)) - -(provide 'helm-ring) - -;;; helm-ring.el ends here diff --git a/elpa/helm-20251212.555/helm-semantic.el b/elpa/helm-20251212.555/helm-semantic.el deleted file mode 100644 index 025019e9..00000000 --- a/elpa/helm-20251212.555/helm-semantic.el +++ /dev/null @@ -1,233 +0,0 @@ -;;; helm-semantic.el --- Helm interface for Semantic -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2017 Daniel Hackney -;; 2012 ~ 2023 Thierry Volpiatto - -;; Author: Daniel Hackney - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Commentary: - -;; Uses `candidates-in-buffer' for speed. - -;;; Code: - -(require 'cl-lib) -(require 'semantic) -(require 'helm-help) -(require 'helm-imenu) - -(declare-function pulse-momentary-highlight-one-line "pulse.el" (point &optional face)) - -(defgroup helm-semantic nil - "Semantic tags related libraries and applications for helm." - :group 'helm) - -(defcustom helm-semantic-display-style - '((python-mode . semantic-format-tag-summarize) - (c-mode . semantic-format-tag-concise-prototype-c-mode) - (emacs-lisp-mode . semantic-format-tag-abbreviate-emacs-lisp-mode)) - "Function to present a semantic tag according to `major-mode'. - -It is an alist where the `car' of each element is a `major-mode' and -the `cdr' a `semantic-format-tag-*' function. - -If no function is found for current `major-mode', fall back to -`semantic-format-tag-summarize' default function. - -You can have more or less informations depending of the `semantic-format-tag-*' -function you choose. - -All the supported functions are prefixed with \"semantic-format-tag-\", -you have completion on these functions with `C-M i' in the customize interface." - :group 'helm-semantic - :type '(alist :key-type symbol :value-type symbol)) - -;;; keymap -(defvar helm-semantic-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-map) - map)) - -(defcustom helm-semantic-lynx-style-map nil - "Use Arrow keys to jump to occurences." - :group 'helm-semantic - :type 'boolean - :set (lambda (var val) - (set var val) - (if val - (progn - (define-key helm-semantic-map (kbd "") 'helm-execute-persistent-action) - (define-key helm-semantic-map (kbd "") 'helm-maybe-exit-minibuffer)) - (define-key helm-semantic-map (kbd "") nil) - (define-key helm-semantic-map (kbd "") nil)))) - -;; Internals vars -(defvar helm-semantic--tags-cache nil) - -(defun helm-semantic--fetch-candidates (tags depth &optional class) - "Write the contents of TAGS to the current buffer." - (let ((class class) cur-type - (stylefn (or (with-helm-current-buffer - (assoc-default major-mode helm-semantic-display-style)) - #'semantic-format-tag-summarize))) - (dolist (tag tags) - (when (listp tag) - (cl-case (setq cur-type (semantic-tag-class tag)) - ((function variable type) - (let ((spaces (make-string (* depth 2) ?\s)) - (type-p (eq cur-type 'type))) - (unless (and (> depth 0) (not type-p)) - (setq class nil)) - (insert - (if (and class (not type-p)) - (format "%s%s(%s) " - spaces (if (< depth 2) "" "├►") class) - spaces) - ;; Save the tag for later - (propertize (funcall stylefn tag nil t) - 'semantic-tag tag) - "\n") - (and type-p (setq class (car tag))) - ;; Recurse to children - (unless (eq cur-type 'function) - (helm-semantic--fetch-candidates - (semantic-tag-components tag) (1+ depth) class)))) - - ;; Don't do anything with packages or includes for now - ((package include) - (insert - (propertize (funcall stylefn tag nil t) - 'semantic-tag tag) - "\n") - ) - ;; Catch-all - (t)))))) - -(defun helm-semantic-default-action (_candidate &optional persistent) - ;; By default, helm doesn't pass on the text properties of the selection. - ;; Fix this. - (helm-log-run-hook "helm-semantic-default-action" - 'helm-goto-line-before-hook) - (with-current-buffer helm-buffer - (when (looking-at " ") - (goto-char (next-single-property-change - (pos-bol) 'semantic-tag nil (pos-eol)))) - (let ((tag (get-text-property (point) 'semantic-tag))) - (semantic-go-to-tag tag) - (unless persistent - (pulse-momentary-highlight-one-line (point)))))) - -(defun helm-semantic--maybe-set-needs-update () - (with-helm-current-buffer - (when (semantic-parse-tree-needs-update-p) - (semantic-parse-tree-set-needs-update)))) - -(defvar helm-source-semantic nil) - -(defclass helm-semantic-source (helm-source-in-buffer) - ((init :initform (lambda () - (helm-semantic--maybe-set-needs-update) - (setq helm-semantic--tags-cache (semantic-fetch-tags)) - (with-current-buffer (helm-candidate-buffer 'global) - (let ((major-mode (with-helm-current-buffer major-mode))) - (helm-semantic--fetch-candidates helm-semantic--tags-cache 0))))) - (get-line :initform 'buffer-substring) - (persistent-help :initform "Show this entry") - (keymap :initform 'helm-semantic-map) - (help-message :initform 'helm-semantic-help-message) - (persistent-action :initform (lambda (elm) - (helm-semantic-default-action elm t) - (helm-highlight-current-line))) - (action :initform 'helm-semantic-default-action))) - -(defcustom helm-semantic-fuzzy-match nil - "Enable fuzzy matching in `helm-source-semantic'." - :group 'helm-semantic - :type 'boolean - :set (lambda (var val) - (set var val) - (setq helm-source-semantic - (helm-make-source "Semantic Tags" 'helm-semantic-source - :fuzzy-match helm-semantic-fuzzy-match)))) - -;;;###autoload -(defun helm-semantic (arg) - "Preconfigured `helm' for `semantic'. -If ARG is supplied, pre-select symbol at point instead of current." - (interactive "P") - (let ((tag (helm-aif (car (semantic-current-tag-parent)) - (let ((curtag (car (semantic-current-tag)))) - (if (string= it curtag) - (format "\\_<%s\\_>" curtag) - (cons (format "\\_<%s\\_>" it) - (format "\\_<%s\\_>" curtag)))) - (format "\\_<%s\\_>" (car (semantic-current-tag))))) - (helm-highlight-matches-around-point-max-lines 'never)) - (unless helm-source-semantic - (setq helm-source-semantic - (helm-make-source "Semantic Tags" 'helm-semantic-source - :fuzzy-match helm-semantic-fuzzy-match))) - (helm :sources 'helm-source-semantic - :candidate-number-limit 9999 - :preselect (if arg - (thing-at-point 'symbol) - tag) - :buffer "*helm semantic*"))) - -;;;###autoload -(defun helm-semantic-or-imenu (arg) - "Preconfigured helm for `semantic' or `imenu'. -If ARG is supplied, pre-select symbol at point instead of current -semantic tag in scope. - -If `semantic-mode' is active in the current buffer, then use -semantic for generating tags, otherwise fall back to `imenu'. -Fill in the symbol at point by default." - (interactive "P") - (unless helm-source-semantic - (setq helm-source-semantic - (helm-make-source "Semantic Tags" 'helm-semantic-source - :fuzzy-match helm-semantic-fuzzy-match))) - (unless helm-source-imenu - (setq helm-source-imenu - (helm-make-source "Imenu" 'helm-imenu-source - :fuzzy-match helm-imenu-fuzzy-match))) - (let* ((source (if (semantic-active-p) - 'helm-source-semantic - 'helm-source-imenu)) - (helm-highlight-matches-around-point-max-lines 'never) - (imenu-p (eq source 'helm-source-imenu)) - (imenu-auto-rescan imenu-p) - (str (thing-at-point 'symbol)) - (helm-execute-action-at-once-if-one - (and imenu-p - helm-imenu-execute-action-at-once-if-one)) - (tag (helm-aif (car (semantic-current-tag-parent)) - (let ((curtag (car (semantic-current-tag)))) - (if (string= it curtag) - (format "\\_<%s\\_>" curtag) - (cons (format "\\_<%s\\_>" it) - (format "\\_<%s\\_>" curtag)))) - (format "\\_<%s\\_>" (car (semantic-current-tag)))))) - (helm :sources source - :candidate-number-limit 9999 - :default (and imenu-p (list (concat "\\_<" (and str (regexp-quote str)) "\\_>") str)) - :preselect (if (or arg imenu-p) str tag) - :buffer "*helm semantic/imenu*"))) - -(provide 'helm-semantic) - -;;; helm-semantic.el ends here diff --git a/elpa/helm-20251212.555/helm-sys.el b/elpa/helm-20251212.555/helm-sys.el deleted file mode 100644 index 18c60492..00000000 --- a/elpa/helm-20251212.555/helm-sys.el +++ /dev/null @@ -1,476 +0,0 @@ -;;; helm-sys.el --- System related functions for helm. -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2025 Thierry Volpiatto - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Code: - -(require 'cl-lib) -(require 'helm) -(require 'helm-help) -(require 'helm-utils) - -(declare-function helm-comp-read "helm-mode") - - -(defgroup helm-sys nil - "System related helm library." - :group 'helm) - -(defface helm-top-columns - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :inherit helm-header)) - "Face for helm help string in minibuffer." - :group 'helm-sys) - - -(defcustom helm-top-command - (cl-case system-type - (darwin "env COLUMNS=%s ps -axo pid,user,pri,nice,ucomm,tty,start_time,vsz,%%cpu,%%mem,etime,command") - (t "env COLUMNS=%s top -b -n 1")) - "Top command used to display output of top. -A format string where %s will be replaced with `frame-width'. - -To use top command, a version supporting batch mode (-b option) -is needed. On Mac OSX top command doesn't support this, so the -ps command is used instead by default. - -Normally top command output have 12 columns, but in some -versions you may have less than this, so you can either customize -top to use 12 columns with the interactives f and W commands -of top, or modify `helm-top-sort-columns-alist' to fit with the -number of columns your top command is using. - -If you modify ps command be sure that pid comes in first and -\"env COLUMNS=%s\" is specified at beginning of command. Ensure -also that no elements contain spaces (e.g., use start_time and -not start). Same as for top: you can customize -`helm-top-sort-columns-alist' to make sort commands working -properly according to your settings." - :group 'helm-sys - :type 'string) - -(defcustom helm-top-sort-columns-alist '((com . 11) - (mem . 9) - (cpu . 8) - (user . 1)) - "Allow defining which column to use when sorting output of top/ps command. -Only com, mem, cpu and user are sorted, so no need to put something -else there,it will have no effect. -Note that column numbers are counted from zero, i.e. column 1 is the -nth 0 column." - :group 'helm-sys - :type '(alist :key-type symbol :value-type (integer :tag "Column number"))) - -(defcustom helm-top-poll-delay 1.5 - "Helm top poll after this delay when `helm-top-poll-mode' is enabled. -The minimal delay allowed is 1.5, if less than this helm-top will use 1.5." - :group 'helm-sys - :type 'float) - -(defcustom helm-top-poll-delay-post-command 1.0 - "Helm top stop polling during this delay. -This delay is added to `helm-top-poll-delay' after Emacs stops -being idle." - :group 'helm-sys - :type 'float) - -(defcustom helm-top-poll-preselection 'linum - "Stay on same line or follow candidate when `helm-top-poll' updates display. -Possible values are \\='candidate or \\='linum. -This affects also sorting functions in the same way." - :group'helm-sys - :type '(radio :tag "Preferred preselection action for helm-top" - (const :tag "Follow candidate" candidate) - (const :tag "Stay on same line" linum))) - -;;; Top (process) -;; -;; -(defvar helm-top-sort-fn nil) -(defvar helm-top-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-map) - (define-key map (kbd "M-P") 'helm-top-run-sort-by-cpu) - (define-key map (kbd "M-C") 'helm-top-run-sort-by-com) - (define-key map (kbd "M-M") 'helm-top-run-sort-by-mem) - (define-key map (kbd "M-U") 'helm-top-run-sort-by-user) - map)) - -(defvar helm-top-after-init-hook nil - "Local hook for helm-top.") - -(defvar helm-top--poll-timer nil) - -(defun helm-top-poll (&optional no-update delay) - (when helm-top--poll-timer - (cancel-timer helm-top--poll-timer)) - (condition-case nil - (progn - (when (and (helm--alive-p) (null no-update) - (null helm-suspend-update-flag)) - ;; Fix quitting while process is running - ;; by binding `with-local-quit' in init function - ;; Bug#1521. - (helm-force-update - (cl-ecase helm-top-poll-preselection - (candidate (replace-regexp-in-string - "[0-9]+" "[0-9]+" - (regexp-quote (helm-get-selection nil t)))) - (linum `(lambda () - (goto-char (point-min)) - (forward-line ,(helm-candidate-number-at-point))))))) - (setq helm-top--poll-timer - (run-with-idle-timer - (helm-aif (current-idle-time) - (time-add it (seconds-to-time - (or delay (helm-top--poll-delay)))) - (or delay (helm-top--poll-delay))) - nil - 'helm-top-poll))) - (quit (cancel-timer helm-top--poll-timer)))) - -(defun helm-top--poll-delay () - (max 1.5 helm-top-poll-delay)) - -(defun helm-top-poll-no-update () - (helm-top-poll t (+ (helm-top--poll-delay) - helm-top-poll-delay-post-command))) - -(defun helm-top-initialize-poll-hooks () - ;; When Emacs is idle during say 20s - ;; the idle timer will run in 20+1.5 s. - ;; This is fine when Emacs stays idle, because the next timer - ;; will run at 21.5+1.5 etc... so the display will be updated - ;; at every 1.5 seconds. - ;; But as soon as emacs looses its idleness, the next update - ;; will occur at say 21+1.5 s, so we have to reinitialize - ;; the timer at 0+1.5. - (add-hook 'post-command-hook 'helm-top-poll-no-update) - (add-hook 'focus-in-hook 'helm-top-poll-no-update)) - -;;;###autoload -(define-minor-mode helm-top-poll-mode - "Refresh automatically helm top buffer once enabled." - :group 'helm-top - :global t - (if helm-top-poll-mode - (progn - (add-hook 'helm-top-after-init-hook 'helm-top-poll-no-update) - (add-hook 'helm-top-after-init-hook 'helm-top-initialize-poll-hooks)) - (remove-hook 'helm-top-after-init-hook 'helm-top-poll-no-update) - (remove-hook 'helm-top-after-init-hook 'helm-top-initialize-poll-hooks))) - -(defvar helm-source-top - (helm-build-in-buffer-source "Top" - :header-name (lambda (name) - (concat name (if helm-top-poll-mode - " (auto updating)" - " (Press C-c C-u to refresh)"))) - :init #'helm-top-init - :after-init-hook 'helm-top-after-init-hook - :cleanup (lambda () - (when helm-top--poll-timer - (cancel-timer helm-top--poll-timer)) - (remove-hook 'post-command-hook 'helm-top-poll-no-update) - (remove-hook 'focus-in-hook 'helm-top-poll-no-update)) - :display-to-real #'helm-top-display-to-real - :persistent-action '(helm-top-sh-persistent-action . never-split) - :persistent-help "SIGTERM" - :help-message 'helm-top-help-message - :mode-line 'helm-top-mode-line - :follow 'never - :keymap helm-top-map - :filtered-candidate-transformer #'helm-top-sort-transformer - :action-transformer #'helm-top-action-transformer - :group 'helm-sys)) - -(defvar helm-top--line nil) -(defun helm-top-transformer (candidates _source) - "Transformer for `helm-top'. -Return empty string for non--valid candidates." - (cl-loop for disp in candidates collect - (cond ((string-match "^ *[0-9]+" disp) disp) - ((string-match "^ *PID" disp) - (setq helm-top--line (cons (propertize disp 'face 'helm-top-columns) ""))) - (t (cons disp ""))) - into lst - finally return (or (member helm-top--line lst) - (cons helm-top--line lst)))) - -(defun helm-top--skip-top-line () - (let ((src (helm-get-current-source))) - (when (helm-aand (assoc-default 'name src) - (string= it "Top") - (helm-get-selection nil t src) - (string-match-p "^ *PID" it)) - (helm-next-line)))) - -(defun helm-top-action-transformer (actions _candidate) - "Action transformer for `top'. -Show actions only on line starting by a PID." - (let ((disp (helm-get-selection nil t))) - (cond ((string-match "\\` *[0-9]+" disp) - `(("kill (SIGTERM)" . ,(lambda (_pid) - (helm-top-sh "TERM" (helm-top--marked-pids)))) - ("kill (SIGKILL)" . ,(lambda (_pid) - (helm-top-sh "KILL" (helm-top--marked-pids)))) - ("kill (SIGINT)" . ,(lambda (_pid) - (helm-top-sh "INT" (helm-top--marked-pids)))) - ("kill (Choose signal)" - . ,(lambda (_pid) - (let ((pids (helm-top--marked-pids))) - (helm-top-sh - (helm-comp-read (format "Kill %d pids with signal: " - (length pids)) - '("ALRM" "HUP" "INT" "KILL" "PIPE" "POLL" - "PROF" "TERM" "USR1" "USR2" "VTALRM" - "STKFLT" "PWR" "WINCH" "CHLD" "URG" - "TSTP" "TTIN" "TTOU" "STOP" "CONT" - "ABRT" "FPE" "ILL" "QUIT" "SEGV" - "TRAP" "SYS" "EMT" "BUS" "XCPU" "XFSZ") - :must-match t) - pids)))))) - (t actions)))) - -(defun helm-top--marked-pids () - (helm-remove-if-not-match "\\`[0-9]+\\'" (helm-marked-candidates))) - -(defun helm-top-sh (sig pids) - "Run kill shell command with signal SIG on PIDS for `helm-top'." - (message "kill -%s %s exited with status %s" - sig (mapconcat 'identity pids " ") - (apply #'call-process - "kill" nil nil nil (format "-%s" sig) pids))) - -(defun helm-top-sh-persistent-action (pid) - (helm-top-sh "TERM" (list pid)) - (helm-delete-current-selection)) - -(defun helm-top-init () - "Insert output of top command in candidate buffer." - (with-local-quit - (unless helm-top-sort-fn (helm-top-set-mode-line "CPU")) - (with-current-buffer (helm-candidate-buffer 'global) - (call-process-shell-command - (format helm-top-command (frame-width)) - nil (current-buffer))))) - -(defun helm-top-display-to-real (line) - "Return pid only from LINE." - (car (split-string line))) - -;; Sort top command - -(defun helm-top-set-mode-line (str) - (if (string-match "Sort:\\[\\(.*\\)\\] " helm-top-mode-line) - (setq helm-top-mode-line (replace-match str nil nil helm-top-mode-line 1)) - (setq helm-top-mode-line (concat (format "Sort:[%s] " str) helm-top-mode-line)))) - -(defun helm-top-sort-transformer (candidates source) - (helm-top-transformer - (if helm-top-sort-fn - (cl-loop for c in candidates - if (string-match "^ *[0-9]+" c) - collect c into pid-cands - else collect c into header-cands - finally return (append - header-cands - (sort pid-cands helm-top-sort-fn))) - candidates) - source)) - -(defun helm-top-sort-by-com (s1 s2) - (let* ((split-1 (split-string s1)) - (split-2 (split-string s2)) - (col (cdr (assq 'com helm-top-sort-columns-alist))) - (com-1 (nth col split-1)) - (com-2 (nth col split-2))) - (string< com-1 com-2))) - -(defun helm-top-sort-by-mem (s1 s2) - (let* ((split-1 (split-string s1)) - (split-2 (split-string s2)) - (col (cdr (assq 'mem helm-top-sort-columns-alist))) - (mem-1 (string-to-number (nth col split-1))) - (mem-2 (string-to-number (nth col split-2)))) - (> mem-1 mem-2))) - -(defun helm-top-sort-by-cpu (s1 s2) - (let* ((split-1 (split-string s1)) - (split-2 (split-string s2)) - (col (cdr (assq 'cpu helm-top-sort-columns-alist))) - (cpu-1 (string-to-number (nth col split-1))) - (cpu-2 (string-to-number (nth col split-2)))) - (> cpu-1 cpu-2))) - -(defun helm-top-sort-by-user (s1 s2) - (let* ((split-1 (split-string s1)) - (split-2 (split-string s2)) - (col (cdr (assq 'user helm-top-sort-columns-alist))) - (user-1 (nth col split-1)) - (user-2 (nth col split-2))) - (string< user-1 user-2))) - -(defun helm-top--preselect-fn () - (if (eq helm-top-poll-preselection 'linum) - `(lambda () - (goto-char (point-min)) - (forward-line ,(helm-candidate-number-at-point))) - (replace-regexp-in-string - "[0-9]+" "[0-9]+" - (regexp-quote (helm-get-selection nil t))))) - -(defun helm-top-run-sort-by-com () - (interactive) - (helm-top-set-mode-line "COM") - (setq helm-top-sort-fn 'helm-top-sort-by-com) - (helm-update (helm-top--preselect-fn))) - -(defun helm-top-run-sort-by-cpu () - (interactive) - (helm-top-set-mode-line "CPU") - ;; Force sorting by CPU even if some versions of top are using by - ;; default CPU sorting (Bug#1908). - (setq helm-top-sort-fn 'helm-top-sort-by-cpu) - (helm-update (helm-top--preselect-fn))) - -(defun helm-top-run-sort-by-mem () - (interactive) - (helm-top-set-mode-line "MEM") - (setq helm-top-sort-fn 'helm-top-sort-by-mem) - (helm-update (helm-top--preselect-fn))) - -(defun helm-top-run-sort-by-user () - (interactive) - (helm-top-set-mode-line "USER") - (setq helm-top-sort-fn 'helm-top-sort-by-user) - (helm-update (helm-top--preselect-fn))) - - -;;; X RandR resolution change -;; -;; -;;; FIXME I do not care multi-display. - -(defun helm-xrandr-info () - "Return a pair with current X screen number and current X display name." - (with-temp-buffer - (call-process "xrandr" nil (current-buffer) nil - "--current") - (let (screen output) - (goto-char (point-min)) - (save-excursion - (when (re-search-forward "\\(^Screen \\)\\([0-9]\\):" nil t) - (setq screen (match-string 2)))) - (when (re-search-forward "^\\(.*\\) connected" nil t) - (setq output (match-string 1))) - (list screen output)))) - -(defun helm-xrandr-screen () - "Return current X screen number." - (car (helm-xrandr-info))) - -(defun helm-xrandr-output () - "Return current X display name." - (cadr (helm-xrandr-info))) - -(defvar helm-source-xrandr-change-resolution - (helm-build-sync-source "Change Resolution" - :candidates - (lambda () - (with-temp-buffer - (call-process "xrandr" nil (current-buffer) nil - "--screen" (helm-xrandr-screen) "-q") - (goto-char 1) - (cl-loop while (re-search-forward " \\([0-9]+x[0-9]+\\)" nil t) - for mode = (match-string 1) - unless (member mode modes) - collect mode into modes - finally return modes))) - :action - (helm-make-actions "Change Resolution" - (lambda (mode) - (call-process "xrandr" nil nil nil - "--screen" (helm-xrandr-screen) - "--output" (helm-xrandr-output) - "--mode" mode))))) - - -;;; Emacs process -;; -;; -(defvar helm-source-emacs-process - (helm-build-sync-source "Emacs Process" - :init (lambda () - (let (tabulated-list-use-header-line) - (list-processes--refresh))) - :candidates (lambda () (mapcar #'process-name (process-list))) - :candidate-transformer - (lambda (candidates) - (cl-loop for c in candidates - for command = (mapconcat - 'identity - (process-command (get-process c)) " ") - if (and command (not (string= command ""))) collect - (cons (concat c " --> " - (mapconcat 'identity - (process-command (get-process c)) " ")) - c) - else collect c)) - :multiline t - :persistent-action (lambda (elm) - (delete-process (get-process elm)) - (helm-delete-current-selection)) - :persistent-help "Kill Process" - :action (helm-make-actions "Kill Process" - (lambda (_elm) - (cl-loop for p in (helm-marked-candidates) - do (delete-process (get-process p))))))) - - -;;;###autoload -(defun helm-top (&optional arg) - "Preconfigured `helm' for top command. -When prefix arg ARG is non nil toggle auto updating mode `helm-top-poll-mode'." - (interactive "P") - (when arg (helm-top-poll-mode 'toggle)) - (add-hook 'helm-after-update-hook 'helm-top--skip-top-line) - (unwind-protect - (helm :sources 'helm-source-top - :buffer "*helm top*" :full-frame t - :candidate-number-limit 9999 - :preselect "^\\s-*[0-9]+" - :truncate-lines helm-show-action-window-other-window) - (remove-hook 'helm-after-update-hook 'helm-top--skip-top-line))) - -;;;###autoload -(defun helm-list-emacs-process () - "Preconfigured `helm' for Emacs process." - (interactive) - (helm :sources 'helm-source-emacs-process - :truncate-lines t - :buffer "*helm process*")) - -;;;###autoload -(defun helm-xrandr-set () - "Preconfigured helm for xrandr." - (interactive) - (helm :sources 'helm-source-xrandr-change-resolution - :buffer "*helm xrandr*")) - -(provide 'helm-sys) - -;;; helm-sys.el ends here diff --git a/elpa/helm-20251212.555/helm-tags.el b/elpa/helm-20251212.555/helm-tags.el deleted file mode 100644 index 53a87773..00000000 --- a/elpa/helm-20251212.555/helm-tags.el +++ /dev/null @@ -1,336 +0,0 @@ -;;; helm-tags.el --- Helm for Etags. -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2025 Thierry Volpiatto - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Code: - -(require 'cl-lib) -(require 'helm) -(require 'helm-help) -(require 'helm-utils) -(require 'helm-grep) - -(defvar helm-etags-fuzzy-match) -(declare-function xref-push-marker-stack "xref") - - -(defgroup helm-tags nil - "Tags related Applications and libraries for Helm." - :group 'helm) - -(defcustom helm-etags-tag-file-name "TAGS" - "Etags tag file name." - :type 'string) - -(defcustom helm-etags-tag-file-search-limit 10 - "The limit level of directory to search tag file. -Don't search tag file deeply if outside this value." - :type 'number) - -(defcustom helm-etags-match-part-only 'tag - "Allow choosing the tag part of CANDIDATE in `helm-source-etags-select'. -A tag looks like this: - filename: (defun foo -You can choose matching against the tag part (i.e \"(defun foo\"), -or against the whole candidate (i.e \"(filename:5:(defun foo\")." - :type '(choice - (const :tag "Match only tag" tag) - (const :tag "Match all file+tag" all))) - -(defcustom helm-etags-execute-action-at-once-if-one t - "Whether to jump straight to the selected tag if there's only -one match." - :type 'boolean) - - -(defgroup helm-tags-faces nil - "Customize the appearance of helm-tags faces." - :prefix "helm-" - :group 'helm-tags - :group 'helm-faces) - -(defface helm-etags-file - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :foreground "Lightgoldenrod4" - :underline t)) - "Face used to highlight etags filenames." - :group 'helm-tags-faces) - - -;;; Etags -;; -;; -(defun helm-etags-find-file (candidate) - "Find file CANDIDATE from helm etags buffer." - (helm-etags-action-goto 'find-file candidate)) - -(defun helm-etags-find-file-other-window (candidate) - "Find file other window from helm etags buffer." - (helm-etags-action-goto 'find-file-other-window candidate)) - -(defun helm-etags-find-file-other-frame (candidate) - "Find file other frame from helm etags buffer." - (helm-etags-action-goto 'find-file-other-frame candidate)) - -(helm-make-command-from-action helm-etags-run-switch-other-window - "Run switch to other window action from `helm-source-etags-select'." - 'helm-etags-find-file-other-window) - -(helm-make-command-from-action helm-etags-run-switch-other-frame - "Run switch to other frame action from `helm-source-etags-select'." - 'helm-etags-find-file-other-frame) - -(defvar helm-etags-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-map) - (define-key map (kbd "M-") 'helm-goto-next-file) - (define-key map (kbd "M-") 'helm-goto-precedent-file) - (define-key map (kbd "C-c o") 'helm-etags-run-switch-other-window) - (define-key map (kbd "C-c C-o") 'helm-etags-run-switch-other-frame) - map) - "Keymap used in Etags.") - -(defvar helm-etags-mtime-alist nil - "Store the last modification time of etags files here.") -(defvar helm-etags-cache (make-hash-table :test 'equal) - "Cache content of etags files used here for faster access.") - -(defun helm-etags-get-tag-file (&optional directory) - "Return the path of etags file if found in DIRECTORY. -Look recursively in parents directorys for a -`helm-etags-tag-file-name' file." - ;; Get tag file from `default-directory' or upper directory. - (let ((current-dir (helm-etags-find-tag-file-directory - (or directory default-directory)))) - ;; Return nil if not find tag file. - (when current-dir - (expand-file-name helm-etags-tag-file-name current-dir)))) - -(defun helm-etags-all-tag-files () - "Find Etags files. -Return files from the following sources: - 1) An automatically located file in the parent directories, - by `helm-etags-get-tag-file'. - 2) `tags-file-name', which is commonly set by `find-tag' command. - 3) `tags-table-list' which is commonly set by `visit-tags-table' command." - (helm-fast-remove-dups - (delq nil - (append (list (helm-etags-get-tag-file) - tags-file-name) - tags-table-list)) - :test 'equal)) - -(defun helm-etags-find-tag-file-directory (current-dir) - "Try to find the directory containing tag file. -If not found in CURRENT-DIR search in upper directory." - (let ((file-exists? (lambda (dir) - (let ((tag-path (expand-file-name - helm-etags-tag-file-name dir))) - (and (stringp tag-path) - (file-regular-p tag-path) - (file-readable-p tag-path)))))) - (cl-loop with count = 0 - until (funcall file-exists? current-dir) - ;; Return nil if outside the value of - ;; `helm-etags-tag-file-search-limit'. - if (= count helm-etags-tag-file-search-limit) - do (cl-return nil) - ;; Or search upper directories. - else - do (cl-incf count) - (setq current-dir (expand-file-name (concat current-dir "../"))) - finally return current-dir))) - -(defun helm-etags-get-header-name (_x) - "Create header name for this helm etags session." - (concat "Etags in " - (with-helm-current-buffer - (helm-etags-get-tag-file)))) - -(defun helm-etags-create-buffer (file) - "Create the `helm-buffer' based on contents of etags tag FILE." - (let* (max - (split (with-temp-buffer - (insert-file-contents file) - (prog1 - (split-string (buffer-string) "\n" 'omit-nulls) - (setq max (line-number-at-pos (point-max)))))) - (progress-reporter (make-progress-reporter "Loading tag file..." 0 max))) - (cl-loop - with fname - with cand - for i in split for count from 0 - for elm = (unless (string-match "^\x0c" i) ;; "^L" - (helm-aif (string-match "\177" i) ;; "^?" - (substring i 0 it) - i)) - for linum = (when (string-match "[0-9]+,?[0-9]*$" i) - (car (split-string (match-string 0 i) ","))) - do (cond ((and elm (string-match "^\\([^,]+\\),[0-9]+$" elm)) - (setq fname (propertize (match-string 1 elm) - 'face 'helm-etags-file))) - (elm (setq cand (format "%s:%s:%s" fname linum elm))) - (t (setq cand nil))) - when cand do (progn - (insert (propertize (concat cand "\n") 'linum linum)) - (progress-reporter-update progress-reporter count))))) - -(defun helm-etags-init () - "Feed `helm-buffer' using `helm-etags-cache' or tag file. -If there is no entry in cache, create one." - (let ((tagfiles (helm-etags-all-tag-files))) - (when tagfiles - (with-current-buffer (helm-candidate-buffer 'global) - (dolist (f tagfiles) - (helm-aif (gethash f helm-etags-cache) - ;; An entry is present in cache, insert it. - (insert it) - ;; No entry, create a new buffer using content of tag file (slower). - (helm-etags-create-buffer f) - ;; Store content of buffer in cache. - (puthash f (buffer-string) helm-etags-cache) - ;; Store or set the last modification of tag file. - (helm-aif (assoc f helm-etags-mtime-alist) - ;; If an entry exists modify it. - (setcdr it (helm-etags-mtime f)) - ;; No entry create a new one. - (cl-pushnew (cons f (helm-etags-mtime f)) - helm-etags-mtime-alist - :test 'equal)))))))) - -(defvar helm-source-etags-select nil - "Helm source for Etags.") - -(defun helm-etags-build-source () - (helm-build-in-buffer-source "Etags" - :header-name 'helm-etags-get-header-name - :init 'helm-etags-init - :get-line 'buffer-substring - :match-part (lambda (candidate) - ;; Match only the tag part of CANDIDATE - ;; and not the filename. - (cl-case helm-etags-match-part-only - (tag (cl-caddr (helm-grep-split-line candidate))) - (t candidate))) - :fuzzy-match helm-etags-fuzzy-match - :help-message 'helm-etags-help-message - :keymap helm-etags-map - :action '(("Go to tag" . helm-etags-find-file) - ("Go to tag in other window" . helm-etags-find-file-other-window) - ("Go to tag in other frame" . helm-etags-find-file-other-frame)) - :group 'helm-tags - :persistent-help "Go to line" - :persistent-action (lambda (candidate) - (helm-etags-action-goto 'find-file candidate) - (helm-highlight-current-line)))) - -(defcustom helm-etags-fuzzy-match nil - "Use fuzzy matching in `helm-etags-select'." - :group 'helm-tags - :type 'boolean - :set (lambda (var val) - (set var val) - (setq helm-source-etags-select - (helm-etags-build-source)))) - -(defsubst helm-etags--file-from-tag (fname) - (cl-loop for ext in - (cons "" (remove "" tags-compression-info-list)) - for file = (concat fname ext) - when (file-exists-p file) - return file)) - -(defun helm-etags-action-goto (switcher candidate) - "Helm default action to jump to an etags entry in other window." - (require 'etags) - (deactivate-mark t) - (helm-log-run-hook "helm-etags-action-goto " 'helm-goto-line-before-hook) - (let* ((split (helm-grep-split-line candidate)) - (fname (cl-loop for tagf being the hash-keys of helm-etags-cache - for f = (expand-file-name - (car split) (file-name-directory tagf)) - ;; Try to find an existing file, possibly compressed. - when (helm-etags--file-from-tag f) - return it)) - (elm (cl-caddr split)) - (linum (string-to-number (cadr split)))) - (if (null fname) - (error "file %s not found" fname) - (xref-push-marker-stack) - (funcall switcher fname) - (helm-goto-line linum t) - (when (search-forward elm nil t) - (goto-char (match-beginning 0)))))) - -(defun helm-etags-mtime (file) - "Last modification time of etags tag FILE." - (cadr (nth 5 (file-attributes file)))) - -(defun helm-etags-file-modified-p (file) - "Check if tag FILE have been modified in this session. -If FILE is nil return nil." - (let ((last-modif (and file - (assoc-default file helm-etags-mtime-alist)))) - (and last-modif - (/= last-modif (helm-etags-mtime file))))) - -;;;###autoload -(defun helm-etags-select (reinit) - "Preconfigured helm for etags. -If called with a prefix argument REINIT -or if any of the tag files have been modified, reinitialize cache. - -This function aggregates three sources of tag files: - - 1) An automatically located file in the parent directories, - by `helm-etags-get-tag-file'. - 2) `tags-file-name', which is commonly set by `find-tag' command. - 3) `tags-table-list' which is commonly set by `visit-tags-table' command." - (interactive "P") - (let ((tag-files (helm-etags-all-tag-files)) - (helm-execute-action-at-once-if-one - helm-etags-execute-action-at-once-if-one) - (str (if (region-active-p) - (buffer-substring-no-properties - (region-beginning) (region-end)) - (thing-at-point 'symbol)))) - (cl-assert (cl-loop for f in tag-files thereis (file-exists-p f)) - nil "No TAGS file found") - (cl-loop for k being the hash-keys of helm-etags-cache - unless (member k tag-files) - do (remhash k helm-etags-cache)) - (mapc (lambda (f) - (when (or (equal reinit '(4)) - (and helm-etags-mtime-alist - (helm-etags-file-modified-p f))) - (remhash f helm-etags-cache))) - tag-files) - (unless helm-source-etags-select - (setq helm-source-etags-select - (helm-etags-build-source))) - (helm :sources 'helm-source-etags-select - :keymap helm-etags-map - :default (and (stringp str) - (if (or helm-etags-fuzzy-match - (and (eq major-mode 'haskell-mode) - (string-match "[']\\'" str))) - str - (list (concat "\\_<" str "\\_>") str))) - :buffer "*helm etags*"))) - -(provide 'helm-tags) - -;;; helm-tags.el ends here diff --git a/elpa/helm-20251212.555/helm-types.el b/elpa/helm-20251212.555/helm-types.el deleted file mode 100644 index c7be1efb..00000000 --- a/elpa/helm-20251212.555/helm-types.el +++ /dev/null @@ -1,342 +0,0 @@ -;;; helm-types.el --- Helm types classes and methods. -*- lexical-binding: t -*- - -;; Copyright (C) 2015 ~ 2025 Thierry Volpiatto - -;; Author: Thierry Volpiatto -;; URL: http://github.com/emacs-helm/helm - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - - -;;; Code: - -(require 'cl-lib) -(require 'eieio) -(eval-when-compile (require 'helm-source)) - -(defvar helm-map) -(defvar helm-mode-line-string) -(defvar helm-bookmark-map) -(declare-function helm-make-actions "helm-lib") -(declare-function helm-ediff-marked-buffers "helm-buffers") -(declare-function helm-make-type "helm-source") -(declare-function helm-marked-candidates "helm-core") - -;; Files -(defclass helm-type-file (helm-source) - ((completing-file-name - :initarg :completing-file-name :initform t - :documentation "Flag to notify we are completing filenames.")) - "A class to define helm type file.") - -(cl-defmethod helm-source-get-action-from-type ((object helm-type-file)) - (slot-value object 'action)) - -(defun helm-actions-from-type-file () - (let ((source (make-instance 'helm-type-file))) - (helm--setup-source source) - (helm-source-get-action-from-type source))) - -(defvar helm-generic-files-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-map) - (define-key map (kbd "C-]") 'helm-ff-run-toggle-basename) - (define-key map (kbd "C-s") 'helm-ff-run-grep) - (define-key map (kbd "M-g s") 'helm-ff-run-grep) - (define-key map (kbd "M-g z") 'helm-ff-run-zgrep) - (define-key map (kbd "M-g p") 'helm-ff-run-pdfgrep) - (define-key map (kbd "M-R") 'helm-ff-run-rename-file) - (define-key map (kbd "M-C") 'helm-ff-run-copy-file) - (define-key map (kbd "M-B") 'helm-ff-run-byte-compile-file) - (define-key map (kbd "M-L") 'helm-ff-run-load-file) - (define-key map (kbd "M-S") 'helm-ff-run-symlink-file) - (define-key map (kbd "M-H") 'helm-ff-run-hardlink-file) - (define-key map (kbd "M-D") 'helm-ff-run-delete-file) - (define-key map (kbd "C-=") 'helm-ff-run-ediff-file) - (define-key map (kbd "C-c =") 'helm-ff-run-ediff-merge-file) - (define-key map (kbd "C-c o") 'helm-ff-run-switch-other-window) - (define-key map (kbd "C-c r") 'helm-ff-run-find-file-as-root) - (define-key map (kbd "C-c C-o") 'helm-ff-run-switch-other-frame) - (define-key map (kbd "M-i") 'helm-ff-properties-persistent) - (define-key map (kbd "C-c C-x") 'helm-ff-run-open-file-externally) - (define-key map (kbd "C-c X") 'helm-ff-run-open-file-with-default-tool) - (define-key map (kbd "C-c @") 'helm-ff-run-insert-org-link) - (define-key map (kbd "C-x C-q") 'helm-ff-run-marked-files-in-dired) - (define-key map (kbd "C-c C-a") 'helm-ff-run-mail-attach-files) - map) - "Generic Keymap for files.") - -(defcustom helm-type-file-actions - (helm-make-actions - "Find file" 'helm-find-file-or-marked - "Find file as root" 'helm-find-file-as-root - "Find file other window" 'helm-find-files-other-window - "Find file other frame" 'find-file-other-frame - "Open dired in file's directory" 'helm-open-dired - "Attach file(s) to mail buffer `C-c C-a'" 'helm-ff-mail-attach-files - "Marked files in dired" 'helm-marked-files-in-dired - "Grep File(s) `C-u recurse'" 'helm-find-files-grep - "Zgrep File(s) `C-u Recurse'" 'helm-ff-zgrep - "Pdfgrep File(s)" 'helm-ff-pdfgrep - "Insert as org link" 'helm-files-insert-as-org-link - "Checksum File" 'helm-ff-checksum - "Ediff File" 'helm-find-files-ediff-files - "Ediff Merge File" 'helm-find-files-ediff-merge-files - "View file" 'view-file - "Insert file" 'insert-file - "Add marked files to file-cache" 'helm-ff-cache-add-file - "Delete file(s)" 'helm-ff-delete-files - "Copy file(s) `M-C, C-u to follow'" 'helm-find-files-copy - "Rename file(s) `M-R, C-u to follow'" 'helm-find-files-rename - "Symlink files(s) `M-S, C-u to follow'" 'helm-find-files-symlink - "Relsymlink file(s) `C-u to follow'" 'helm-find-files-relsymlink - "Hardlink file(s) `M-H, C-u to follow'" 'helm-find-files-hardlink - "Open file externally (C-u to choose)" 'helm-open-file-externally - "Open file with default tool" 'helm-open-file-with-default-tool - "Find file in hex dump" 'hexl-find-file) - "Default actions for type files." - :group 'helm-files - :type '(alist :key-type string :value-type function)) - -(cl-defmethod helm--setup-source ((_source helm-type-file))) - -(cl-defmethod helm--setup-source :before ((source helm-type-file)) - (setf (slot-value source 'action) 'helm-type-file-actions) - (setf (slot-value source 'persistent-help) "Show this file") - (setf (slot-value source 'action-transformer) - '(helm-transform-file-load-el - helm-transform-file-browse-url - helm-transform-file-cache)) - (setf (slot-value source 'candidate-transformer) - '(helm-skip-boring-files - helm-w32-pathname-transformer)) - (setf (slot-value source 'filtered-candidate-transformer) - 'helm-highlight-files) - (setf (slot-value source 'help-message) 'helm-generic-file-help-message) - (setf (slot-value source 'mode-line) (list "File(s)" helm-mode-line-string)) - (setf (slot-value source 'keymap) helm-generic-files-map) - (setf (slot-value source 'group) 'helm-files)) - - -;; Bookmarks -(defclass helm-type-bookmark (helm-source) () - "A class to define type bookmarks.") - -(defcustom helm-type-bookmark-actions - (helm-make-actions - "Jump to bookmark" 'helm-bookmark-jump - "Jump to BM other window" 'helm-bookmark-jump-other-window - "Jump to BM other frame" 'helm-bookmark-jump-other-frame - "Jump to BM other tab" 'helm-bookmark-jump-other-tab - "Show bookmark annotation" 'helm-bookmark-show-annotation - "Bookmark edit annotation" 'bookmark-edit-annotation - "Delete marked bookmark(s)" 'helm-delete-marked-bookmarks - "Edit Bookmark" 'helm-bookmark-edit-bookmark - "Reset Bookmark to current pos" 'bookmark-set - "Rename marked bookmark(s)" 'helm-bookmark-rename-marked - "Relocate bookmark" 'bookmark-relocate) - "Default actions for type bookmarks." - :group 'helm-bookmark - :type '(alist :key-type string - :value-type function)) - -(cl-defmethod helm-source-get-action-from-type ((object helm-type-bookmark)) - (slot-value object 'action)) - -(cl-defmethod helm--setup-source ((_source helm-type-bookmark))) - -(cl-defmethod helm--setup-source :before ((source helm-type-bookmark)) - (setf (slot-value source 'action) 'helm-type-bookmark-actions) - (setf (slot-value source 'keymap) helm-bookmark-map) - (setf (slot-value source 'mode-line) (list "Bookmark(s)" helm-mode-line-string)) - (setf (slot-value source 'help-message) 'helm-bookmark-help-message) - (setf (slot-value source 'migemo) t) - (setf (slot-value source 'follow) 'never) - (setf (slot-value source 'group) 'helm-bookmark)) - - -;; Buffers -(defclass helm-type-buffer (helm-source) () - "A class to define type buffer.") - -(defcustom helm-type-buffer-actions - (helm-make-actions - "Switch to buffer(s)" 'helm-buffer-switch-buffers - "Switch to buffer(s) other window `C-c o'" - 'helm-buffer-switch-buffers-other-window - "Switch to buffer(s) other frame `C-c C-o'" - 'helm-buffer-switch-to-buffer-other-frame - "Raise buffer frame maybe" - 'helm-buffers-maybe-raise-buffer-frame - (lambda () (and (fboundp 'tab-bar-mode) - "Switch to buffer(s) other tab `C-c C-t'")) - 'helm-buffers-switch-buffers-in-tab - "Switch to buffer at line number" - 'helm-switch-to-buffer-at-linum - "Browse project `C-x C-d'" - 'helm-buffers-browse-project - "Switch to shell" - 'helm-buffer-switch-to-shell - "Query replace regexp `C-M-%'" - 'helm-buffer-query-replace-regexp - "Query replace `M-%'" 'helm-buffer-query-replace - "View buffer" 'view-buffer - "Display buffer" 'display-buffer - "Rename buffer `M-R'" 'helm-buffers-rename-buffer - "Grep buffer(s) `M-g s' (C-u grep all buffers)" - 'helm-zgrep-buffers - "Multi occur buffer(s) `C-s (C-u search also in current)'" - 'helm-multi-occur-as-action - "Revert buffer(s) `M-G'" 'helm-revert-marked-buffers - "Insert buffer" 'insert-buffer - "Kill buffer(s) `M-D'" 'helm-kill-marked-buffers - "Diff with file `C-='" 'diff-buffer-with-file - "Ediff Marked buffers `C-c ='" 'helm-ediff-marked-buffers - "Ediff Merge marked buffers `M-='" - (lambda (candidate) - (helm-ediff-marked-buffers candidate t))) - "Default actions for type buffers." - :group 'helm-buffers - :type '(alist :key-type string :value-type function)) - -(cl-defmethod helm-source-get-action-from-type ((object helm-type-buffer)) - (slot-value object 'action)) - -(cl-defmethod helm--setup-source ((_source helm-type-buffer))) - -(cl-defmethod helm--setup-source :before ((source helm-type-buffer)) - (setf (slot-value source 'action) 'helm-type-buffer-actions) - (setf (slot-value source 'persistent-help) "Show this buffer") - (setf (slot-value source 'mode-line) - ;; Use default-value of `helm-mode-line-string' in case user - ;; starts with a helm buffer as current-buffer otherwise the - ;; local value of this helm buffer is used (bug#1517, bug#2377). - (list "Buffer(s)" (default-value 'helm-mode-line-string))) - (setf (slot-value source 'filtered-candidate-transformer) - '(helm-skip-boring-buffers - helm-buffers-sort-transformer - helm-highlight-buffers)) - (setf (slot-value source 'group) 'helm-buffers)) - -;; Functions -(defclass helm-type-function (helm-source) () - "A class to define helm type function.") - -(defcustom helm-type-function-actions - (helm-make-actions - "Describe function" 'helm-describe-function - "Find function (C-u for source)" 'helm-find-function - "Info lookup" 'helm-info-lookup-symbol - "Debug on entry" 'debug-on-entry - "Cancel debug on entry" 'cancel-debug-on-entry - "Trace function" 'trace-function - "Trace function (background)" 'trace-function-background - "Untrace function" 'untrace-function) - "Default actions for type functions." - :group 'helm-elisp - ;; Use symbol as value type because some functions may not be - ;; autoloaded (like untrace-function). - :type '(alist :key-type string :value-type symbol)) - -(cl-defmethod helm-source-get-action-from-type ((object helm-type-function)) - (slot-value object 'action)) - -(defun helm-actions-from-type-function () - (let ((source (make-instance 'helm-type-function))) - (helm--setup-source source) - (helm-source-get-action-from-type source))) - -(cl-defmethod helm--setup-source ((_source helm-type-function))) - -(cl-defmethod helm--setup-source :before ((source helm-type-function)) - (setf (slot-value source 'action) 'helm-type-function-actions) - (setf (slot-value source 'action-transformer) - 'helm-transform-function-call-interactively) - (setf (slot-value source 'candidate-transformer) - 'helm-mark-interactive-functions) - (setf (slot-value source 'coerce) 'helm-symbolify)) - - -;; Commands -(defclass helm-type-command (helm-source) () - "A class to define helm type command.") - -(defun helm-actions-from-type-command () - (let ((source (make-instance 'helm-type-command))) - (helm--setup-source source) - (helm-source-get-action-from-type source))) - -(defcustom helm-type-command-actions - (append (helm-make-actions - "Execute command" 'helm-M-x-execute-command) - (symbol-value - (helm-actions-from-type-function))) - "Default actions for type command." - :group 'helm-command - :type '(alist :key-type string :value-type symbol)) - -(cl-defmethod helm--setup-source ((_source helm-type-command))) - -(cl-defmethod helm--setup-source :before ((source helm-type-command)) - (setf (slot-value source 'action) 'helm-type-command-actions) - (setf (slot-value source 'coerce) 'helm-symbolify) - (setf (slot-value source 'persistent-action) 'helm-M-x-persistent-action) - (setf (slot-value source 'persistent-help) "Describe this command") - (setf (slot-value source 'group) 'helm-command)) - -;; Timers -(defclass helm-type-timers (helm-source) () - "A class to define helm type timers.") - -(defcustom helm-type-timers-actions - `(("Cancel Timer" . ,(lambda (_timer) - (let ((mkd (helm-marked-candidates))) - (cl-loop for timer in mkd - do (cancel-timer timer))))) - ("Describe Function" . ,(lambda (tm) - (describe-function (timer--function tm)))) - ("Find Function" . ,(lambda (tm) - (helm-aif (timer--function tm) - (if (or (byte-code-function-p it) - (helm-subr-native-elisp-p it)) - (message "Can't find anonymous function `%s'" it) - (find-function it)))))) - "Default actions for type timers." - :group 'helm-elisp - :type '(alist :key-type string :value-type function)) - -(cl-defmethod helm--setup-source ((_source helm-type-timers))) - -(cl-defmethod helm--setup-source :before ((source helm-type-timers)) - (setf (slot-value source 'action) 'helm-type-timers-actions) - (setf (slot-value source 'persistent-action) - (lambda (tm) - (describe-function (timer--function tm)))) - (setf (slot-value source 'persistent-help) "Describe Function") - (setf (slot-value source 'group) 'helm-elisp)) - -;; Builders. -(defun helm-build-type-file () - (helm-make-type 'helm-type-file)) -(make-obsolete 'helm-build-type-file 'helm-make-source "4.0.3") -(defun helm-build-type-function () - (helm-make-type 'helm-type-function)) -(make-obsolete 'helm-build-type-function 'helm-make-source "4.0.3") -(defun helm-build-type-command () - (helm-make-type 'helm-type-command)) -(make-obsolete 'helm-build-type-command 'helm-make-source "4.0.3") - -(provide 'helm-types) - -;;; helm-types.el ends here diff --git a/elpa/helm-20251212.555/helm-utils.el b/elpa/helm-20251212.555/helm-utils.el deleted file mode 100644 index fed5c2ee..00000000 --- a/elpa/helm-20251212.555/helm-utils.el +++ /dev/null @@ -1,1232 +0,0 @@ -;;; helm-utils.el --- Utilities Functions for helm. -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2025 Thierry Volpiatto - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Code: - -(require 'cl-lib) -(require 'helm) -(require 'helm-help) - -(declare-function helm-find-files-1 "helm-files" (fname &optional preselect)) -(declare-function helm-grep-split-line "helm-grep" (line)) -(declare-function markdown-show-entry "ext:markdown-mode.el") -(declare-function outline-show-subtree "outline") -(declare-function org-reveal "org") -(declare-function hs-show-block "hideshow.el") -(declare-function hs-show-all "hideshow.el") -(declare-function tab-bar-tabs "tab-bar") -(declare-function tab-bar-select-tab "tab-bar") -(declare-function dired-goto-file "dired") -(declare-function bookmark-get-filename "bookmark") -(declare-function package-installed-p "package") -(declare-function package-desc-dir "package") - -(defvar hs-minor-mode) -(defvar hs-show-hook) -(defvar org-directory) -(defvar winner-boring-buffers) -(defvar bookmark-alist) -(defvar dired-buffers) -(defvar helm-show-completion-overlay) -(defvar helm-buffers-maybe-switch-to-tab) -(defvar helm-ff-transformer-show-only-basename) -(defvar helm-popup-tip-mode) -(defvar helm-ff-last-expanded-candidate-regexp) -(defvar helm-mode-find-file-target-alist) - -(defgroup helm-utils nil - "Utilities routines for Helm." - :group 'helm) - -(defcustom helm-su-or-sudo "sudo" - "What command to use for root access." - :type 'string - :group 'helm-utils) - -(defcustom helm-default-kbsize 1024.0 - "Default Kbsize to use for showing files size. -It is a float, usually 1024.0 but could be 1000.0 on some systems." - :group 'helm-utils - :type 'float) - -(define-obsolete-variable-alias - 'helm-highlight-number-lines-around-point - 'helm-highlight-matches-around-point-max-lines - "20160119") - -(defcustom helm-highlight-matches-around-point-max-lines '(15 . 15) - "Number of lines around point where matched items are highlighted. - -Possible value are: -- A cons cell (x . y) - Match x lines before point and y lines after point. -- An integer - Positive means this number lines after point. - Negative means this number lines before point. - A zero value means highlight only inside matched lines. -- The symbol never - Means do not highlight matched items. " - :group 'helm-utils - :type '(choice (cons (integer :tag "Match before") - (integer :tag "Match after")) - (const :tag "Match in line only" 0) - (integer :tag "Match after or before (+/-)") - (const :tag "Never match" never))) - -(defcustom helm-highlight-only-all-matches nil - "Highlight only when all items match on the line when non nil. -See `helm-highlight-current-line'." - :group 'helm-utils - :type 'boolean) - -(defcustom helm-buffers-to-resize-on-pa nil - "A list of helm buffers where the helm-window should be reduced on PA. -Where PA means persistent action." - :group 'helm-utils - :type '(repeat (choice string))) - -(defcustom helm-resize-on-pa-text-height 12 - "The size of the helm-window when resizing on persistent action." - :group 'helm-utils - :type 'integer) - -(defcustom helm-html-decode-entities-function #'helm-html-decode-entities-string - "Function used to decode HTML entities in HTML bookmarks. -Helm comes by default with `helm-html-decode-entities-string', if -you need something more sophisticated you can use -`w3m-decode-entities-string' if available. - -In Emacs itself org-entities seem broken and `xml-substitute-numeric-entities' -supports only numeric entities." - :group 'helm-utils - :type 'function) - - -(defvar helm-goto-line-before-hook '(helm-save-current-pos-to-mark-ring) - "Run before jumping to line. -This hook runs when jumping from `helm-goto-line', `helm-etags-default-action', -`helm-imenu-default-action' and `helm-mark-ring-default-action' itself. -This allows you to retrieve a previous position after using the different helm -tools for searching or retrieving a position (etags, grep, gid, (m)occur etc...). -By default positions are added to `mark-ring'. - -You can also add to register by using (or adding) -`helm-save-pos-to-register-before-jump' instead. In this case -last position is added to the register `helm-save-pos-before-jump-register'. -Note that when using a register only one position is saved globally to registers -whereas when using `mark-ring' all positions are saved locally in each buffer.") - -(defvar helm-save-pos-before-jump-register ?_ - "The register where `helm-save-pos-to-register-before-jump' saves position.") - -(defconst helm-html-entities-alist - '((""" . 34) ;; " - (">" . 62) ;; > - ("<" . 60) ;; < - ("&" . 38) ;; & - ("€" . 8364) ;; € - ("Ÿ" . 89) ;; Y - ("¡" . 161) ;; ¡ - ("¢" . 162) ;; ¢ - ("£" . 163) ;; £ - ("¤" . 164) ;; ¤ - ("¥" . 165) ;; Â¥ - ("¦" . 166) ;; ¦ - ("§" . 167) ;; § - ("¨" . 32) ;; SPC - (" " . 160) ;;   (non breaking space) - ("©" . 169) ;; © - ("ª" . 97) ;; a - ("«" . 171) ;; « - ("¬" . 172) ;; ¬ - ("&masr;" . 174) ;; ® - ("°" . 176) ;; ° - ("±" . 177) ;; ± - ("²" . 50) ;; 2 - ("³" . 51) ;; 3 - ("´" . 39) ;; ' - ("µ" . 956) ;; μ - ("¶" . 182) ;; ¶ - ("·" . 183) ;; · - ("¸" . 32) ;; SPC - ("¹" . 49) ;; 1 - ("º" . 111) ;; o - ("»" . 187) ;; » - ("¼" . 49) ;; 1 - ("½" . 49) ;; 1 - ("¾" . 51) ;; 3 - ("¿" . 191) ;; ¿ - ("À" . 192) ;; À - ("Á" . 193) ;; Á - ("Â" . 194) ;;  - ("Ã" . 195) ;; à - ("Ä" . 196) ;; Ä - ("Å" . 197) ;; Å - ("&Aelig" . 198) ;; Æ - ("Ç" . 199) ;; Ç - ("È" . 200) ;; È - ("É" . 201) ;; É - ("Ê" . 202) ;; Ê - ("Ë" . 203) ;; Ë - ("Ì" . 204) ;; Ì - ("Í" . 205) ;; Í - ("Î" . 206) ;; Î - ("Ï" . 207) ;; Ï - ("ð" . 208) ;; Ð - ("Ñ" . 209) ;; Ñ - ("Ò" . 210) ;; Ò - ("Ó" . 211) ;; Ó - ("Ô" . 212) ;; Ô - ("Õ" . 213) ;; Õ - ("Ö" . 214) ;; Ö - ("×" . 215) ;; × - ("Ø" . 216) ;; Ø - ("Ù" . 217) ;; Ù - ("Ú" . 218) ;; Ú - ("Û" . 219) ;; Û - ("Ü" . 220) ;; Ü - ("Ý" . 221) ;; Ý - ("þ" . 222) ;; Þ - ("ß" . 223) ;; ß - ("à" . 224) ;; à - ("á" . 225) ;; á - ("â" . 226) ;; â - ("ã" . 227) ;; ã - ("ä" . 228) ;; ä - ("å" . 229) ;; Ã¥ - ("æ" . 230) ;; æ - ("ç" . 231) ;; ç - ("è" . 232) ;; è - ("é" . 233) ;; é - ("ê" . 234) ;; ê - ("ë" . 235) ;; ë - ("ì" . 236) ;; ì - ("í" . 237) ;; í - ("î" . 238) ;; î - ("ï" . 239) ;; ï - ("ð" . 240) ;; ð - ("ñ" . 241) ;; ñ - ("ò" . 242) ;; ò - ("ó" . 243) ;; ó - ("ô" . 244) ;; ô - ("õ" . 245) ;; õ - ("ö" . 246) ;; ö - ("÷" . 247) ;; ÷ - ("ø" . 248) ;; ø - ("ù" . 249) ;; ù - ("ú" . 250) ;; ú - ("û" . 251) ;; û - ("ü" . 252) ;; ü - ("ý" . 253) ;; ý - ("þ" . 254) ;; þ - ("ÿ" . 255) ;; ÿ - ("®" . 174) ;; ® - ("­" . 173)) ;; ­ - - "Table of html character entities and values. -See https://www.freeformatter.com/html-entities.html") - -(defvar helm-find-many-files-after-hook nil - "Hook that runs at end of `helm-find-many-files'.") - -(defvar helm-marked-buffer-name "*helm marked*") - -;;; Faces. -;; -(defface helm-selection-line - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :inherit highlight :distant-foreground "black")) - "Face used in the `helm-current-buffer' when jumping to a candidate." - :group 'helm-faces) - -(defface helm-match-item - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :inherit isearch)) - "Face used to highlight the item matched in a selected line." - :group 'helm-faces) - - -;;; Utils functions -;; -;; -(defcustom helm-window-prefer-horizontal-split nil - "Maybe switch to other window vertically when non nil. - -Possible values are t, nil and `decide'. - -When t switch vertically. -When nil switch horizontally. -When `decide' try to guess if it is possible to switch vertically -according to the setting of `split-width-threshold' and the size of -the window from where splitting is done. - -Note that when using `decide' and `split-width-threshold' is nil, the -behavior is the same as with a nil value." - :group 'helm-utils - :type '(choice - (const :tag "Split window vertically" t) - (const :tag "Split window horizontally" nil) - (symbol :tag "Guess how to split window" 'decide))) - -(defcustom helm-window-show-buffers-function #'helm-window-decide-split-fn - "The default function to use when opening several buffers at once. -It is typically used to rearrange windows." - :group 'helm-utils - :type '(choice - (function :tag "Decide how to split according to number of candidates" - helm-window-decide-split-fn) - (function :tag "Split windows vertically or horizontally" - helm-window-default-split-fn) - (function :tag "Split in alternate windows" - helm-window-alternate-split-fn) - (function :tag "Split windows in mosaic" - helm-window-mosaic-fn))) - -(defun helm-window-show-buffers (buffers &optional other-window) - "Show BUFFERS. - -With more than one buffer marked switch to these buffers in separate windows. -If OTHER-WINDOW is non-nil, keep current buffer and switch to other buffers -in separate windows. -If a prefix arg is given split windows vertically." - (let ((initial-ow-fn (if (cdr (window-list)) - #'switch-to-buffer-other-window - #'helm-window-other-window))) - (if (cdr buffers) - (funcall helm-window-show-buffers-function buffers - (and other-window initial-ow-fn)) - (if other-window - (funcall initial-ow-fn (car buffers)) - (helm-buffers-switch-to-buffer-or-tab (car buffers)))))) - -(defvar tab-bar-tab-name-function) -(declare-function tab-bar-switch-to-tab "tab-bar.el") -(declare-function tab-bar-tab-name-all "tab-bar.el") - -(defun helm-buffers-maybe-switch-to-buffer-in-tab (buffer fallback-fn) - "Switch to BUFFER in its tab if possible, otherwise call FALLBACK-FN." - (let* (;; Normally `helm-buffers-maybe-switch-to-tab' custom set function - ;; bounded `tab-bar-tab-name-function' to `tab-bar-tab-name-all' - ;; but in case user bounded this with setq ensure it works - ;; at least partially by let-bounding it here. - (tab-bar-tab-name-function #'tab-bar-tab-name-all) - (tabs (tab-bar-tabs)) - (tab-names (mapcar (lambda (tab) - (cdr (assq 'name tab))) - tabs)) - (bname (buffer-name (get-buffer buffer))) - (tab (helm-buffers--get-tab-from-name bname tabs))) - (if (helm-buffers--buffer-in-tab-p bname tab-names) - (progn - (tab-bar-switch-to-tab (alist-get 'name tab)) - (select-window (get-buffer-window bname))) - (funcall fallback-fn buffer)))) - -(defun helm-buffers-switch-to-buffer-or-tab (buffer) - "Switch to BUFFER in its tab if some." - (if (and (fboundp 'tab-bar-mode) - helm-buffers-maybe-switch-to-tab - tab-bar-mode) - (helm-buffers-maybe-switch-to-buffer-in-tab - buffer #'switch-to-buffer) - (switch-to-buffer buffer))) - -(defun helm-buffers--get-tab-from-name (tab-name tabs) - "Return tab from TABS when it contains TAB-NAME." - (cl-loop for tab in tabs - when (member tab-name (split-string (cdr (assq 'name tab)) ", " t)) - return tab)) - -(defun helm-buffers-switch-buffers-in-tab-1 (buffers) - "Display BUFFERS in a new tab. -If only one buffer in BUFFERS, try to switch to it in its -tab if some, otherwise, display it in a new tab. -When a double prefix arg is given (C-u C-u), display each buffer of BUFFERS in -new tabs. When a single buffer is given, a single prefix arg will force -displaying buffer in a new tab even if it is already present in a tab. -When there is more than one buffer in BUFFERS a single prefix arg display the -buffers vertically according to `helm-window-show-buffers-function'." - (when (fboundp 'switch-to-buffer-other-tab) - (if (cdr buffers) - (if (equal helm-current-prefix-arg '(16)) - (cl-loop for b in buffers - do (switch-to-buffer-other-tab b)) - (switch-to-buffer-other-tab (car buffers)) - (helm-window-show-buffers buffers)) - (if helm-current-prefix-arg - (switch-to-buffer-other-tab (car buffers)) - (helm-buffers-maybe-switch-to-buffer-in-tab - (car buffers) #'switch-to-buffer-other-tab))))) - -(defun helm--get-tab-names () - (let ((tab-bar-tab-name-function #'tab-bar-tab-name-all)) - (mapcar (lambda (tab) - (cdr (assq 'name tab))) - (tab-bar-tabs)))) - -(defun helm-buffers--buffer-in-tab-p (buffer-name &optional tab-names) - "Check if BUFFER-NAME is in TAB-NAMES list." - (cl-loop for name in (or tab-names (helm--get-tab-names)) - ;; Buf names are separated with "," in TAB-NAMES - ;; e.g. '("tab-bar.el" "*scratch*, helm-buffers.el"). - thereis (member buffer-name (split-string name ", " t)))) - -(defun helm-window-decide-split-fn (candidates &optional other-window-fn) - "Try to find the best split window fn according to the number of CANDIDATES." - (let ((fn (cond (;; 4 or more. - (>= (length candidates) - (if other-window-fn 3 4)) - #'helm-window-mosaic-fn) - ;; 3 only. - ((= (length candidates) - (if other-window-fn 2 3)) - #'helm-window-alternate-split-fn) - ;; 2 or less. - (t #'helm-window-default-split-fn)))) - (funcall fn candidates other-window-fn))) - -(defun helm-window-default-split-fn (candidates &optional other-window-fn) - "Split windows in one direction and balance them. - -Direction can be controlled via `helm-window-prefer-horizontal-split'. -If a prefix arg is given split windows the other direction. -This function is suitable for `helm-window-show-buffers-function'." - (if other-window-fn - (funcall other-window-fn (car candidates)) - (switch-to-buffer (car candidates))) - (save-selected-window - (cl-loop with nosplit - for b in (cdr candidates) - when nosplit return - (message "Too many buffers to visit simultaneously") - do (condition-case _err - (helm-window-other-window b 'balance) - (error (setq nosplit t) nil))))) - -(defun helm-window-alternate-split-fn (candidates &optional other-window-fn) - "Split windows horizontally and vertically in alternate fashion. - -Direction can be controlled via `helm-window-prefer-horizontal-split'. -If a prefix arg is given split windows the other direction. -This function is suitable for `helm-window-show-buffers-function'." - (if other-window-fn - (funcall other-window-fn (car candidates)) - (switch-to-buffer (car candidates))) - (let (right-side) - (save-selected-window - (cl-loop with nosplit - for b in (cdr candidates) - when nosplit return - (message "Too many buffers to visit simultaneously") - do (condition-case _err - (let ((helm-current-prefix-arg right-side)) - (helm-window-other-window b) - (setq right-side (not right-side))) - (error (setq nosplit t) nil)))))) - -(defun helm-window-mosaic-fn (candidates &optional other-window-fn) - "Make an as-square-as-possible window mosaic of the CANDIDATES buffers. - -If rectangular, the long side is in the direction given by -`helm-window-prefer-horizontal-split': if non-nil, it is horizontal, vertical -otherwise. -If OTHER-WINDOW-FN is non-nil, current windows are included in the mosaic. -This function is suitable for `helm-window-show-buffers-function'." - (when other-window-fn - (setq candidates (append (mapcar 'window-buffer (window-list)) candidates))) - (delete-other-windows) - (let* ((helm-window-prefer-horizontal-split - (if (eq helm-window-prefer-horizontal-split 'decide) - (and (numberp split-width-threshold) - (>= (window-width (selected-window)) - split-width-threshold)) - helm-window-prefer-horizontal-split)) - mosaic-length-tile-count - mosaic-width-tile-count - mosaic-length-tile-size - mosaic-width-tile-size - next-window) - ;; If 4 tiles, make 2x2 mosaic. - ;; If 5-6 tiles, make 2x3 mosaic with direction depending on `helm-window-prefer-horizontal-split'. - ;; If 7-9 tiles, make 3x3 mosaic. And so on. - (setq mosaic-length-tile-count (ceiling (sqrt (length candidates)))) - (setq mosaic-width-tile-count - (if (<= (length candidates) (* mosaic-length-tile-count (1- mosaic-length-tile-count))) - (1- mosaic-length-tile-count) - mosaic-length-tile-count)) - ;; We lower-bound the tile size, otherwise the function would - ;; fail during the first inner split. - ;; There is consequently no need to check for errors when - ;; splitting. - (let ((frame-mosaic-length-direction-size (frame-height)) - (frame-mosaic-width-direction-size (frame-width)) - (window-mosaic-length-direction-min-size window-min-height) - (window-mosaic-width-direction-min-size window-min-width)) - (if helm-window-prefer-horizontal-split - (setq frame-mosaic-length-direction-size (frame-width) - frame-mosaic-width-direction-size (frame-height) - window-mosaic-length-direction-min-size window-min-width - window-mosaic-width-direction-min-size window-min-height)) - (setq mosaic-length-tile-size (max - (/ frame-mosaic-length-direction-size mosaic-length-tile-count) - window-mosaic-length-direction-min-size) - mosaic-width-tile-size (max - (/ frame-mosaic-width-direction-size mosaic-width-tile-count) - window-mosaic-width-direction-min-size)) - ;; Shorten `candidates' to `max-tiles' elements. - (let ((max-tiles (* (/ frame-mosaic-length-direction-size mosaic-length-tile-size) - (/ frame-mosaic-width-direction-size mosaic-width-tile-size)))) - (when (> (length candidates) max-tiles) - (message "Too many buffers to visit simultaneously") - (setcdr (nthcdr (- max-tiles 1) candidates) nil)))) - ;; Make the mosaic. - (while candidates - (when (> (length candidates) mosaic-length-tile-count) - (setq next-window (split-window nil - mosaic-width-tile-size - (not helm-window-prefer-horizontal-split)))) - (switch-to-buffer (pop candidates)) - (dotimes (_ (min (1- mosaic-length-tile-count) (length candidates))) - (select-window (split-window nil - mosaic-length-tile-size - helm-window-prefer-horizontal-split)) - (switch-to-buffer (pop candidates))) - (when next-window - (select-window next-window))))) - -(defun helm-window-other-window (buffer-or-name &optional balance) - "Switch to BUFFER-OR-NAME in other window. -Direction can be controlled via `helm-window-prefer-horizontal-split'. -If a prefix arg is given split windows the other direction. -When argument BALANCE is provided `balance-windows'." - (let* ((helm-window-prefer-horizontal-split - (if (eq helm-window-prefer-horizontal-split 'decide) - (and (numberp split-width-threshold) - (>= (window-width (selected-window)) - split-width-threshold)) - helm-window-prefer-horizontal-split)) - (right-side (if helm-window-prefer-horizontal-split - (not helm-current-prefix-arg) - helm-current-prefix-arg))) - (select-window (split-window nil nil right-side)) - (and balance (balance-windows)) - (switch-to-buffer buffer-or-name))) - -(cl-defun helm-current-buffer-narrowed-p (&optional - (buffer helm-current-buffer)) - "Check if BUFFER is narrowed. -Default is `helm-current-buffer'." - (with-current-buffer buffer - (let ((beg (point-min)) - (end (point-max)) - (total (buffer-size))) - (or (/= beg 1) (/= end (1+ total)))))) - -(defun helm-goto-char (loc) - "Go to char, revealing if necessary." - (goto-char loc) - (let ((fn (cond ((eq major-mode 'org-mode) - ;; On some old Emacs versions org may not be loaded. - (require 'org) - #'org-reveal) - ((and (boundp 'outline-minor-mode) - outline-minor-mode) - #'outline-show-subtree) - ((and (boundp 'hs-minor-mode) - hs-minor-mode) - #'hs-show-all) - ((and (boundp 'markdown-mode-map) - (derived-mode-p 'markdown-mode)) - #'markdown-show-entry))) - (hs-show-hook (list (lambda () (goto-char loc))))) - ;; outline may fail in some conditions e.g. with markdown enabled - ;; (Bug#1919). - (condition-case-unless-debug nil - (and fn (funcall fn)) - (error nil)))) - -(defun helm-goto-line (lineno &optional noanim) - "Goto LINENO opening only outline headline if needed. -Animation is used unless NOANIM is non--nil." - (helm-log-run-hook "helm-goto-line" - 'helm-goto-line-before-hook) - (helm-match-line-cleanup) - (unless helm-alive-p - (with-helm-current-buffer - (unless helm-yank-point (setq helm-yank-point (point))))) - (goto-char (point-min)) - (helm-goto-char (pos-bol lineno)) - (unless noanim - (helm-highlight-current-line))) - -(defun helm-save-pos-to-register-before-jump () - "Save current buffer position to `helm-save-pos-before-jump-register'. -To use this add it to `helm-goto-line-before-hook'." - (point-to-register helm-save-pos-before-jump-register)) - -(defun helm-save-current-pos-to-mark-ring () - "Save current buffer position to mark ring. -To use this add it to `helm-goto-line-before-hook'." - (set-marker (mark-marker) (point)) - (push-mark (point) 'nomsg)) - -(defun helm-displaying-source-names () - "Return the list of sources name for this helm session." - (with-current-buffer helm-buffer - (goto-char (point-min)) - (cl-loop with pos - while (setq pos (next-single-property-change (point) 'helm-header)) - do (goto-char pos) - collect (buffer-substring-no-properties (pos-bol)(pos-eol)) - do (forward-line 1)))) - -(defun helm-handle-winner-boring-buffers () - "Add `helm-buffer' to `winner-boring-buffers' when quitting/exiting helm. -Add this function to `helm-cleanup-hook' when you don't want to see helm buffers -after running winner-undo/redo." - (require 'winner) - (cl-pushnew helm-buffer winner-boring-buffers :test 'equal)) -(add-hook 'helm-cleanup-hook #'helm-handle-winner-boring-buffers) - -(defun helm-quit-and-find-file-1 () - "Drop into `helm-find-files' from `helm'. -If current selection is a buffer or a file, `helm-find-files' -from its directory." - (with-helm-alive-p - (require 'helm-grep) - (require 'helm-elisp) - (require 'bookmark) ; For bookmark-alist - (let ((src (helm-get-current-source))) - (helm-run-after-exit - (lambda (f) - ;; Ensure specifics `helm-execute-action-at-once-if-one' - ;; fns don't run here. - (let (helm-execute-action-at-once-if-one - helm-actions-inherit-frame-settings) ; use this-command - (if (file-exists-p f) - (helm-find-files-1 (file-name-directory f) - (format - helm-ff-last-expanded-candidate-regexp - (regexp-quote - (if helm-ff-transformer-show-only-basename - (helm-basename f) f)))) - (helm-find-files-1 f)))) - (helm--quit-and-find-file-default-file src))))) - -(defun helm--quit-and-find-file-default-file (source) - (let ((target-fn (or (helm-get-attr 'find-file-target source) - (assoc-default (helm-get-attr 'name source) - helm-mode-find-file-target-alist)))) - ;; target-fn function may return nil, in this case fallback to default. - (helm-aif (and target-fn (funcall target-fn source)) - it - (let* ((sel (helm-get-selection nil nil source)) - (default-preselection (or (helm-default-directory) - (buffer-file-name helm-current-buffer) - default-directory))) - (cond - ((and (stringp sel) (or (file-remote-p sel) - (file-exists-p sel))) - (expand-file-name sel)) - ;; Url. - ((and (stringp sel) - helm--url-regexp - (string-match helm--url-regexp sel)) - sel) - ;; Exit brutally from a `with-helm-show-completion' - ((and helm-show-completion-overlay - (overlayp helm-show-completion-overlay)) - (delete-overlay helm-show-completion-overlay) - (remove-hook 'helm-move-selection-after-hook 'helm-show-completion) - (expand-file-name default-preselection)) - ;; Default. - (t (expand-file-name default-preselection))))))) - -(defun helm-generic-sort-fn (s1 s2) - "Sort predicate function for helm candidates. -Args S1 and S2 can be single or (display . real) candidates, -that is sorting is done against real value of candidate." - (let* ((qpattern (regexp-quote helm-pattern)) - (reg1 (concat "\\_<" qpattern "\\_>")) - (reg2 (concat "\\_<" qpattern)) - (reg3 helm-pattern) - (split (helm-remove-if-match - "\\`!" (helm-mm-split-pattern helm-pattern))) - (str1 (if (consp s1) (cdr s1) s1)) - (str2 (if (consp s2) (cdr s2) s2)) - (score (lambda (str r1 r2 r3 lst) - (condition-case nil - (+ (if (string-match (concat "\\`" qpattern) str) 1 0) - (cond ((string-match r1 str) 5) - ((and (string-match " " qpattern) - (car lst) - (string-match - (concat "\\_<" (regexp-quote (car lst))) str) - (cl-loop for r in (cdr lst) - always (string-match r str))) - 4) - ((and (string-match " " qpattern) - (cl-loop for r in lst - always (string-match r str))) - 3) - ((string-match r2 str) 2) - ((string-match r3 str) 1) - (t 0))) - (invalid-regexp 0)))) - (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)) - ((= sc3 sc4) - (< (length str1) (length str2))) - (t (> sc3 sc4))))) - -(defun helm-file-human-size (size &optional kbsize) - "Return a string showing SIZE of a file in human readable form. -SIZE can be an integer or a float depending on it's value. -`file-attributes' will take care of that to avoid overflow error. -KBSIZE is a floating point number, defaulting to `helm-default-kbsize'." - (unless kbsize (setq kbsize helm-default-kbsize)) - (cl-loop with result = (cons "B" size) - for i in '("k" "M" "G" "T" "P" "E" "Z" "Y") - while (>= (cdr result) kbsize) - do (setq result (cons i (/ (cdr result) kbsize))) - finally return - (helm-acase (car result) - ("B" (format "%s" size)) - (t (format "%.1f%s" (cdr result) it))))) - -(defun helm-directory-size (directory &optional recursive human) - "Return the resulting size of the sum of all files in DIRECTORY. - -If RECURSIVE is non nil return the size of all files in DIRECTORY and -its subdirectories. With arg HUMAN format the size in a human -readable format,see `helm-file-human-size'." - (cl-loop with files = (if recursive - (helm-walk-directory - directory - :path 'full - :directories t) - (directory-files - directory t - directory-files-no-dot-files-regexp)) - for file in files - sum (nth 7 (file-attributes file)) into total - finally return (if human - (helm-file-human-size total) - total))) - -(defun helm-format-time-string (time) - "Format the time value TIME. -If year of TIME is inferior to current year -use \"%b %e %Y\" otherwise use \"%b %e %H:%M\"." - (let ((current-year (nth 5 (decode-time))) - (year (nth 5 (decode-time time))) - (fmt-opt '("%b %e %H:%M" - "%b %e %Y"))) - (if (< year current-year) - (format-time-string (nth 1 fmt-opt) time) - (format-time-string (nth 0 fmt-opt) time)))) - -(cl-defun helm-file-attributes - (file &key type links uid gid access-time modif-time - status size mode gid-change inode device-num dired human-size - mode-type mode-owner mode-group mode-other octal (string t)) - "Return `file-attributes' elements of FILE separately according to key value. -Availables keys are: -- TYPE: Same as nth 0 `files-attributes' if STRING is nil - otherwise return either symlink, directory or file (default). -- LINKS: See nth 1 `files-attributes'. -- UID: See nth 2 `files-attributes'. -- GID: See nth 3 `files-attributes'. -- ACCESS-TIME: See nth 4 `files-attributes', however format time - when STRING is non--nil (the default). -- MODIF-TIME: See nth 5 `files-attributes', same as above. -- STATUS: See nth 6 `files-attributes', same as above. -- SIZE: See nth 7 `files-attributes'. -- MODE: See nth 8 `files-attributes'. -- GID-CHANGE: See nth 9 `files-attributes'. -- INODE: See nth 10 `files-attributes'. -- DEVICE-NUM: See nth 11 `files-attributes'. -- DIRED: A line similar to what \\='ls -l' return. -- HUMAN-SIZE: The size in human form, see `helm-file-human-size'. -- MODE-TYPE, mode-owner,mode-group, mode-other: Split what - nth 8 `files-attributes' return in four categories. -- OCTAL: The octal value of MODE-OWNER+MODE-GROUP+MODE-OTHER. -- STRING: When non--nil (default) `helm-file-attributes' return - more friendly values. -If you want the same behavior as `files-attributes' , -\(but with return values in proplist) use a nil value for STRING. -However when STRING is non--nil, time and type value are different from what -you have in `file-attributes'." - (helm-aif (file-attributes file string) - (let* ((all (cl-destructuring-bind - (type links uid gid access-time modif-time - status size mode gid-change inode device-num) - it - (list :type (if string - (cond ((stringp type) "symlink") ; fname - (type "directory") ; t - (t "file")) ; nil - type) - :links links - :uid uid - :gid gid - :access-time (if string - (helm-format-time-string access-time) - access-time) - :modif-time (if string - (helm-format-time-string modif-time) - modif-time) - :status (if string - (format-time-string - "%Y-%m-%d %R" status) - status) - :size size - :mode mode - :gid-change gid-change - :inode inode - :device-num device-num))) - (perms (cl-getf all :mode)) - (modes (helm-split-mode-file-attributes perms nil t))) - (cond (type (cl-getf all :type)) - (links (cl-getf all :links)) - (uid (cl-getf all :uid)) - (gid (cl-getf all :gid)) - (access-time (cl-getf all :access-time)) - (modif-time (cl-getf all :modif-time)) - (status (cl-getf all :status)) - (size (cl-getf all :size)) - (mode perms) - (gid-change (cl-getf all :gid-change)) - (inode (cl-getf all :inode)) - (device-num (cl-getf all :device-num)) - (dired (helm-file-attributes-dired-line - all human-size octal)) - (human-size (helm-file-human-size (cl-getf all :size))) - (mode-type (cl-getf modes :mode-type)) - (mode-owner (cl-getf modes :user)) - (mode-group (cl-getf modes :group)) - (mode-other (cl-getf modes :other)) - (octal (cl-getf modes :octal)) - (t (append all modes)))))) - -(defun helm-file-attributes-dired-line (all &optional human-size show-octal) - (format "%s %s %s:%s %s %s" - (helm-split-mode-file-attributes - (cl-getf all :mode) t show-octal) - (number-to-string (cl-getf all :links)) - (cl-getf all :uid) - (cl-getf all :gid) - (if human-size - (helm-file-human-size (cl-getf all :size)) - (int-to-string (cl-getf all :size))) - (cl-getf all :modif-time))) - -(defun helm-split-mode-file-attributes (modes &optional string show-octal) - "Split MODES in a list of modes. -MODES is same as what (nth 8 (file-attributes \"foo\")) would return." - (if (string-match "\\`\\(.\\)\\(...\\)\\(...\\)\\(...\\)\\'" modes) - (let* ((type (match-string 1 modes)) - (user (match-string 2 modes)) - (group (match-string 3 modes)) - (other (match-string 4 modes)) - (octal (and show-octal - (helm-ff-numeric-permissions - (list user group other))))) - (if string - (mapconcat 'identity (list type user group other (or octal "")) "") - (list :mode-type type :user user - :group group :other other - :octal octal))) - (error "Wrong modes specification for %s" modes))) - -(defun helm-ff-numeric-permissions (perms) - "Return the numeric representation of PERMS. -PERMS is the list of permissions for owner, group and others." - ;; `file-modes-symbolic-to-number' interpret its MODES argument as what would - ;; result when calling such mode on a file with chmod, BTW we have to remove - ;; all "-" like read-file-modes does. - (helm-aand (listp perms) - (apply 'format "u=%s,g=%s,o=%s" perms) - (replace-regexp-in-string "-" "" it) - (format "%o" (file-modes-symbolic-to-number it)))) - -(defun helm-format-columns-of-files (files) - "Same as `dired-format-columns-of-files'. -Inlined here for compatibility." - (let ((beg (point))) - (completion--insert-strings files) - (put-text-property beg (point) 'mouse-face nil))) - -(defmacro with-helm-display-marked-candidates (buffer-or-name candidates &rest body) - (declare (indent 0) (debug t)) - (helm-with-gensyms (buffer window winconf) - `(let* ((,buffer (temp-buffer-window-setup ,buffer-or-name)) - (,winconf helm-last-frame-or-window-configuration) - (helm-always-two-windows t) - (helm-split-window-default-side - (if (eq helm-split-window-default-side 'same) - 'below helm-split-window-default-side)) - helm-split-window-inside-p - helm-reuse-last-window-split-state - ,window) - (with-current-buffer ,buffer - (helm-format-columns-of-files ,candidates)) - (unwind-protect - (with-selected-window - (setq ,window (temp-buffer-window-show - ,buffer - '(display-buffer-below-selected - (window-height . fit-window-to-buffer)))) - (progn ,@body)) - (quit-window 'kill ,window) - (and ,winconf (set-window-configuration ,winconf)))))) - -;;; Persistent Action Helpers -;; -;; -;; Internal -(defvar helm-match-line-overlay nil) -(defvar helm--match-item-overlays nil) - -(defun helm-highlight-current-line (&optional start end buf face) - "Highlight current line and all matching items around it. - -The number of lines around matched line where the matching items are -highlighted are defined by `helm-highlight-matches-around-point-max-lines'. -When the variable `helm-highlight-only-all-matches' is non nil only -the lines containing all matches (in case of multi match) are highlighted. - -Optional arguments START, END and FACE are only here for debugging purpose." - (catch 'never - (let* ((start (or start (line-beginning-position))) - (end (or end (1+ (line-end-position)))) - start-match end-match - (args (list start end buf)) - (case-fold-search (if helm-alive-p - (helm-set-case-fold-search) - case-fold-search))) - ;; Highlight the current line. - (if (not helm-match-line-overlay) - (setq helm-match-line-overlay (apply 'make-overlay args)) - (apply 'move-overlay helm-match-line-overlay args)) - (overlay-put helm-match-line-overlay - 'face (or face 'helm-selection-line)) - ;; Now highlight matches only if we are in helm session, we are - ;; maybe coming from helm-grep-mode or helm-moccur-mode buffers. - (when helm-alive-p - (helm-acase helm-highlight-matches-around-point-max-lines - ;; Next 2 clauses must precede others otherwise - ;; `helm-highlight-matches-around-point-max-lines' is - ;; compared as a number by other clauses and return an error. - (never (throw 'never nil)) - ((dst* (x . y)) - (setq start-match (save-excursion (forward-line (- x)) (pos-bol)) - end-match (save-excursion (forward-line y) (pos-bol)))) - ((guard* (or (null it) (zerop it))) - (setq start-match start - end-match end)) - ((guard* (< it 0)) - (setq start-match (save-excursion (forward-line it) (pos-bol)) - end-match start)) - ((guard* (> it 0)) - (setq start-match start - end-match (save-excursion (forward-line it) (pos-bol))))) - (catch 'empty-line - (let* ((regex-list (helm-remove-if-match - "\\`!" (helm-mm-split-pattern - (if (with-helm-buffer - ;; Needed for highlighting AG matches. - (assq 'pcre (helm-get-current-source))) - (helm--translate-pcre-to-elisp helm-input) - helm-input)))) - (num-regex (length regex-list))) - (save-excursion - (goto-char start-match) - (while (< (point) end-match) - (let* ((start-line (line-beginning-position)) - (end-line (line-end-position)) - all-matches) - (dolist (r regex-list) - (let ((match-list '())) - (save-excursion - (goto-char start-line) - (while (condition-case _err - (and (not (= start-line end-line)) - (if helm-migemo-mode - (helm-mm-migemo-forward r end-line t) - (re-search-forward r end-line t))) - (invalid-regexp nil)) - (let ((s (match-beginning 0)) - (e (match-end 0))) - (if (= s e) - (throw 'empty-line nil) - (push (cons s e) match-list))))) - (when match-list - (push match-list all-matches)))) - (when (and all-matches - (or (not helm-highlight-only-all-matches) - (eql (length all-matches) num-regex))) - (cl-loop for ml in all-matches - do (cl-loop for (s . e) in ml - for ov = (make-overlay s e) - do (progn - (push ov helm--match-item-overlays) - (overlay-put ov 'face 'helm-match-item) - (overlay-put ov 'priority 1)))))) - (forward-line 1)))))) - (recenter)))) - -(defun helm--translate-pcre-to-elisp (regexp) - "Should translate pcre REGEXP to elisp regexp. -Assume regexp is a pcre based regexp." - (with-temp-buffer - (insert " " regexp " ") - (goto-char (point-min)) - (save-excursion - ;; match (){}| unquoted - (helm-awhile (and (re-search-forward "\\([(){}|]\\)" nil t) - (match-string 1)) - (let ((pos (match-beginning 1))) - (if (eql (char-before pos) ?\\) - (delete-region pos (1- pos)) - (replace-match (concat "\\" it) t t nil 1))))) - ;; match \s or \S - (helm-awhile (and (re-search-forward "\\S\\?\\(\\s\\[sS]\\)[^-]" nil t) - (match-string 1)) - (replace-match (concat it "-") t t nil 1)) - (buffer-substring (1+ (point-min)) (1- (point-max))))) - -(defun helm-match-line-cleanup () - (when helm-match-line-overlay - (delete-overlay helm-match-line-overlay) - (setq helm-match-line-overlay nil)) - (when helm--match-item-overlays - (mapc 'delete-overlay helm--match-item-overlays))) - -(defun helm-match-line-cleanup-maybe () - (when (helm-empty-buffer-p) - (helm-match-line-cleanup))) - -(defun helm-match-line-update () - (when helm--match-item-overlays - (mapc 'delete-overlay helm--match-item-overlays)) - (when helm-match-line-overlay - (delete-overlay helm-match-line-overlay) - (helm-highlight-current-line))) - -(defun helm-persistent-autoresize-hook () - (when (and helm-buffers-to-resize-on-pa - (member helm-buffer helm-buffers-to-resize-on-pa) - (eq helm-split-window-state 'vertical)) - (set-window-text-height (helm-window) helm-resize-on-pa-text-height))) - -(defun helm-match-line-cleanup-pulse () - (run-with-timer 0.3 nil #'helm-match-line-cleanup)) - -(add-hook 'helm-after-update-hook 'helm-match-line-cleanup-maybe) -(add-hook 'helm-after-persistent-action-hook 'helm-persistent-autoresize-hook) -(add-hook 'helm-cleanup-hook 'helm-match-line-cleanup) -(add-hook 'helm-after-action-hook 'helm-match-line-cleanup-pulse) -(add-hook 'helm-after-persistent-action-hook 'helm-match-line-update) - -;;; Popup-info -;; -(defvar helm--show-popup-info-timer nil) -(defvar helm--maybe-show-popup-info-overlay nil) -(defface helm-tooltip - '((((type tty pc)) - :background "yellow" :foreground "black") - (t :background "goldenrod" :foreground "black")) - "Face used by `helm-popup-tip-show'." - :group 'helm-grep-faces) - -(defun helm-cancel-popup-tip-timer () - (when helm--show-popup-info-timer - (cancel-timer helm--show-popup-info-timer) - (setq helm--show-popup-info-timer nil)) - (when helm--maybe-show-popup-info-overlay - (delete-overlay helm--maybe-show-popup-info-overlay) - (setq helm--maybe-show-popup-info-overlay nil))) - -(defun helm-popup-tip-show (text pos) - "Display TEXT at POS in an overlay." - (setq helm--maybe-show-popup-info-overlay - (make-overlay pos (1+ pos))) - (overlay-put helm--maybe-show-popup-info-overlay - 'display - (propertize - (concat text "\n") - 'face 'helm-tooltip))) - -(defun helm-maybe-show-popup-tip-info () - (when helm--maybe-show-popup-info-overlay - (delete-overlay helm--maybe-show-popup-info-overlay)) - (let* ((src (helm-get-current-source)) - (popup-info-fn (assoc-default 'popup-info src))) - (when (and helm-alive-p - helm-popup-tip-mode - popup-info-fn) - (unless (timerp helm--show-popup-info-timer) - (setq helm--show-popup-info-timer - (run-with-idle-timer - 1 nil - (lambda () - (cancel-timer helm--show-popup-info-timer) - (setq helm--show-popup-info-timer nil) - ;; We may have an error (wrong-type-argument window-live-p nil) - ;; when switching to help window, the error may occur in the - ;; small lap of time where the helm-window is deleted and the - ;; help buffer not already displayed. - (ignore-error wrong-type-argument - (save-selected-window - (with-helm-window - (let ((pos (save-excursion (end-of-visual-line) (point))) - (str (and popup-info-fn - (funcall popup-info-fn (helm-get-selection))))) - (when (and str (not (string= str ""))) - (helm-popup-tip-show - (concat " " str) - pos))))))))))))) - -;;;###autoload -(define-minor-mode helm-popup-tip-mode - "Show additional informations in a popup tip at end of line. - -When the mode is enabled, popup showup when the source -has a `popup-info' attribute which define a specific function for -this source to fetch infos on candidate." - :global t - (if helm-popup-tip-mode - (progn - (add-hook 'helm-move-selection-after-hook 'helm-maybe-show-popup-tip-info) - (add-hook 'helm-help-mode-after-hook 'helm-maybe-show-popup-tip-info) - (add-hook 'helm-cleanup-hook 'helm-cancel-popup-tip-timer)) - (remove-hook 'helm-move-selection-after-hook 'helm-maybe-show-popup-tip-info) - (remove-hook 'helm-help-mode-after-hook 'helm-maybe-show-popup-tip-info) - (remove-hook 'helm-cleanup-hook 'helm-cancel-popup-tip-timer))) - -(defun helm-open-file-with-default-tool (file) - "Open FILE with the default tool on this platform." - (let (process-connection-type) - (if (eq system-type 'windows-nt) - (helm-w32-shell-execute-open-file file) - (start-process "helm-open-file-with-default-tool" - nil - (helm-acase system-type - (gnu/linux "xdg-open") - ((darwin macos) "open") - (cygwin "cygstart")) - file)))) - -(defun helm-open-dired (file) - "Open a dired buffer in FILE's directory. -If FILE is a directory, open this directory." - (require 'dired) - (if (file-directory-p file) - (dired file) - (dired (file-name-directory file)) - (dired-goto-file file))) - -(defun helm-find-file-as-root (candidate) - (let* ((buf (helm-basename candidate)) - (host (file-remote-p candidate 'host)) - (remote-path (format "/%s:%s:%s" - helm-su-or-sudo - (or host "") - (expand-file-name - (if host - (file-remote-p candidate 'localname) - candidate)))) - non-essential) - (if (buffer-live-p (get-buffer buf)) - (progn - (set-buffer buf) - (find-alternate-file remote-path)) - (find-file remote-path)))) - -(defun helm-find-many-files (_ignore) - "Simple action that run `find-file' on marked candidates. -Run `helm-find-many-files-after-hook' at end." - (let ((helm--reading-passwd-or-string t)) - (mapc 'find-file (helm-marked-candidates)) - (helm-log-run-hook "helm-find-many-files" - 'helm-find-many-files-after-hook))) - -(defun helm-read-repeat-string (prompt &optional count) - "Prompt as many time PROMPT is not empty. -If COUNT is non--nil add a number after each prompt. -Return the list of strings entered in each prompt." - (cl-loop with prt = prompt - with elm - while (not (string= elm "")) - for n from 1 - do (when count - (setq prt (format "%s (%s): " - (replace-regexp-in-string - ": " "" prompt) - (int-to-string n)))) - collect (setq elm (helm-read-string prt)) into lis - finally return (remove "" lis))) - -(defun helm-html-bookmarks-to-alist (file url-regexp bmk-regexp) - "Parse HTML bookmark FILE and return an alist with (title . url) as elements." - (let (bookmarks-alist url title) - (with-temp-buffer - (insert-file-contents file) - (goto-char (point-min)) - (while (re-search-forward "href=\\|^ *
. - -;;; Commentary: - -;;; Code: - -(require 'helm-for-files) - - -;;; List of files gleaned from every dired buffer -;; -;; -(defvar dired-buffers) -(defvar directory-files-no-dot-files-regexp) -(defun helm-files-in-all-dired-candidates () - "Return a list of files from live `dired' buffers." - (save-excursion - (cl-loop for (f . b) in dired-buffers - when (buffer-live-p b) - append (let ((dir (with-current-buffer b dired-directory))) - (if (listp dir) (cdr dir) - (directory-files f t directory-files-no-dot-files-regexp)))))) - -;; (dired '("~/" "~/.emacs.d/.emacs-custom.el" "~/.emacs.d/.emacs.bmk")) - -(defclass helm-files-dired-source (helm-source-sync helm-type-file) - ((candidates :initform #'helm-files-in-all-dired-candidates))) - -(defvar helm-source-files-in-all-dired - (helm-make-source "Files in all dired buffer." 'helm-files-dired-source)) - -;;; session.el files -;; -;; session (http://emacs-session.sourceforge.net/) is an alternative to -;; recentf that saves recent file history and much more. -(defvar session-file-alist) -(defclass helm-source-session-class (helm-source-sync) - ((candidates :initform (lambda () - (cl-delete-if-not - (lambda (f) - (or (string-match helm-tramp-file-name-regexp f) - (file-exists-p f))) - (mapcar 'car session-file-alist)))) - (keymap :initform 'helm-generic-files-map) - (help-message :initform 'helm-generic-file-help-message) - (action :initform 'helm-type-file-actions))) - -(defvar helm-source-session nil - "File list from emacs-session.") - -(defcustom helm-session-fuzzy-match nil - "Enable fuzzy matching in `helm-source-session' when non--nil." - :group 'helm-files - :type 'boolean - :set (lambda (var val) - (set var val) - (setq helm-source-session - (helm-make-source "Session" 'helm-source-session-class - :fuzzy-match val)))) - - -;;; External searching file tools. -;; -;; Tracker desktop search - -(defun helm-source-tracker-transformer (candidates _source) - "Return file names from tracker CANDIDATES." - ;; loop through tracker candidates selecting out file:// lines - ;; then select part after file:// and url decode to get straight filenames - (cl-loop for cand in candidates - when (and (stringp cand) - (string-match "\\`[[:space:]]*file://\\(.*\\)" cand)) - collect (url-unhex-string (match-string 1 cand)))) - -(defvar helm-source-tracker-search - (helm-build-async-source "Tracker Search" - :candidates-process - (lambda () - ;; the tracker-search command has been deprecated, now invoke via tracker - ;; also, disable the contextual snippets which we don't currently use - (start-process "tracker-search-process" nil - "tracker" "search" - "--disable-snippets" - "--disable-color" - "--limit=512" - helm-pattern)) - ;; new simplified transformer of tracker search results - :filtered-candidate-transformer #'helm-source-tracker-transformer - ;;(multiline) ; https://github.com/emacs-helm/helm/issues/529 - :keymap helm-generic-files-map - :action 'helm-type-file-actions - :action-transformer '(helm-transform-file-load-el - helm-transform-file-browse-url) - :requires-pattern 3) - "Source for the Tracker desktop search engine.") - -;; Spotlight (MacOS X desktop search) -(defclass helm-mac-spotlight-source (helm-source-async helm-type-file) - ((candidates-process :initform - (lambda () - (start-process - "mdfind-process" nil "mdfind" helm-pattern))) - (requires-pattern :initform 3))) - -(defvar helm-source-mac-spotlight - (helm-make-source "mdfind" 'helm-mac-spotlight-source) - "Source for retrieving files via Spotlight's command line utility mdfind.") - -(provide 'helm-x-files) - -;;; helm-x-files.el ends here diff --git a/elpa/helm-20251212.555/helm-x-icons.el b/elpa/helm-20251212.555/helm-x-icons.el deleted file mode 100644 index 6f13efa9..00000000 --- a/elpa/helm-20251212.555/helm-x-icons.el +++ /dev/null @@ -1,168 +0,0 @@ -;;; helm-x-icons.el --- Provide compatibility between icons providers -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2025 Thierry Volpiatto - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Code: - -(require 'helm-lib) - -(defgroup helm-x-icons nil - "Compatibility functions between icons provider packages." - :group 'helm) - -(defcustom helm-x-icons-provider (if (display-graphic-p) - 'all-the-icons 'nerd-icons) - "The icons provider package. -The currently supported providers are `all-the-icons' and `nerd-icons'. -Do not use setq to set this variable but customize." - :type '(choice - (const :tag "Use `all-the-icons' package" all-the-icons) - (const :tag "Use `nerd-icons' package" nerd-icons)) - :set (lambda (var val) - (when val (setq val (require val nil t))) - (set var val))) - -(defun helm-x-icons-match-to-alist (file type) - "Match FILE against an entry in ALIST using `string-match-p'. -Supported TYPE are ext, regexp, mode, url and dir." - (cl-loop with alist = (helm-x-icons-resolve-alist type) - for (elm . rest) in alist - for target = (if (eq type 'url) file (helm-basename file)) - when (string-match-p (helm-stringify elm) target) - return rest)) - -(defun helm-x-icons-resolve-alist (type) - "Return the icon alist corresponding to TYPE. -The returned alist is computed according to `helm-x-icons-provider'." - (let* ((provider-name (symbol-name helm-x-icons-provider)) - (alist-name (helm-acase type - (ext "extension-icon-alist") - (regexp "regexp-icon-alist") - (dir "dir-icon-alist") - (url "url-alist") - (mode "mode-icon-alist")))) - (symbol-value - (intern-soft (concat provider-name "-" alist-name))))) - -(defun helm-x-icons-icon-for-file (&rest args) - "Compatibility function for `*-icon-for-file'." - (let ((fn (helm-acase helm-x-icons-provider - (all-the-icons 'all-the-icons-icon-for-file) - (nerd-icons 'nerd-icons-icon-for-file))) - icon) - (when fn - (setq icon (apply fn args)) - (add-text-properties 0 1 `(icon ,(length icon)) icon) - icon))) - -(defvar helm-x-icons-nerd-icons-compat-alist - '(("file-symlink-directory" . (nerd-icons-codicon . "nf-cod-file_symlink_directory")) - ("file-directory" . (nerd-icons-sucicon . "nf-custom-folder_oct")) - ("star" . (nerd-icons-mdicon . "nf-md-star")) - ("mail-read" . (nerd-icons-codicon . "nf-cod-mail_read")) - ("info" . (nerd-icons-faicon . "nf-fa-info")) - ("link-external" . (nerd-icons-faicon . "nf-fa-external_link")) - ("mail" . (nerd-icons-mdicon . "nf-md-email")) - ("note_add" . (nerd-icons-codicon . "nf-cod-new_file")) - ("create_new_folder" . (nerd-icons-codicon . "nf-cod-new_folder")) - ("firefox" . (nerd-icons-faicon . "nf-fa-firefox")) - ("globe" . (nerd-icons-faicon . "nf-fa-globe")) - ("man-page" . (nerd-icons-octicon . "nf-oct-command_palette")) - ("crop" . (nerd-icons-faicon . "nf-fa-crop")) - ("package" . (nerd-icons-octicon . "nf-oct-package")) - ("color_lens" . (nerd-icons-mdicon . "nf-md-color_lens")) - ("cube" . (nerd-icons-mdicon . "nf-md-cube")) - ("three-bars" . (nerd-icons-codicon . "nf-code-three_bars")) - ("cog" . (nerd-icons-mdicon . "nf-md-cog")) - ("lightning" . (nerd-icons-mdicon . "nf-md-lightning_bolt")) - ("file" . (nerd-icons-mdicon . "nf-md-file")) - ("folder" . (nerd-icons-mdicon . "nf-md-folder")) - ("key" . (nerd-icons-faicon . "nf-fa-key")) - ("angle-double-right" . (nerd-icons-faicon . "nf-fa-angle-double-right")) - ("calculator" . (nerd-icons-mdicon . "nf-md-calculator")) - ("book" . (nerd-icons-codicon . "nf-cod-book")) - ("border_style" . (nerd-icons-mdicon . "nf-md-border_style")) - ("text_fields" . (nerd-icons-mdicon . "nf-md-text")) - ("code" . (nerd-icons-faicon . "nf-fa-code")) - ("bar-chart" . (nerd-icons-faicon . "nf-fa-bar_chart")) - ("clone" . (nerd-icons-faicon . "nf-fa-clone"))) - "The `nerd-icons' counterpart for icon names. -The `helm-x-icons-generic' function uses this alist to find `nerd-icons' -functions and names to display icons. -To each icon added here, its all-the-icons counterpart have to be added in -`helm-x-icons-all-the-icons-compat-alist'.") - -(defvar helm-x-icons-all-the-icons-compat-alist - '(("file-symlink-directory" . (all-the-icons-octicon . "file-symlink-directory")) - ("file-directory" . (all-the-icons-octicon . "file-directory")) - ("star" . (all-the-icons-octicon . "star")) - ("mail-read" . (all-the-icons-octicon . "mail-read")) - ("info" . (all-the-icons-octicon . "info")) - ("link-external" . (all-the-icons-octicon . "link-external")) - ("mail" . (all-the-icons-octicon . "mail")) - ("note_add" . (all-the-icons-material . "note_add")) - ("create_new_folder" . (all-the-icons-material . "create_new_folder")) - ("firefox" . (all-the-icons-faicon . "firefox")) - ("globe" . (all-the-icons-faicon . "globe")) - ("man-page" . (all-the-icons-fileicon . "man-page")) - ("crop" . (all-the-icons-material . "crop")) - ("package" . (all-the-icons-octicon . "package")) - ("color_lens" . (all-the-icons-material . "color_lens")) - ("cube" . (all-the-icons-faicon . "cube")) - ("three-bars" . (all-the-icons-octicon . "three-bars")) - ("cog" . (all-the-icons-faicon . "cog")) - ("lightning" . (all-the-icons-wicon . "lightning")) - ("file" . (all-the-icons-faicon . "file")) - ("folder" . (all-the-icons-faicon . "folder")) - ("key" . (all-the-icons-octicon . "key")) - ("angle-double-right" . (all-the-icons-faicon . "angle-double-right")) - ("calculator" . (all-the-icons-faicon . "calculator")) - ("book" . (all-the-icons-octicon . "book")) - ("border_style" . (all-the-icons-material . "border_style")) - ("text_fields" . (all-the-icons-material . "text_fields")) - ("code" . (all-the-icons-material . "code")) - ("bar-chart" . (all-the-icons-faicon . "bar-chart")) - ("clone" . (all-the-icons-faicon . "clone"))) - "The `all-the-icons' counterpart for icon names. -The `helm-x-icons-generic' function uses this alist to find `all-the-icons' -functions and names to display icons. -To each icon added here, its all-the-icons counterpart have to be added in -`helm-x-icons-nerd-icons-compat-alist'.") - -(defun helm-x-icons-generic (icon-name &rest args) - "Compatibility function for icons. -Run an `all-the-icons' or `nerd-icons' function according to -`helm-x-icons-provider'and ICON-NAME. -Functions and icon names are found in `helm-x-icons-all-the-icons-compat-alist' -and `helm-x-icons-nerd-icons-compat-alist'." - (let (fn icon) - (helm-acase helm-x-icons-provider - (nerd-icons - (helm-acase (assoc-default icon-name helm-x-icons-nerd-icons-compat-alist) - ((dst* (sym . name)) - (setq fn sym icon-name name)))) - (all-the-icons - (helm-acase (assoc-default icon-name helm-x-icons-all-the-icons-compat-alist) - ((dst* (sym . name)) - (setq fn sym icon-name name))))) - (when fn - (setq icon (apply fn icon-name args)) - (add-text-properties 0 1 `(icon ,(length icon)) icon) - icon))) - -(provide 'helm-x-icons) - -;;; helm-x-icons.el ends here diff --git a/elpa/helm-20251212.555/helm.el b/elpa/helm-20251212.555/helm.el deleted file mode 100644 index ac8ca346..00000000 --- a/elpa/helm-20251212.555/helm.el +++ /dev/null @@ -1,54 +0,0 @@ -;;; helm.el --- Helm is an Emacs incremental and narrowing framework -*- lexical-binding: t -*- - -;; Copyright (C) 2007 Tamas Patrovics -;; 2008 ~ 2011 rubikitch -;; 2011 ~ 2025 Thierry Volpiatto - -;; This is a fork of anything.el wrote by Tamas Patrovics. - -;; Authors of anything.el: Tamas Patrovics -;; rubikitch -;; Thierry Volpiatto - -;; Author: Thierry Volpiatto -;; Package-Version: 20251212.555 -;; Package-Revision: 08fb63fab625 -;; URL: https://emacs-helm.github.io/helm/ -;; Package-Requires: ((helm-core "4.0.6") (wfnames "1.2")) -;; Keywords: helm, convenience, files, buffers, grep, completion, lisp, matching, tools, help - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Commentary: - -;; This is just a wrapper for helm-core.el and a place holder we -;; currently use only to hold the package's metadata in the header. - -;;; Code: - -(require 'helm-core) -(require 'helm-global-bindings) - -;; Build info sources and commands once called (bug #2608). We need to autoload -;; only these commands which are bound in helm-global-bindings, if we add more -;; helm-info* commands to helm-global-bindings we will have to autoload them -;; here. Requiring helm-info here instead will make recursive require to helm so -;; don't do that. -(autoload 'helm-info-emacs "helm-info" nil t) -(autoload 'helm-info-gnus "helm-info" nil t) -(autoload 'helm-info-at-point "helm-info" nil t) - -(provide 'helm) - -;;; helm.el ends here diff --git a/elpa/helm-20260424.1357/README-elpa b/elpa/helm-20260424.1357/README-elpa new file mode 100644 index 00000000..ac3576bc --- /dev/null +++ b/elpa/helm-20260424.1357/README-elpa @@ -0,0 +1,2 @@ +This is just a wrapper for helm-core.el and a place holder we +currently use only to hold the package's metadata in the header. diff --git a/elpa/helm-20260424.1357/emacs-helm.sh b/elpa/helm-20260424.1357/emacs-helm.sh new file mode 100755 index 00000000..097e8843 --- /dev/null +++ b/elpa/helm-20260424.1357/emacs-helm.sh @@ -0,0 +1,277 @@ +#!/usr/bin/env sh + + +## Copyright (C) 2012 ~ 2026 Thierry Volpiatto +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program. If not, see . + +## Commentary: +# Preconfigured `emacs -Q' with a basic Helm configuration. + + +# If TEMP env var exists, use it, otherwise declare it. +test -z "$TEMP" && TEMP="/tmp" + +CONF_FILE="$TEMP/helm-cfg.el" +EMACS=emacs +QUICK=-Q +TOOLBARS=-1 +LOAD_PACKAGES= + +usage () { + cat >&1 < $CONF_FILE <\`helm-find-files'\\n\ +;; - \`occur'(M-s o) =>\`helm-occur'\\n\ +;; - \`list-buffers'(C-x C-b) =>\`helm-buffers-list'\\n\ +;; - \`apropos-command'(C-h a) =>\`helm-apropos'\\n\ +;; - \`dabbrev-expand'(M-/) =>\`helm-dabbrev'\\n\ +;; - \`execute-extended-command'(M-x) =>\`helm-M-x'\\n\ +;; - \`yank-pop'(M-y) =>\`helm-show-kill-ring'\\n\\n +;; \`helm-mode' is enabled which mean that most Emacs commands using completion\\n\ +;; will use helm.\\n\ + +;; To start editing a file or to create a new file, visit it with \`C-x C-f'\\n\ +;; and enter text in its buffer, to save your changes hit \`C-x C-s'. + +;; Find context help for most Helm commands with \`C-h m' while helm is running.\\n\ +;; You can also retrieve the whole user documentation with \`C-x c h h'.\\n\ +;; For online documentation see \`https://github.com/emacs-helm/helm/wiki'.\\n\ +;; \(Put cursor on url, hit \`C-x C-f' and then RETurn).\\n\ + +;; To quit this Emacs, hit \'C-x C-c'.\\n\ + +;; Note about keybindings in Emacs: \`C-' means \'Control-' and \`M-' \'Alt-'.\\n\ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\\n\\n") + +(setq load-path (quote $LOAD_PATH)) + +(defvar default-package-manager nil) +;; /home/you/.emacs.d/.local/straight/build-27.1/helm +(defvar initial-package-directory (file-name-directory (file-truename "$0"))) + +(defvar bootstrap-version) +(let* ((packages "$LOAD_PACKAGES") + (pkg-list (and packages + (not (equal packages "")) + (split-string packages ","))) + ;; /home/you/.emacs.d/.local/straight/build-27.1 + (straight-path (file-name-directory (directory-file-name initial-package-directory))) + ;; /home/you/.emacs.d/.local/straight/build-27.1/async + (async-path (expand-file-name "async" straight-path)) + ;; /home/you/.emacs.d/.local/straight/repos/straight.el/bootstrap.el + (bootstrap-file + (expand-file-name "repos/straight.el/bootstrap.el" + (file-name-directory (directory-file-name straight-path)))) + (bootstrap-version 5)) + (when (file-exists-p bootstrap-file) + (setq default-package-manager 'straight) + (load bootstrap-file nil 'nomessage) + (add-to-list 'load-path async-path) + (when pkg-list + (dolist (pkg pkg-list) + (let* ((pkg-path (expand-file-name pkg straight-path)) + (autoload-file (expand-file-name + (format "%s-autoloads.el" pkg) + pkg-path))) + (add-to-list 'load-path pkg-path) + (if (file-exists-p autoload-file) + (load autoload-file nil 'nomessage) + (straight-use-package (intern pkg)))))))) + +(unless (eq default-package-manager 'straight) + (require 'package) + ;; User may be using a non standard \`package-user-dir'. + ;; Modify \`package-directory-list' instead of \`package-user-dir' + ;; in case the user starts Helm from a non-ELPA installation. + (unless (file-equal-p package-user-dir (locate-user-emacs-file "elpa")) + ;; Something like /home/you/.emacs.d/somedir/else/elpa/ + ;; starting from default-directory is wrong in case helm.sh is a symlink + ;; or e.g. helm --chdir foo have been used. + (add-to-list 'package-directory-list (directory-file-name + (file-name-directory + (directory-file-name initial-package-directory))))) + + (let* ((str-lst "$LOAD_PACKAGES") + (load-packages (and str-lst + (not (string= str-lst "")) + (split-string str-lst ",")))) + (setq package-load-list + (if (equal load-packages '("all")) + '(all) + (append '((helm-core t) (helm t) (async t) (wfnames t)) + (mapcar (lambda (p) (list (intern p) t)) load-packages))))) + + (package-initialize)) + +(add-to-list 'load-path initial-package-directory) + +(unless (> $TOOLBARS 0) + (setq default-frame-alist '((vertical-scroll-bars . nil) + (tool-bar-lines . 0) + (menu-bar-lines . 0) + (fullscreen . nil)))) +(blink-cursor-mode -1) +(load "helm-autoloads" nil t) +(helm-mode 1) +(with-eval-after-load 'tramp-cache (setq tramp-cache-read-persistent-data t)) +(with-eval-after-load 'auth-source (setq auth-source-save-behavior nil)) +(define-key global-map [remap find-file] 'helm-find-files) +(define-key global-map [remap occur] 'helm-occur) +(define-key global-map [remap list-buffers] 'helm-buffers-list) +(define-key global-map [remap dabbrev-expand] 'helm-dabbrev) +(define-key global-map [remap execute-extended-command] 'helm-M-x) +(define-key global-map [remap apropos-command] 'helm-apropos) +(define-key global-map [remap yank-pop] 'helm-show-kill-ring) +(add-hook 'kill-emacs-hook #'(lambda () (and (file-exists-p "$CONF_FILE") (delete-file "$CONF_FILE")))) +EOF + +$EMACS "$QUICK" -l "$CONF_FILE" "$@" diff --git a/elpa/helm-20260424.1357/helm-adaptive.el b/elpa/helm-20260424.1357/helm-adaptive.el new file mode 100644 index 00000000..ea9fef6d --- /dev/null +++ b/elpa/helm-20260424.1357/helm-adaptive.el @@ -0,0 +1,284 @@ +;;; helm-adaptive.el --- Adaptive Sorting of Candidates. -*- lexical-binding: t -*- + +;; Original Author: Tamas Patrovics + +;; Copyright (C) 2007 Tamas Patrovics +;; Copyright (C) 2012 ~ 2026 Thierry Volpiatto + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Code: + +(require 'cl-lib) +(require 'helm) + + +(defgroup helm-adapt nil + "Adaptative sorting of candidates for Helm." + :group 'helm) + +(defcustom helm-adaptive-history-file + (locate-user-emacs-file "helm-adaptive-history") + "Path of file where history information is stored. +When nil history is not saved nor restored after Emacs restart +unless you save/restore `helm-adaptive-history' with something +else like psession or desktop." + :type 'string) + +(defcustom helm-adaptive-history-length 50 + "Maximum number of candidates stored for a source." + :type 'number) + +(defcustom helm-adaptive-sort-by-frequent-recent-usage t + "Try to sort on an average of frequent and recent usage when non-nil. + +When nil sort on frequency usage only. + +Only frequency: +When candidate have low frequency, you have to hit on it many +times to make it going up on top. + +Frequency+recent: +Even with a low frequency, candidate go up on top. If a candidate +have a high frequency but it is not used since some time, it goes +down slowly, but as soon you reuse it it go up on top quickly." + :type 'boolean) + +;; Internal +(defvar helm-adaptive-done nil + "nil if history information is not yet stored for the current +selection.") + +(defvar helm-adaptive-history nil + "Contains the stored history information. +Format: ((SOURCE-NAME + (SELECTED-CANDIDATE (PATTERN . NUMBER-OF-USE) ...) ...) ...)") + +(defconst helm-adaptive-freq-coefficient 5) +(defconst helm-adaptive-recent-coefficient 2) + +(defun helm-adaptive-done-reset () + (setq helm-adaptive-done nil)) + +;;;###autoload +(define-minor-mode helm-adaptive-mode + "Toggle adaptive sorting in all sources." + :global t + (if helm-adaptive-mode + (progn + (unless helm-adaptive-history + (helm-adaptive-maybe-load-history)) + (add-hook 'kill-emacs-hook #'helm-adaptive-save-history) + ;; Should run at beginning of `helm-initial-setup'. + (add-hook 'helm-before-initialize-hook #'helm-adaptive-done-reset) + ;; Should run at beginning of `helm-exit-minibuffer'. + (add-hook 'helm-before-action-hook #'helm-adaptive-store-selection) + ;; Should run at beginning of `helm-select-action'. + (add-hook 'helm-select-action-hook #'helm-adaptive-store-selection)) + (helm-adaptive-save-history) + (setq helm-adaptive-history nil) + (remove-hook 'kill-emacs-hook #'helm-adaptive-save-history) + (remove-hook 'helm-before-initialize-hook #'helm-adaptive-done-reset) + (remove-hook 'helm-before-action-hook #'helm-adaptive-store-selection) + (remove-hook 'helm-select-action-hook #'helm-adaptive-store-selection))) + +(defun helm-adapt-use-adaptive-p (&optional source-name) + "Return current source only if it use adaptive history, nil otherwise." + (when helm-adaptive-mode + (let* ((source (or source-name (helm-get-current-source))) + (adapt-source (or (assoc-default 'filtered-candidate-transformer source) + (assoc-default 'candidate-transformer source)))) + (if (listp adapt-source) + (and (memq 'helm-adaptive-sort adapt-source) source) + (and (eq adapt-source 'helm-adaptive-sort) source))))) + +(defun helm-adaptive-store-selection () + "Store history information for the selected candidate." + (unless helm-adaptive-done + (setq helm-adaptive-done t) + (let ((source (helm-adapt-use-adaptive-p))) + (when source + (let* ((source-name (assoc-default 'name source)) + (source-info (or (assoc source-name helm-adaptive-history) + (progn + (push (list source-name) helm-adaptive-history) + (car helm-adaptive-history)))) + (selection (helm-get-selection nil t)) + (selection-info (progn + (setcdr source-info + (cons + (let ((found (assoc selection (cdr source-info)))) + (if (not found) + ;; new entry + (list selection) + ;; move entry to the beginning of the + ;; list, so that it doesn't get + ;; trimmed when the history is + ;; truncated + (setcdr source-info + (delete found (cdr source-info))) + found)) + (cdr source-info))) + (cadr source-info))) + (pattern-info (progn + (setcdr selection-info + (cons + (let ((found (assoc helm-pattern (cdr selection-info)))) + (if (not found) + ;; new entry + (cons helm-pattern 0) + ;; move entry to the beginning of the + ;; list, so if two patterns used the + ;; same number of times then the one + ;; used last appears first in the list + (setcdr selection-info + (delete found (cdr selection-info))) + found)) + (cdr selection-info))) + (cadr selection-info))) + (timestamp-info (helm-aif (assq 'timestamp (cdr selection-info)) + it + (setcdr selection-info (cons (cons 'timestamp 0) (cdr selection-info))) + (cadr selection-info)))) + ;; Increase usage count. + (setcdr pattern-info (1+ (cdr pattern-info))) + ;; Update timestamp. + (setcdr timestamp-info (float-time)) + ;; Truncate history if needed. + (if (> (length (cdr selection-info)) helm-adaptive-history-length) + (setcdr selection-info + (helm-take (cdr selection-info) helm-adaptive-history-length)))))))) + +(defun helm-adaptive-maybe-load-history () + "Load `helm-adaptive-history-file' which contain `helm-adaptive-history'. +Returns nil if `helm-adaptive-history-file' doesn't exist." + (when (and helm-adaptive-history-file + (file-readable-p helm-adaptive-history-file)) + (load-file helm-adaptive-history-file))) + +(defun helm-adaptive-save-history (&optional arg) + "Save history information to the file given by `helm-adaptive-history-file'." + (interactive "p") + (when helm-adaptive-history-file + (with-temp-buffer + (insert + ";; -*- mode: emacs-lisp; lexical-binding: t -*-\n" + ";; History entries used for helm adaptive display.\n") + (let (print-length print-level) + (prin1 `(setq helm-adaptive-history ',helm-adaptive-history) + (current-buffer))) + (insert ?\n) + (write-region (point-min) (point-max) helm-adaptive-history-file nil + (unless arg 'quiet))))) + +(defun helm-adaptive-sort (candidates source) + "Sort the CANDIDATES for SOURCE by usage frequency. +This is a filtered candidate transformer you can use with the +`filtered-candidate-transformer' attribute." + (let* ((source-name (assoc-default 'name source)) + (source-info (assoc source-name helm-adaptive-history))) + (if source-info + (let ((usage + ;; Loop in the SOURCE entry of `helm-adaptive-history' + ;; and assemble a list containing the (CANDIDATE + ;; . USAGE-COUNT) pairs. + (cl-loop with cf = (if helm-adaptive-sort-by-frequent-recent-usage + helm-adaptive-freq-coefficient 1) + with cr = helm-adaptive-recent-coefficient + for (src-cand . infos) in (cdr source-info) + for count-freq = 0 + for count-rec = + (helm-aif (and helm-adaptive-sort-by-frequent-recent-usage + (assq 'timestamp infos)) + (* cr (+ (float-time) (cdr it))) + 0) + do (cl-loop for (pattern . score) in + (remove (assq 'timestamp infos) infos) + ;; If current pattern is equal to + ;; the previously used one then + ;; this candidate has priority + ;; (that's why its count-freq is + ;; boosted by 10000) and it only + ;; has to compete with other + ;; candidates which were also + ;; selected with the same pattern. + if (equal pattern helm-pattern) + return (setq count-freq (+ 10000 score)) + else do (cl-incf count-freq score)) + and collect (cons src-cand (+ (* count-freq cf) count-rec)) + into results + ;; Sort the list in descending order, so + ;; candidates with highest priority come + ;; first. + finally return + (sort results (lambda (first second) + (> (cdr first) (cdr second))))))) + (if (consp usage) + ;; Put those candidates first which have the highest usage count. + (cl-loop for (cand . _freq) in usage + for info = (or (and (assq 'multiline source) + (replace-regexp-in-string + "\n\\'" "" cand)) + ;; Some transformers like in + ;; bookmarks may add a leading + ;; space to provide additional + ;; infos like an icon as a + ;; display prop, strip out this + ;; leading space for + ;; comparison. Same for a + ;; trailing space (helm + ;; boookmark add bmk location as + ;; a display prop when + ;; displaying it). + (helm-aand (replace-regexp-in-string "\\` " "" cand) + (replace-regexp-in-string " \\'" "" it))) + when (cl-member info candidates + :test 'helm-adaptive-compare) + collect (car it) into sorted + and do (setq candidates + (cl-remove info candidates + :test 'helm-adaptive-compare)) + finally return (append sorted candidates)) + (message "Your `%s' is maybe corrupted or too old, \ +you should reinitialize it with `helm-reset-adaptive-history'" + helm-adaptive-history-file) + (sit-for 1) + candidates)) + ;; if there is no information stored for this source then do nothing + candidates))) + +;;;###autoload +(defun helm-reset-adaptive-history () + "Delete all `helm-adaptive-history' and his file. +Useful when you have a old or corrupted +`helm-adaptive-history-file'." + (interactive) + (when (y-or-n-p "Really delete all your `helm-adaptive-history'? ") + (setq helm-adaptive-history nil) + (when (and helm-adaptive-history-file + (file-exists-p helm-adaptive-history-file)) + (delete-file helm-adaptive-history-file)))) + +(defun helm-adaptive-compare (x y) + "Compare display parts if some of candidates X and Y. + +Arguments X and Y are cons cell in (DISPLAY . REAL) format or +atoms." + (equal (if (listp x) (car x) x) + (if (listp y) (car y) y))) + + +(provide 'helm-adaptive) + +;;; helm-adaptive.el ends here diff --git a/elpa/helm-20260424.1357/helm-autoloads.el b/elpa/helm-20260424.1357/helm-autoloads.el new file mode 100644 index 00000000..6141c67e --- /dev/null +++ b/elpa/helm-20260424.1357/helm-autoloads.el @@ -0,0 +1,1101 @@ +;;; helm-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*- +;; Generated by the `loaddefs-generate' function. + +;; This file is part of GNU Emacs. + +;;; Code: + +(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path))) + + + +;;; Generated autoloads from helm-adaptive.el + +(defvar helm-adaptive-mode nil +"Non-nil if Helm-Adaptive mode is enabled. +See the `helm-adaptive-mode' command +for a description of this minor mode. +Setting this variable directly does not take effect; +either customize it (see the info node `Easy Customization') +or call the function `helm-adaptive-mode'.") +(custom-autoload 'helm-adaptive-mode "helm-adaptive" nil) +(autoload 'helm-adaptive-mode "helm-adaptive" +"Toggle adaptive sorting in all sources. + +This is a global minor mode. If called interactively, toggle the +`Helm-Adaptive mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value \\='helm-adaptive-mode)'. + +The mode's hook is called both when the mode is enabled and when it is +disabled. + +(fn &optional ARG)" t) +(autoload 'helm-reset-adaptive-history "helm-adaptive" +"Delete all `helm-adaptive-history' and his file. +Useful when you have a old or corrupted +`helm-adaptive-history-file'." t) +(register-definition-prefixes "helm-adaptive" '("helm-adapt")) + + +;;; Generated autoloads from helm-bookmark.el + +(autoload 'helm-bookmark-import-eww-bookmarks "helm-bookmark" +"Import EWW bookmarks into bookmark-alist." t) +(autoload 'helm-bookmarks "helm-bookmark" +"Preconfigured `helm' for bookmarks." t) +(autoload 'helm-filtered-bookmarks "helm-bookmark" +"Preconfigured `helm' for bookmarks (filtered by category). +Optional source `helm-source-bookmark-addressbook' is loaded only +if external addressbook-bookmark package is installed." t) +(register-definition-prefixes "helm-bookmark" '("bmk" "bookmark" "helm-")) + + +;;; Generated autoloads from helm-buffers.el + +(autoload 'helm-buffers-quit-and-find-file-fn "helm-buffers" +" + +(fn SOURCE)") +(autoload 'helm-buffers-list "helm-buffers" +"Preconfigured `helm' to list buffers." t) +(autoload 'helm-mini "helm-buffers" +"Preconfigured `helm' displaying `helm-mini-default-sources'." t) +(register-definition-prefixes "helm-buffers" '("helm-")) + + +;;; Generated autoloads from helm-color.el + +(autoload 'helm-colors "helm-color" +"Preconfigured `helm' for color." t) +(register-definition-prefixes "helm-color" '("helm-")) + + +;;; Generated autoloads from helm-command.el + +(autoload 'helm-M-x "helm-command" +"Preconfigured `helm' for Emacs commands. +It is `helm' replacement of regular `M-x' +`execute-extended-command'. + +Unlike regular `M-x' Emacs vanilla `execute-extended-command' +command, the prefix args if needed, can be passed AFTER starting +`helm-M-x'. When a prefix arg is passed BEFORE starting +`helm-M-x', the first `C-u' while in `helm-M-x' session will +disable it. + +You can get help on each command by persistent action. + +(fn ARG)" t) +(register-definition-prefixes "helm-command" '("helm-")) + + +;;; Generated autoloads from helm-dabbrev.el + +(autoload 'helm-dabbrev "helm-dabbrev" +"Preconfigured helm for dynamic abbreviations." t) +(register-definition-prefixes "helm-dabbrev" '("helm-dabbrev-")) + + +;;; Generated autoloads from helm-elisp.el + +(autoload 'helm-lisp-completion-at-point "helm-elisp" +"Preconfigured Helm for Lisp symbol completion at point." t) +(autoload 'helm-get-first-line-documentation "helm-elisp" +"Return first line documentation of symbol SYM truncated at END-COLUMN. +If SYM is not documented, return \"Not documented\". +Argument NAME allows specifiying what function to use to display +documentation when SYM name is the same for function and variable. + +(fn SYM &optional NAME END-COLUMN)") +(autoload 'helm-complete-file-name-at-point "helm-elisp" +"Preconfigured Helm to complete file name at point. + +(fn &optional FORCE)" t) +(autoload 'helm-lisp-indent "helm-elisp" nil t) +(autoload 'helm-apropos "helm-elisp" +"Preconfigured Helm to describe commands, functions, variables and faces. +In non interactives calls DEFAULT argument should be provided as +a string, i.e. the `symbol-name' of any existing symbol. + +(fn DEFAULT)" t) +(autoload 'helm-locate-library "helm-elisp" +"Preconfigured helm to locate elisp libraries. + +When `completions-detailed' or `helm-completions-detailed' is non +nil, a description of libraries is provided. The libraries are +partially cached in the variables +`helm--locate-library-doc-cache' and +`helm--locate-library-cache'. TIP: You can make these vars +persistent for faster start with the psession package, using M-x +psession-make-persistent-variable. NOTE: The caches affect as +well `find-libray' and `locate-library' when `helm-mode' is +enabled and `completions-detailed' is non nil. There is no need +to refresh the caches, they will be updated automatically if some +new libraries are found, however when a library update its +headers and the description change you can reset the caches with +a prefix arg. + +(fn &optional ARG)" t) +(autoload 'helm-timers "helm-elisp" +"Preconfigured `helm' for timers." t) +(autoload 'helm-complex-command-history "helm-elisp" +"Preconfigured `helm' for complex command history." t) +(register-definition-prefixes "helm-elisp" '("helm-" "with-helm-show-completion")) + + +;;; Generated autoloads from helm-epa.el + +(defvar helm-epa-mode nil +"Non-nil if Helm-Epa mode is enabled. +See the `helm-epa-mode' command +for a description of this minor mode. +Setting this variable directly does not take effect; +either customize it (see the info node `Easy Customization') +or call the function `helm-epa-mode'.") +(custom-autoload 'helm-epa-mode "helm-epa" nil) +(autoload 'helm-epa-mode "helm-epa" +"Enable helm completion on gpg keys in epa functions. + +This is a global minor mode. If called interactively, toggle the +`Helm-Epa mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value \\='helm-epa-mode)'. + +The mode's hook is called both when the mode is enabled and when it is +disabled. + +(fn &optional ARG)" t) +(autoload 'helm-epa-list-keys "helm-epa" +"List all gpg keys. +This is the helm interface for `epa-list-keys'." t) +(register-definition-prefixes "helm-epa" '("helm-epa")) + + +;;; Generated autoloads from helm-eshell.el + +(autoload 'helm-esh-pcomplete "helm-eshell" +"Preconfigured `helm' to provide Helm completion in Eshell." t) +(autoload 'helm-eshell-history "helm-eshell" +"Preconfigured Helm for Eshell history." t) +(autoload 'helm-eshell-prompts "helm-eshell" +"Pre-configured `helm' to browse the prompts of the current Eshell." t) +(autoload 'helm-eshell-prompts-all "helm-eshell" +"Pre-configured `helm' to browse the prompts of all Eshell sessions." t) +(register-definition-prefixes "helm-eshell" '("helm-e")) + + +;;; Generated autoloads from helm-eval.el + +(autoload 'helm-eval-expression "helm-eval" +"Preconfigured `helm' for `helm-source-evaluation-result'. + +(fn ARG)" t) +(autoload 'helm-eval-expression-with-eldoc "helm-eval" +"Preconfigured `helm' for `helm-source-evaluation-result' with `eldoc' support." t) +(autoload 'helm-calcul-expression "helm-eval" +"Preconfigured `helm' for `helm-source-calculation-result'." t) +(register-definition-prefixes "helm-eval" '("helm-")) + + +;;; Generated autoloads from helm-external.el + +(autoload 'helm-run-external-command "helm-external" +"Preconfigured `helm' to run External PROGRAM asyncronously from Emacs. +If program is already running try to run `helm-raise-command' if +defined otherwise exit with error. You can set your own list of +commands with `helm-external-commands-list'." t) +(register-definition-prefixes "helm-external" '("helm-")) + + +;;; Generated autoloads from helm-fd.el + +(register-definition-prefixes "helm-fd" '("helm-fd-")) + + +;;; Generated autoloads from helm-files.el + +(defvar helm-ff-icon-mode nil +"Non-nil if Helm-Ff-Icon mode is enabled. +See the `helm-ff-icon-mode' command +for a description of this minor mode. +Setting this variable directly does not take effect; +either customize it (see the info node `Easy Customization') +or call the function `helm-ff-icon-mode'.") +(custom-autoload 'helm-ff-icon-mode "helm-files" nil) +(autoload 'helm-ff-icon-mode "helm-files" +"Display icons from `helm-x-icons-provider' package in HFF when enabled. + +This is a global minor mode. If called interactively, toggle the +`Helm-Ff-Icon mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value \\='helm-ff-icon-mode)'. + +The mode's hook is called both when the mode is enabled and when it is +disabled. + +(fn &optional ARG)" t) +(autoload 'helm-ff-clear-image-dired-thumbnails-cache "helm-files" +"Clear `helm-ff-image-dired-thumbnails-cache'. +You may want to do this after customizing +`image-dired-thumbnail-storage' which may change the place where +thumbnail files are stored." t) +(autoload 'helm-ff-cleanup-image-dired-dir-and-cache "helm-files" +"Cleanup `image-dired-dir' directory. +Delete all thumb files that are no more associated with an existing +image file in `helm-ff-image-dired-thumbnails-cache'." t) +(autoload 'helm-projects-history "helm-files" +"Jump to project already visisted with `helm-browse-project'. +Prefix arg allows browsing files recursively under a project not handled +by git or hg, otherwise it has no effect. + +(fn &optional ARG)" t) +(autoload 'helm-browse-project "helm-files" +"Preconfigured helm to browse projects. +Browse files and see status of project with its VCS. +GIT, HG and SVN are supported for now, but only git is fully featured with +`helm-ls-git' package. +Fall back to `helm-browse-project-find-files' if current +directory is not under control or one of those VCS. +With a prefix ARG browse files recursively, with two prefix ARG +rebuild the cache. +If the current directory is found in the cache, start +`helm-browse-project-find-files' even with no prefix ARG. +NOTE: The prefix ARG have no effect on the VCS controlled +directories. + +Needed dependencies for VCS (not mandatory, pickup what you need): + + +. + +(fn ARG)" t) +(autoload 'helm-find-files "helm-files" +"Preconfigured `helm' for helm implementation of `find-file'. +Called with a prefix arg show history if some. +Don't call it from programs, use `helm-find-files-1' instead. +This is the starting point for nearly all actions you can do on +files. + +(fn ARG)" t) +(register-definition-prefixes "helm-files" '("eshell-command-aliases-list" "helm-")) + + +;;; Generated autoloads from helm-find.el + +(autoload 'helm-find "helm-find" +"Preconfigured `helm' for the find shell command. + +Recursively find files whose names are matched by all specified +globbing PATTERNs under the current directory using the external +program specified in `find-program' (usually \"find\"). Every +input PATTERN is silently wrapped into two stars: *PATTERN*. + +With prefix argument, prompt for a directory to search. + +When user option `helm-findutils-search-full-path' is non-nil, +match against complete paths, otherwise, against file names +without directory part. + +The (possibly empty) list of globbing PATTERNs can be followed by +the separator \"*\" plus any number of additional arguments that +are passed to \"find\" literally. + +(fn ARG)" t) +(register-definition-prefixes "helm-find" '("helm-")) + + +;;; Generated autoloads from helm-font.el + +(autoload 'helm-select-xfont "helm-font" +"Preconfigured `helm' to select Xfont." t) +(autoload 'helm-ucs "helm-font" +"Preconfigured `helm' for `ucs-names'. + +Called with a prefix arg force reloading cache. + +(fn ARG)" t) +(register-definition-prefixes "helm-font" '("helm-")) + + +;;; Generated autoloads from helm-for-files.el + +(autoload 'helm-highlight-files "helm-for-files" +"A basic transformer for helm files sources. +Colorize only symlinks, directories and files. + +(fn FILES SOURCE)") +(autoload 'helm-for-files "helm-for-files" +"Preconfigured `helm' for opening files. +Run all sources defined in `helm-for-files-preferred-list'." t) +(autoload 'helm-multi-files "helm-for-files" +"Preconfigured helm like `helm-for-files' but running locate only on demand. + +Allow toggling back and forth from locate to others sources with +`helm-multi-files-toggle-locate-binding' key. +This avoids launching locate needlessly when what you are +searching for is already found." t) +(autoload 'helm-recentf "helm-for-files" +"Preconfigured `helm' for `recentf'." t) +(register-definition-prefixes "helm-for-files" '("helm-")) + + +;;; Generated autoloads from helm-global-bindings.el + +(register-definition-prefixes "helm-global-bindings" '("helm-command-")) + + +;;; Generated autoloads from helm-grep.el + +(autoload 'helm-goto-precedent-file "helm-grep" +"Go to previous file in Helm grep/etags buffers." t) +(autoload 'helm-goto-next-file "helm-grep" +"Go to previous file in Helm grep/etags buffers." t) +(autoload 'helm-revert-next-error-last-buffer "helm-grep" +"Revert last `next-error' buffer from `current-buffer'. + +Accept to revert only `helm-grep-mode' or `helm-occur-mode' buffers. +Use this when you want to revert the `next-error' buffer after +modifications in `current-buffer'." t) +(autoload 'helm-do-grep-ag "helm-grep" +"Preconfigured `helm' for grepping with AG in `default-directory'. +With prefix arg prompt for type if available with your AG +version. + +(fn ARG)" t) +(autoload 'helm-do-grep-ag-project "helm-grep" +"Preconfigured `helm' for grepping with AG from the current project root. +If no project found use `default-directory'. +With prefix arg prompt for type if available with your AG version. + +(fn ARG)" t) +(autoload 'helm-grep-do-git-grep "helm-grep" +"Preconfigured `helm' for git-grepping `default-directory'. +With a prefix arg ARG git-grep the whole repository. + +(fn ARG)" t) +(register-definition-prefixes "helm-grep" '("helm-")) + + +;;; Generated autoloads from helm-help.el + +(autoload 'helm-documentation "helm-help" +"Preconfigured `helm' for Helm documentation. +With a prefix arg refresh the documentation. + +Find here the documentation of all documented sources." t) +(defvar helm-comp-read-mode-line "\\C/\\[helm-cr-empty-string]:Empty \\\\[helm-help]:Help \\[helm-select-action]:Act \\[helm-maybe-exit-minibuffer]/f1/f2/f-n:NthAct \\[helm-toggle-suspend-update]:Tog.suspend \\[helm-customize-group]:Conf") +(defvar helm-read-file-name-mode-line-string "\\\\[helm-help]:Help C/\\[helm-cr-empty-string]:Empty \\\\[helm-select-action]:Act \\[helm-maybe-exit-minibuffer]/f1/f2/f-n:NthAct \\[helm-toggle-suspend-update]:Tog.suspend \\[helm-customize-group]:Conf" +"String displayed in mode-line in `helm-source-find-files'.") +(defvar helm-top-mode-line "\\\\[helm-help]:Help \\\\[helm-select-action]:Act \\[helm-maybe-exit-minibuffer]/f1/f2/f-n:NthAct \\[helm-toggle-suspend-update]:Tog.suspend \\[helm-customize-group]:Conf") +(register-definition-prefixes "helm-help" '("helm-")) + + +;;; Generated autoloads from helm-id-utils.el + +(autoload 'helm-gid "helm-id-utils" +"Preconfigured `helm' for `gid' command line of `ID-Utils'. +Need A database created with the command `mkid' above +`default-directory'. +Need id-utils as dependency which provide `mkid', `gid' etc.. +See ." t) +(register-definition-prefixes "helm-id-utils" '("helm-gid-")) + + +;;; Generated autoloads from helm-imenu.el + +(autoload 'helm-imenu "helm-imenu" +"Preconfigured `helm' for `imenu'." t) +(autoload 'helm-imenu-in-all-buffers "helm-imenu" +"Fetch Imenu entries in all buffers with similar mode as current. +A mode is similar as current if it is the same, it is derived +i.e. `derived-mode-p' or it have an association in +`helm-imenu-all-buffer-assoc'." t) +(register-definition-prefixes "helm-imenu" '("helm-")) + + +;;; Generated autoloads from helm-info.el + +(autoload 'helm-info "helm-info" +"Preconfigured `helm' for searching Info files' indices. + +With a prefix argument \\[universal-argument], set REFRESH to +non-nil. + +Optional parameter REFRESH, when non-nil, re-evaluates +`helm-default-info-index-list' and clears caches (see below). +If the variable has been customized, set it to its saved value. +If not, set it to its standard value. See +`custom-reevaluate-setting' for more. + +REFRESH is useful when new Info files are installed. If +`helm-default-info-index-list' has not been customized, the new +Info files are made available. + +When `completions-detailed' or `helm-completions-detailed' is non +nil, a description of Info files is provided. The Info files are +partially cached in the variables `helm-info--files-cache' and +`helm-info--files-docs-cache'. TIP: You can make these vars +persistent for faster start with the psession package, using +\\[psession-make-persistent-variable]. + +NOTE: The caches affect as well `info-dislpay-manual' when +`helm-mode' is enabled and `completions-detailed' is non nil. +When new Info files are installed, for example a library update +changed Info dir node entry, you can reset the caches with +a prefix arg. + +(fn &optional REFRESH)" t) +(autoload 'helm-info-at-point "helm-info" +"Preconfigured `helm' for searching info at point." t) +(register-definition-prefixes "helm-info" '("helm-")) + + +;;; Generated autoloads from helm-locate.el + +(autoload 'helm-projects-find-files "helm-locate" +"Find files with locate in `helm-locate-project-list'. +With a prefix arg refresh the database in each project. + +(fn UPDATE)" t) +(autoload 'helm-locate "helm-locate" +"Preconfigured `helm' for Locate. +Note: you can add locate options after entering pattern. +See \\='man locate' for valid options and also `helm-locate-command'. + +You can specify a local database with prefix argument ARG. +With two prefix arg, refresh the current local db or create it if +it doesn't exists. + +To create a user specific db, use +\"updatedb -l 0 -o db_path -U directory\". +Where db_path is a filename matched by +`helm-locate-db-file-regexp'. + +(fn ARG)" t) +(register-definition-prefixes "helm-locate" '("helm-")) + + +;;; Generated autoloads from helm-man.el + +(autoload 'helm-man-woman "helm-man" +"Preconfigured `helm' for Man and Woman pages. +With a prefix ARG reinitialize the cache. To have a popup +showing a basic description of selected candidate, turn on +`helm-popup-tip-mode'. + +(fn ARG)" t) +(register-definition-prefixes "helm-man" '("helm-")) + + +;;; Generated autoloads from helm-misc.el + +(defvar helm-minibuffer-history-mode nil +"Non-nil if Helm-Minibuffer-History mode is enabled. +See the `helm-minibuffer-history-mode' command +for a description of this minor mode. +Setting this variable directly does not take effect; +either customize it (see the info node `Easy Customization') +or call the function `helm-minibuffer-history-mode'.") +(custom-autoload 'helm-minibuffer-history-mode "helm-misc" nil) +(autoload 'helm-minibuffer-history-mode "helm-misc" +"Bind `helm-minibuffer-history-key' in al minibuffer maps. + +This mode is enabled by `helm-mode', so there is no need to enable it directly. + +This is a global minor mode. If called interactively, toggle the +`Helm-Minibuffer-History mode' mode. If the prefix argument is +positive, enable the mode, and if it is zero or negative, disable the +mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value \\='helm-minibuffer-history-mode)'. + +The mode's hook is called both when the mode is enabled and when it is +disabled. + +(fn &optional ARG)" t) +(autoload 'helm-world-time "helm-misc" +"Preconfigured `helm' to show world time. +Default action change TZ environment variable locally to emacs." t) +(autoload 'helm-insert-latex-math "helm-misc" +"Preconfigured helm for latex math symbols completion." t) +(autoload 'helm-ratpoison-commands "helm-misc" +"Preconfigured `helm' to execute ratpoison commands." t) +(autoload 'helm-stumpwm-commands "helm-misc" +"Preconfigured helm for stumpwm commands." t) +(autoload 'helm-minibuffer-history "helm-misc" +"Preconfigured `helm' for `minibuffer-history'." t) +(autoload 'helm-outline "helm-misc" +"Basic helm navigation tool for outline buffers. + +(fn &optional ARG)" t) +(register-definition-prefixes "helm-misc" '("helm-")) + + +;;; Generated autoloads from helm-mode.el + +(autoload 'helm-comp-read "helm-mode" +"Read a string in the minibuffer, with helm completion. + +It is helm `completing-read' equivalent. + +- PROMPT is the prompt name to use. + +- COLLECTION can be a list, alist, vector, obarray or hash-table. + For alists and hash-tables their car are use as real value of + candidate unless ALISTP is non-nil. + It can be also a function that receives three arguments: + the values string, predicate and t. See `all-completions' for more details. + +Keys description: + +- TEST: A predicate called with one arg i.e candidate. + +- INITIAL-INPUT: Same as input arg in `helm'. + +- PRESELECT: See preselect arg of `helm'. + +- DEFAULT: This option is used only for compatibility with regular + Emacs `completing-read' (Same as DEFAULT arg of `completing-read'). + +- BUFFER: Name of helm-buffer. + +- MUST-MATCH: Candidate selected must be one of COLLECTION. + +- FUZZY: Enable fuzzy matching. + +- REVERSE-HISTORY: When non--nil display history source after current + source completion. + +- REQUIRES-PATTERN: Same as helm attribute, default is 0. + +- HISTORY: A symbol where each result will be saved. + If not specified as a symbol an error will popup. + When specified, all elements of HISTORY are displayed in + a special source before or after COLLECTION according to REVERSE-HISTORY. + The main difference with INPUT-HISTORY is that the result of the + completion is saved whereas in INPUT-HISTORY it is the minibuffer + contents which is saved when you exit. + Don't use the same symbol for INPUT-HISTORY and HISTORY. + NOTE: As mentionned above this has nothing to do with + `minibuffer-history-variable', therefore if you want to save this + history persistently, you will have to add this variable to the + relevant variable of your favorite tool for persistent emacs session + i.e. psession, desktop etc... + +- RAW-HISTORY: When non-nil do not remove backslashs if some in + HISTORY candidates. + +- INPUT-HISTORY: A symbol. The minibuffer input history will be + stored there, if nil or not provided, `minibuffer-history' + will be used instead. You can navigate in this history with + `M-p' and `M-n'. + Don't use the same symbol for INPUT-HISTORY and HISTORY. + +- CASE-FOLD: Same as `helm-case-fold-search'. + +- PERSISTENT-ACTION: A function called with one arg i.e candidate. + +- PERSISTENT-HELP: A string to document PERSISTENT-ACTION. + +- MODE-LINE: A string or list to display in mode line. + Default is `helm-comp-read-mode-line'. + +- KEYMAP: A keymap to use in this `helm-comp-read'. + (the keymap will be shared with history source) + +- NAME: The name related to this local source. + +- HEADER-NAME: A function to alter NAME, see `helm'. + +- EXEC-WHEN-ONLY-ONE: Bound `helm-execute-action-at-once-if-one' + to non--nil. (possibles values are t or nil). + +- VOLATILE: Use volatile attribute. + +- SORT: A predicate to give to `sort' e.g `string-lessp' + Use this only on small data as it is inefficient. + If you want to sort faster add a sort function to + FC-TRANSFORMER. + Note that FUZZY when enabled is already providing a sort function. + +- FC-TRANSFORMER: A `filtered-candidate-transformer' function + or a list of functions. + +- HIST-FC-TRANSFORMER: A `filtered-candidate-transformer' + function for the history source. + +- MARKED-CANDIDATES: If non-nil return candidate or marked candidates as a list. + +- NOMARK: When non--nil don't allow marking candidates. + +- ALISTP: + When non-nil (default) pass the value of (DISPLAY . REAL) + candidate in COLLECTION to action when COLLECTION is an alist or a + hash-table, otherwise DISPLAY is always returned as result on exit, + which is the default when using `completing-read'. + See `helm-comp-read-get-candidates'. + +- CANDIDATES-IN-BUFFER: when non--nil use a source build with + `helm-source-in-buffer' which is much faster. + Argument VOLATILE have no effect when CANDIDATES-IN-BUFFER is non--nil. + +- GET-LINE: Specify the :get-line slot of `helm-source-in-buffer', has no effect + when CANDIDATES-IN-BUFFER is nil. + +- MATCH-PART: Allow matching only one part of candidate. + See match-part documentation in `helm-source'. + +- MATCH-DYNAMIC: See match-dynamic in `helm-source-sync' + It has no effect when used with CANDIDATES-IN-BUFFER. + +- ALLOW-NEST: Allow nesting this `helm-comp-read' in a helm session. + See `helm'. + +- MULTILINE: See multiline in `helm-source'. + +- COERCE: See coerce in `helm-source'. + +- RAW-CANDIDATE: Do not unquote the unknown candidate coming from helm-pattern + when non nil. + +- GROUP: See group in `helm-source'. + +Any prefix args passed during `helm-comp-read' invocation will be recorded +in `helm-current-prefix-arg', otherwise if prefix args were given before +`helm-comp-read' invocation, the value of `current-prefix-arg' will be used. +That means you can pass prefix args before or after calling a command +that use `helm-comp-read'. See `helm-M-x' for example. + +(fn PROMPT COLLECTION &key TEST INITIAL-INPUT DEFAULT PRESELECT (BUFFER \"*Helm Completions*\") MUST-MATCH FUZZY REVERSE-HISTORY (REQUIRES-PATTERN 0) (HISTORY nil SHISTORY) RAW-HISTORY INPUT-HISTORY (CASE-FOLD helm-comp-read-case-fold-search) (PERSISTENT-ACTION nil) (PERSISTENT-HELP \"DoNothing\") (MODE-LINE helm-comp-read-mode-line) HELP-MESSAGE (KEYMAP helm-comp-read-map) (NAME \"Helm Completions\") HEADER-NAME CANDIDATES-IN-BUFFER (GET-LINE #\\='buffer-substring) DIACRITICS MATCH-PART MATCH-DYNAMIC EXEC-WHEN-ONLY-ONE QUIT-WHEN-NO-CAND (VOLATILE t) SORT FC-TRANSFORMER HIST-FC-TRANSFORMER (MARKED-CANDIDATES helm-comp-read-use-marked) NOMARK (ALISTP t) (CANDIDATE-NUMBER-LIMIT helm-candidate-number-limit) MULTILINE ALLOW-NEST COERCE RAW-CANDIDATE (GROUP \\='helm) POPUP-INFO)") +(autoload 'helm-read-file-name "helm-mode" +"Read a file name with helm completion. + +It is helm `read-file-name' emulation. + +Argument PROMPT is the default prompt to use. + +Keys description: + +- NAME: Source name, default to \"Read File Name\". + +- INITIAL-INPUT: Where to start reading file name, + default to `default-directory' or $HOME. + +- BUFFER: `helm-buffer' name, defaults to \"*Helm Completions*\". + +- TEST: A predicate called with one arg \\='candidate'. + +- NORET: Allow disabling helm-ff-RET (have no effect if helm-ff-RET + isn't bound to RET). + +- CASE-FOLD: Same as `helm-case-fold-search'. + +- PRESELECT: helm preselection. + +- HISTORY: Display HISTORY in a special source. + +- MUST-MATCH: Can be \\='confirm, nil, or t. + +- FUZZY: Enable fuzzy matching when non-nil (Enabled by default). + +- MARKED-CANDIDATES: When non--nil return a list of marked candidates + otherwise a single filename is returned. + +- ALL-MARKED: Allow marking several dummy candidates. + +- NOMARK: When non--nil don't allow marking candidates. + +- ALISTP: Don't use `all-completions' in history + (take effect only on history). + +- PERSISTENT-ACTION-IF: a persistent if action function. + +- PERSISTENT-HELP: persistent help message. + +- MODE-LINE: A mode line message, default is + `helm-read-file-name-mode-line-string'. + +(fn PROMPT &key (NAME \"Read File Name\") INITIAL-INPUT (BUFFER \"*Helm file completions*\") TEST NORET (CASE-FOLD helm-file-name-case-fold-search) PRESELECT HISTORY MUST-MATCH (FUZZY t) DEFAULT MARKED-CANDIDATES ALL-MARKED (CANDIDATE-NUMBER-LIMIT helm-ff-candidate-number-limit) NOMARK (ALISTP t) (PERSISTENT-ACTION-IF \\='helm-find-files-persistent-action-if) (PERSISTENT-HELP \"Hit1 Expand Candidate, Hit2 or (C-u) Find file\") (MODE-LINE helm-read-file-name-mode-line-string))") +(autoload 'helm-dynamic-completion "helm-mode" +"Build a completion function for `helm-pattern' in COLLECTION. + +Only the elements of COLLECTION that satisfy PREDICATE are considered. + +Argument POINT is the 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 has +to be provided if needed either with an FCT function in source or +by passing the sort function with METADATA +E.g.: \\='((metadata (display-sort-function . foo))). +Candidates can be modified by passing an affixation-function in METADATA. + +If you don't want the sort fn provided by style to kick +in (emacs-27) you can use as metadata value the symbol `nosort'. + +Example: + + (helm :sources (helm-build-sync-source \"test\" + :candidates (helm-dynamic-completion + \\='(foo bar baz foab) + \\='symbolp) + :match-dynamic t) + :buffer \"*helm test*\") + +When argument NOMODE is non nil don't use `completion-styles' as +specified in `helm-completion-styles-alist' for specific modes. + +When STYLES is specified use these `completion-styles', see +`helm--prepare-completion-styles'. + +Also `helm-completion-style' settings have no effect here, +`emacs' being used inconditionally as value. + +(fn COLLECTION PREDICATE &optional POINT METADATA NOMODE STYLES)") +(defvar helm-mode nil +"Non-nil if Helm mode is enabled. +See the `helm-mode' command +for a description of this minor mode. +Setting this variable directly does not take effect; +either customize it (see the info node `Easy Customization') +or call the function `helm-mode'.") +(custom-autoload 'helm-mode "helm-mode" nil) +(autoload 'helm-mode "helm-mode" +"Toggle generic helm completion. + +All functions in Emacs that use `completing-read', +`read-file-name', `completion-in-region' and friends will use helm +interface when this mode is turned on. + +However you can modify this behavior for functions of your choice +with `helm-completing-read-handlers-alist'. + +Called with a positive arg, turn on unconditionally, with a +negative arg turn off. +You can toggle it with M-x `helm-mode'. + +About `ido-mode': +DO NOT enable `ido-everywhere' when using `helm-mode'. Instead of +using `ido-mode', add the commands where you want to use ido to +`helm-completing-read-handlers-alist' with `ido' as value. + +Note: This mode is incompatible with Emacs23. + +(fn &optional ARG)" t) +(register-definition-prefixes "helm-mode" '("helm-")) + + +;;; Generated autoloads from helm-net.el + +(autoload 'helm-browse-url-firefox "helm-net" +"Same as `browse-url-firefox' but detach from Emacs. + +So when you quit Emacs you can keep your Firefox session open and +not be prompted to kill the Firefox process. + +NOTE: Probably not supported on some systems (e.g., Windows). + +(fn URL &optional IGNORE)" t) +(autoload 'helm-browse-url-opera "helm-net" +"Browse URL with Opera browser and detach from Emacs. + +So when you quit Emacs you can keep your Opera session open and +not be prompted to kill the Opera process. + +NOTE: Probably not supported on some systems (e.g., Windows). + +(fn URL &optional IGNORE)" t) +(autoload 'helm-browse-url-chromium "helm-net" +"Same as `browse-url-chromium' but detach from emacs. + +So when you quit Emacs you can keep your Chromium session open and +not be prompted to kill the Chromium process. + +NOTE: Probably not supported on some systems (e.g., Windows). + +(fn URL &optional IGNORE)" t) +(autoload 'helm-browse-url-brave "helm-net" +"Browse URL with Brave browser and detach from emacs. + +Brave browser executable is determined by `helm-browse-url-brave-program'. + +So when you quit Emacs you can keep your Opera session open and +not be prompted to kill the Opera process. + +NOTE: Probably not supported on some systems (e.g., Windows). + +(fn URL &optional IGNORE)" t) +(autoload 'helm-browse-url-uzbl "helm-net" +"Browse URL with uzbl browser. + +(fn URL &optional IGNORE)" t) +(autoload 'helm-browse-url-conkeror "helm-net" +"Browse URL with conkeror browser. + +(fn URL &optional IGNORE)" t) +(autoload 'helm-browse-url-nyxt "helm-net" +"Browse URL with nyxt browser. + +(fn URL &optional IGNORE)" t) +(autoload 'helm-surfraw "helm-net" +"Preconfigured `helm' to search PATTERN with search ENGINE. + +(fn PATTERN ENGINE)" t) +(autoload 'helm-google-suggest "helm-net" +"Preconfigured `helm' for Google search with Google suggest." t) +(register-definition-prefixes "helm-net" '("helm-")) + + +;;; Generated autoloads from helm-occur.el + +(autoload 'helm-occur "helm-occur" +"Preconfigured helm for searching lines matching pattern in `current-buffer'. + +When `helm-source-occur' is member of +`helm-sources-using-default-as-input' which is the default, +symbol at point is searched at startup. + +When a region is marked search only in this region by narrowing. + +To search in multiples buffers start from one of the commands listing +buffers (i.e. a helm command using `helm-source-buffers-list' like +`helm-mini') and use the multi occur buffers action. + +This is the helm implementation that collect lines matching pattern +like vanilla Emacs `occur' but have nothing to do with it, the search +engine beeing completely different and also much faster." t) +(autoload 'helm-occur-visible-buffers "helm-occur" +"Run helm-occur on all visible buffers in frame." t) +(autoload 'helm-occur-from-isearch "helm-occur" +"Invoke `helm-occur' from isearch. + +To use this bind it to a key in `isearch-mode-map'." t) +(autoload 'helm-multi-occur-from-isearch "helm-occur" +"Invoke `helm-multi-occur' from isearch. + +With a prefix arg, reverse the behavior of +`helm-moccur-always-search-in-current'. +The prefix arg can be set before calling +`helm-multi-occur-from-isearch' or during the buffer selection. + +To use this bind it to a key in `isearch-mode-map'." t) +(register-definition-prefixes "helm-occur" '("helm-")) + + +;;; Generated autoloads from helm-packages.el + +(autoload 'helm-packages "helm-packages" +"Helm interface to manage packages. + +With a prefix arg ARG refresh package list. + +When installing or upgrading ensure to refresh the package list +to avoid errors with outdated packages no more availables. + +(fn &optional ARG)" t) +(autoload 'helm-finder "helm-packages" +"Helm interface to find packages by keywords with `finder'. +To have more actions on packages, use `helm-packages'. + +(fn &optional ARG)" t) +(register-definition-prefixes "helm-packages" '("helm-")) + + +;;; Generated autoloads from helm-regexp.el + +(autoload 'helm-regexp "helm-regexp" +"Preconfigured helm to build regexps. +`query-replace-regexp' can be run from there against found regexp." t) +(register-definition-prefixes "helm-regexp" '("helm-")) + + +;;; Generated autoloads from helm-ring.el + +(autoload 'helm-mark-ring "helm-ring" +"Preconfigured `helm' for `helm-source-mark-ring'." t) +(autoload 'helm-global-mark-ring "helm-ring" +"Preconfigured `helm' for `helm-source-global-mark-ring'." t) +(autoload 'helm-all-mark-rings "helm-ring" +"Preconfigured `helm' for mark rings. +Source used are `helm-source-global-mark-ring' and +`helm-source-mark-ring'." t) +(autoload 'helm-register "helm-ring" +"Preconfigured `helm' for Emacs registers." t) +(autoload 'helm-show-kill-ring "helm-ring" +"Preconfigured `helm' for `kill-ring'. +It is drop-in replacement of `yank-pop'. + +First call open the kill-ring browser, next calls move to next line." t) +(autoload 'helm-execute-kmacro "helm-ring" +"Preconfigured helm for keyboard macros. +Define your macros with `f3' and `f4'. +See (info \"(emacs) Keyboard Macros\") for detailed infos." t) +(register-definition-prefixes "helm-ring" '("helm-")) + + +;;; Generated autoloads from helm-semantic.el + +(autoload 'helm-semantic "helm-semantic" +"Preconfigured `helm' for `semantic'. +If ARG is supplied, pre-select symbol at point instead of current. + +(fn ARG)" t) +(autoload 'helm-semantic-or-imenu "helm-semantic" +"Preconfigured helm for `semantic' or `imenu'. +If ARG is supplied, pre-select symbol at point instead of current +semantic tag in scope. + +If `semantic-mode' is active in the current buffer, then use +semantic for generating tags, otherwise fall back to `imenu'. +Fill in the symbol at point by default. + +(fn ARG)" t) +(register-definition-prefixes "helm-semantic" '("helm-s")) + + +;;; Generated autoloads from helm-sys.el + +(defvar helm-top-poll-mode nil +"Non-nil if Helm-Top-Poll mode is enabled. +See the `helm-top-poll-mode' command +for a description of this minor mode. +Setting this variable directly does not take effect; +either customize it (see the info node `Easy Customization') +or call the function `helm-top-poll-mode'.") +(custom-autoload 'helm-top-poll-mode "helm-sys" nil) +(autoload 'helm-top-poll-mode "helm-sys" +"Refresh automatically helm top buffer once enabled. + +This is a global minor mode. If called interactively, toggle the +`Helm-Top-Poll mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value \\='helm-top-poll-mode)'. + +The mode's hook is called both when the mode is enabled and when it is +disabled. + +(fn &optional ARG)" t) +(autoload 'helm-top "helm-sys" +"Preconfigured `helm' for top command. +When prefix arg ARG is non nil toggle auto updating mode `helm-top-poll-mode'. + +(fn &optional ARG)" t) +(autoload 'helm-list-emacs-process "helm-sys" +"Preconfigured `helm' for Emacs process." t) +(autoload 'helm-xrandr-set "helm-sys" +"Preconfigured helm for xrandr." t) +(register-definition-prefixes "helm-sys" '("helm-")) + + +;;; Generated autoloads from helm-tags.el + +(autoload 'helm-etags-select "helm-tags" +"Preconfigured helm for etags. +If called with a prefix argument REINIT +or if any of the tag files have been modified, reinitialize cache. + +This function aggregates three sources of tag files: + + 1) An automatically located file in the parent directories, + by `helm-etags-get-tag-file'. + 2) `tags-file-name', which is commonly set by `find-tag' command. + 3) `tags-table-list' which is commonly set by `visit-tags-table' command. + +(fn REINIT)" t) +(register-definition-prefixes "helm-tags" '("helm-")) + + +;;; Generated autoloads from helm-types.el + +(register-definition-prefixes "helm-types" '("helm-")) + + +;;; Generated autoloads from helm-utils.el + +(defvar helm-popup-tip-mode nil +"Non-nil if Helm-Popup-Tip mode is enabled. +See the `helm-popup-tip-mode' command +for a description of this minor mode. +Setting this variable directly does not take effect; +either customize it (see the info node `Easy Customization') +or call the function `helm-popup-tip-mode'.") +(custom-autoload 'helm-popup-tip-mode "helm-utils" nil) +(autoload 'helm-popup-tip-mode "helm-utils" +"Show additional informations in a popup tip at end of line. + +When the mode is enabled, popup showup when the source +has a `popup-info' attribute which define a specific function for +this source to fetch infos on candidate. + +This is a global minor mode. If called interactively, toggle the +`Helm-Popup-Tip mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value \\='helm-popup-tip-mode)'. + +The mode's hook is called both when the mode is enabled and when it is +disabled. + +(fn &optional ARG)" t) +(register-definition-prefixes "helm-utils" '("helm-" "with-helm-display-marked-candidates")) + + +;;; Generated autoloads from helm-x-files.el + +(register-definition-prefixes "helm-x-files" '("helm-")) + + +;;; Generated autoloads from helm-x-icons.el + +(register-definition-prefixes "helm-x-icons" '("helm-x-icons-")) + +;;; End of scraped data + +(provide 'helm-autoloads) + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; no-native-compile: t +;; coding: utf-8-emacs-unix +;; End: + +;;; helm-autoloads.el ends here diff --git a/elpa/helm-20260424.1357/helm-bookmark.el b/elpa/helm-20260424.1357/helm-bookmark.el new file mode 100644 index 00000000..bf2d9526 --- /dev/null +++ b/elpa/helm-20260424.1357/helm-bookmark.el @@ -0,0 +1,964 @@ +;;; helm-bookmark.el --- Helm for Emacs regular Bookmarks. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2026 Thierry Volpiatto + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Code: +(require 'cl-lib) +(require 'bookmark) +(require 'helm) +(require 'helm-lib) +(require 'helm-help) +(require 'helm-types) +(require 'helm-utils) +(require 'helm-info) +(require 'helm-adaptive) +(require 'helm-net) +(require 'helm-x-icons) + +(declare-function helm-browse-project "helm-files" (arg)) +(declare-function addressbook-bookmark-edit "ext:addressbook-bookmark.el" (bookmark)) +(declare-function eww-read-bookmarks "eww") + +(defvar eww-bookmarks) + + +(defgroup helm-bookmark nil + "Predefined configurations for `helm.el'." + :group 'helm) + +(defcustom helm-bookmark-show-location nil + "Show location of bookmark on display." + :type 'boolean) + +(defcustom helm-bookmark-default-filtered-sources + (append '(helm-source-bookmark-org + helm-source-bookmark-files&dirs + helm-source-bookmark-helm-find-files + helm-source-bookmark-info + helm-source-bookmark-gnus + helm-source-bookmark-mu4e + helm-source-bookmark-man + helm-source-bookmark-images + helm-source-bookmark-w3m) + (list 'helm-source-bookmark-uncategorized + 'helm-source-bookmark-set)) + "List of sources to use in `helm-filtered-bookmarks'." + :type '(repeat (choice symbol))) + +(defcustom helm-bookmark-use-icon nil + "Display candidates with an icon with `all-the-icons' when non nil. +Don't use `setq' to set this." + :type 'boolean + :set (lambda (var val) + (set var (and (require helm-x-icons-provider nil t) val)))) + +(defcustom helm-bookmark-default-sort-method 'adaptive + "Sort method for `helm-filtered-bookmarks'. + +Value can be either \\='native' or \\='adaptive'. + +See `helm-adaptive-sort' for infos on \\='native'. + +Once you use \\='native' the bookmark variable `bookmark-sort-flag' +will be honored." + :type '(choice + (symbol :tag "Helm adaptive sort method" adaptive) + (symbol :tag "Native bookmark sort method" native)) + ;; Don't use the :set function until functions and variables below + ;; are not loaded i.e. use set-default only for now. + :initialize 'custom-initialize-changed + :set (lambda (var val) + (set var val) + (cl-loop for s in (remove 'helm-source-bookmark-set + helm-bookmark-default-filtered-sources) + for fn = (intern (format "%s-builder" s)) + do (set s (funcall fn))))) + +(defcustom helm-bookmark-annotation-sign "*" + "Boomarks with annotation are prefixed with this string." + :type 'string) + +(defgroup helm-bookmark-faces nil + "Customize the appearance of helm-bookmark." + :prefix "helm-" + :group 'helm-bookmark + :group 'helm-faces) + +(defface helm-bookmark-info + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :foreground "green")) + "Face used for W3m Emacs bookmarks (not w3m bookmarks)." + :group 'helm-bookmark-faces) + +(defface helm-bookmark-w3m + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :foreground "yellow")) + "Face used for W3m Emacs bookmarks (not w3m bookmarks)." + :group 'helm-bookmark-faces) + +(defface helm-bookmark-gnus + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :foreground "magenta")) + "Face used for Gnus bookmarks." + :group 'helm-bookmark-faces) + +(defface helm-bookmark-man + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :foreground "orange4")) + "Face used for Woman/man bookmarks." + :group 'helm-bookmark-faces) + +(defface helm-bookmark-file + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :foreground "DeepSkyBlue2")) + "Face used for file bookmarks." + :group 'helm-bookmark-faces) + +(defface helm-bookmark-file-not-found + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :foreground "SlateGray4")) + "Face used for file bookmarks." + :group 'helm-bookmark-faces) + +(defface helm-bookmark-directory + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :inherit helm-ff-directory)) + "Face used for file bookmarks." + :group 'helm-bookmark-faces) + +(defface helm-bookmark-addressbook + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :foreground "tomato")) + "Face used for addressbook bookmarks." + :group 'helm-bookmark-faces) + + +(defvar helm-bookmark-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (define-key map (kbd "C-c o") #'helm-bookmark-run-jump-other-window) + (define-key map (kbd "C-c C-o") #'helm-bookmark-run-jump-other-frame) + (define-key map (kbd "C-c C-t") #'helm-bookmark-run-jump-other-tab) + (define-key map (kbd "C-d") #'helm-bookmark-run-delete) + (define-key map (kbd "C-]") #'helm-bookmark-toggle-filename) + (define-key map (kbd "M-e") #'helm-bookmark-run-edit) + map) + "Generic Keymap for Emacs bookmark sources.") + +(defclass helm-source-basic-bookmarks (helm-source-in-buffer helm-type-bookmark) + ((init :initform (lambda () + (bookmark-maybe-load-default-file) + (helm-init-candidates-in-buffer + 'global + (if (and (fboundp 'bookmark-maybe-sort-alist) + (fboundp 'bookmark-name-from-full-record)) + (mapcar 'bookmark-name-from-full-record + (bookmark-maybe-sort-alist)) + (bookmark-all-names))))) + (filtered-candidate-transformer :initform 'helm-bookmark-transformer) + (find-file-target :initform #'helm-bookmarks-quit-an-find-file-fn))) + +(defvar helm-source-bookmarks + (helm-make-source "Bookmarks" 'helm-source-basic-bookmarks) + "See (info \"(emacs)Bookmarks\").") + +(defun helm-bookmark-transformer (candidates _source) + (cl-loop for i in candidates + for loc = (bookmark-location i) + for len = (string-width i) + for trunc = (if (> len bookmark-bmenu-file-column) + (helm-substring i bookmark-bmenu-file-column) + i) + for sep = (make-string (- (+ bookmark-bmenu-file-column 2) + (length trunc)) + ? ) + if helm-bookmark-show-location + collect (cons (concat trunc sep (if (listp loc) (car loc) loc)) i) + else collect i)) + +(defun helm-bookmark-toggle-filename-1 (_candidate) + (let* ((real (helm-get-selection helm-buffer)) + (trunc (if (> (string-width real) bookmark-bmenu-file-column) + (helm-substring real bookmark-bmenu-file-column) + real))) + (setq helm-bookmark-show-location (not helm-bookmark-show-location)) + (helm-update (if helm-bookmark-show-location + (regexp-quote trunc) + (regexp-quote real))))) + +(helm-make-persistent-command-from-action helm-bookmark-toggle-filename + "Toggle bookmark location visibility." + 'toggle-filename 'helm-bookmark-toggle-filename-1) + +(defun helm-bookmark-jump-1 (candidate &optional fn) + (let (;; FIXME Why is prefarg necessary here? + (current-prefix-arg helm-current-prefix-arg) + non-essential) + (bookmark-jump candidate fn))) + +(defun helm-bookmark-jump (candidate) + "Jump to bookmark action." + (helm-bookmark-jump-1 candidate)) + +(defun helm-bookmark-jump-other-frame (candidate) + "Jump to bookmark in other frame action." + (helm-bookmark-jump-1 candidate #'switch-to-buffer-other-frame)) + +(defun helm-bookmark-jump-other-window (candidate) + "Jump to bookmark in other window action." + (helm-bookmark-jump-1 candidate #'switch-to-buffer-other-window)) + +(defun helm-bookmark-jump-other-tab (candidate) + "Jump to bookmark action." + (cl-assert (fboundp 'tab-bar-mode) nil "Tab-bar-mode not available") + (helm-bookmark-jump-1 candidate #'switch-to-buffer-other-tab)) + +;;; bookmark-set +;; +(defvar helm-source-bookmark-set + (helm-build-dummy-source "Set Bookmark" + :filtered-candidate-transformer + (lambda (_candidates _source) + (list (or (and (not (string= helm-pattern "")) + helm-pattern) + "Enter a bookmark name to record"))) + :action `(("Set bookmark" . ,(lambda (candidate) + (if (string= helm-pattern "") + (message "No bookmark name given for record") + (bookmark-set candidate)))))) + "See (info \"(emacs)Bookmarks\").") + + +;;; Predicates +;; +(defconst helm-bookmark--non-file-filename " - no file -" + "Name to use for `filename' entry, for non-file bookmarks.") + +(defun helm-bookmark-gnus-bookmark-p (bookmark) + "Return non-nil if BOOKMARK is a Gnus bookmark. +BOOKMARK is a bookmark name or a bookmark record." + (or (eq (bookmark-get-handler bookmark) 'bmkext-jump-gnus) + (eq (bookmark-get-handler bookmark) 'gnus-summary-bookmark-jump) + (eq (bookmark-get-handler bookmark) 'bookmarkp-jump-gnus) + (eq (bookmark-get-handler bookmark) 'bmkp-jump-gnus))) + +(defun helm-bookmark-mu4e-bookmark-p (bookmark) + "Return non nil if BOOKMARK is a mu4e bookmark. +BOOKMARK is a bookmark name or a bookmark record." + (memq (bookmark-get-handler bookmark) + '(mu4e-bookmark-jump mu4e--jump-to-bookmark))) + +(defun helm-bookmark-w3m-bookmark-p (bookmark) + "Return non-nil if BOOKMARK is a W3m bookmark. +BOOKMARK is a bookmark name or a bookmark record." + (or (eq (bookmark-get-handler bookmark) 'bmkext-jump-w3m) + (eq (bookmark-get-handler bookmark) 'bookmark-w3m-bookmark-jump) + (eq (bookmark-get-handler bookmark) 'bookmarkp-jump-w3m) + (eq (bookmark-get-handler bookmark) 'bmkp-jump-w3m))) + +(defun helm-bookmark-eww-bookmark-p (bookmark) + "Return non-nil if BOOKMARK is an Eww bookmark. +BOOKMARK is a bookmark name or a bookmark record." + (eq (bookmark-get-handler bookmark) 'eww-bookmark-jump)) + +(defun helm-bookmark-woman-bookmark-p (bookmark) + "Return non-nil if BOOKMARK is a Woman bookmark. +BOOKMARK is a bookmark name or a bookmark record." + (or (eq (bookmark-get-handler bookmark) 'bmkext-jump-woman) + (eq (bookmark-get-handler bookmark) 'woman-bookmark-jump) + (eq (bookmark-get-handler bookmark) 'bookmarkp-jump-woman) + (eq (bookmark-get-handler bookmark) 'bmkp-jump-woman))) + +(defun helm-bookmark-man-bookmark-p (bookmark) + "Return non-nil if BOOKMARK is a Man bookmark. +BOOKMARK is a bookmark name or a bookmark record." + (or (eq (bookmark-get-handler bookmark) 'bmkext-jump-man) + (eq (bookmark-get-handler bookmark) 'Man-bookmark-jump) + (eq (bookmark-get-handler bookmark) 'bookmarkp-jump-man) + (eq (bookmark-get-handler bookmark) 'bmkp-jump-man))) + +(defun helm-bookmark-woman-man-bookmark-p (bookmark) + "Return non-nil if BOOKMARK is a Man or Woman bookmark. +BOOKMARK is a bookmark name or a bookmark record." + (or (helm-bookmark-man-bookmark-p bookmark) + (helm-bookmark-woman-bookmark-p bookmark))) + +(defun helm-bookmark-info-bookmark-p (bookmark) + "Return non-nil if BOOKMARK is an Info bookmark. +BOOKMARK is a bookmark name or a bookmark record." + (eq (bookmark-get-handler bookmark) 'Info-bookmark-jump)) + +(defun helm-bookmark-image-bookmark-p (bookmark) + "Return non-nil if BOOKMARK bookmarks an image file." + (if (stringp bookmark) + (assq 'image-type (assq bookmark bookmark-alist)) + (assq 'image-type bookmark))) + +(defun helm-bookmark-file-p (bookmark) + "Return non-nil if BOOKMARK bookmarks a file or directory. +BOOKMARK is a bookmark name or a bookmark record. +This excludes bookmarks of a more specific kind (Info, Gnus, and W3m)." + (let* ((filename (bookmark-get-filename bookmark)) + (isnonfile (equal filename helm-bookmark--non-file-filename))) + (and filename + (not isnonfile) + (not (helm-bookmark-org-file-p bookmark)) + (not (bookmark-get-handler bookmark))))) + +(defun helm-bookmark-org-file-p (bookmark) + (let* ((filename (bookmark-get-filename bookmark))) + (or (string-suffix-p ".org" filename t) + (string-suffix-p ".org_archive" filename t)))) + +(defun helm-bookmark-helm-find-files-p (bookmark) + "Return non-nil if BOOKMARK bookmarks a `helm-find-files' session. +BOOKMARK is a bookmark name or a bookmark record." + (eq (bookmark-get-handler bookmark) 'helm-ff-bookmark-jump)) + +(defun helm-bookmark-addressbook-p (bookmark) + "Return non--nil if BOOKMARK is a contact recorded with addressbook-bookmark. +BOOKMARK is a bookmark name or a bookmark record." + (if (listp bookmark) + (string= (assoc-default 'type bookmark) "addressbook") + (string= (assoc-default + 'type (assoc bookmark bookmark-alist)) "addressbook"))) + +(defun helm-bookmark-uncategorized-bookmark-p (bookmark) + "Return non--nil if BOOKMARK match no known category." + (cl-loop for pred in '(helm-bookmark-org-file-p + helm-bookmark-addressbook-p + helm-bookmark-gnus-bookmark-p + helm-bookmark-mu4e-bookmark-p + helm-bookmark-w3m-bookmark-p + helm-bookmark-woman-man-bookmark-p + helm-bookmark-info-bookmark-p + helm-bookmark-image-bookmark-p + helm-bookmark-file-p + helm-bookmark-helm-find-files-p + helm-bookmark-addressbook-p + helm-bookmark-eww-bookmark-p) + never (funcall pred bookmark))) + +(defun helm-bookmark-filter-setup-alist (fn) + "Return a filtered `bookmark-alist' sorted alphabetically." + (cl-loop for b in (if (and (fboundp 'bookmark-maybe-sort-alist) + (eq helm-bookmark-default-sort-method 'native)) + (bookmark-maybe-sort-alist) + bookmark-alist) + for name = (car b) + when (funcall fn b) collect + (propertize name 'location (bookmark-location name)))) + +;;; Bookmark handlers +;; +(defvar w3m-async-exec) +(defun helm-bookmark-jump-w3m (bookmark) + "Jump to W3m bookmark BOOKMARK, setting a new tab. +If `browse-url-browser-function' is set to something else than +`w3m-browse-url' use it." + (require 'helm-net) + (let* ((file (or (bookmark-prop-get bookmark 'filename) + (bookmark-prop-get bookmark 'url))) + (buf (generate-new-buffer-name "*w3m*")) + (w3m-async-exec nil) + ;; If user don't have anymore w3m installed let it browse its + ;; bookmarks with default browser otherwise assume bookmark + ;; have been bookmarked from w3m and use w3m. + (browse-url-browser-function (or (and (fboundp 'w3m-browse-url) + (executable-find "w3m") + 'w3m-browse-url) + browse-url-browser-function)) + (really-use-w3m (equal browse-url-browser-function 'w3m-browse-url))) + (helm-browse-url file really-use-w3m) + (when really-use-w3m + (bookmark-default-handler + `("" (buffer . ,buf) . ,(bookmark-get-bookmark-record bookmark)))))) + +;; All bookmarks recorded with the handler provided with w3m +;; (`bookmark-w3m-bookmark-jump') will use our handler which open +;; the bookmark in a new tab or in an external browser depending +;; on `browse-url-browser-function'. +(defalias 'bookmark-w3m-bookmark-jump #'helm-bookmark-jump-w3m) + +;; Provide compatibility with old handlers provided in external +;; packages bookmark-extensions.el and bookmark+. +(defalias 'bmkext-jump-woman #'woman-bookmark-jump) +(defalias 'bmkext-jump-man #'Man-bookmark-jump) +(defalias 'bmkext-jump-w3m #'helm-bookmark-jump-w3m) +(defalias 'bmkext-jump-gnus #'gnus-summary-bookmark-jump) +(defalias 'bookmarkp-jump-gnus #'gnus-summary-bookmark-jump) +(defalias 'bookmarkp-jump-w3m #'helm-bookmark-jump-w3m) +(defalias 'bookmarkp-jump-woman #'woman-bookmark-jump) +(defalias 'bookmarkp-jump-man #'Man-bookmark-jump) +(defalias 'bmkp-jump-gnus #'gnus-summary-bookmark-jump) +(defalias 'bmkp-jump-w3m #'helm-bookmark-jump-w3m) +(defalias 'bmkp-jump-woman #'woman-bookmark-jump) +(defalias 'bmkp-jump-man #'Man-bookmark-jump) + + +;;;; Filtered bookmark sources +;; +;; +(defclass helm-source-filtered-bookmarks (helm-source-in-buffer helm-type-bookmark) + ((filtered-candidate-transformer + :initform (delq nil + `(,(and (eq helm-bookmark-default-sort-method 'adaptive) + 'helm-adaptive-sort) + helm-highlight-bookmark))) + (find-file-target :initform #'helm-bookmarks-quit-an-find-file-fn))) + +(defun helm-bookmarks-quit-an-find-file-fn (source) + (let* ((sel (helm-get-selection nil nil source)) + (bmk (assoc (replace-regexp-in-string "\\`\\*" "" sel) + bookmark-alist))) + (helm-aif (bookmark-get-filename bmk) + (if (and helm--url-regexp + (string-match helm--url-regexp it)) + it (expand-file-name it)) + (expand-file-name default-directory)))) + +(defun helm-bookmark-build-source (name buildfn &optional class &rest args) + (apply #'helm-make-source name + (or class 'helm-source-filtered-bookmarks) + :init (lambda () + (bookmark-maybe-load-default-file) + (helm-init-candidates-in-buffer + 'global (funcall buildfn))) + args)) + +;;; W3m bookmarks. +;; +(defun helm-bookmark-w3m-setup-alist () + "Specialized filter function for bookmarks w3m." + (helm-bookmark-filter-setup-alist 'helm-bookmark-w3m-bookmark-p)) + +(defun helm-source-bookmark-w3m-builder () + (helm-bookmark-build-source "Bookmark W3m" #'helm-bookmark-w3m-setup-alist)) + +(defvar helm-source-bookmark-w3m (helm-source-bookmark-w3m-builder)) + +;;; Images +;; +(defun helm-bookmark-images-setup-alist () + "Specialized filter function for images bookmarks." + (helm-bookmark-filter-setup-alist 'helm-bookmark-image-bookmark-p)) + +(defun helm-source-bookmark-images-builder () + (helm-bookmark-build-source "Bookmark Images" #'helm-bookmark-images-setup-alist)) + +(defvar helm-source-bookmark-images (helm-source-bookmark-images-builder)) + +;;; EWW bookmarks +;; +(defun helm-bookmark-normalize-eww-bmks () + (unless eww-bookmarks (eww-read-bookmarks)) + (cl-loop for (_url url _title title _time _time) in eww-bookmarks do + (unless (bookmark-get-bookmark title t) + (push (list title (cons 'location url) + '(imported . t) + '(handler . eww-bookmark-jump)) + bookmark-alist) + (cl-incf bookmark-alist-modification-count)))) + +;;;###autoload +(defun helm-bookmark-import-eww-bookmarks () + "Import EWW bookmarks into bookmark-alist." + (interactive) + (when (y-or-n-p "Really import eww-bookmarks into bookmark-alist?") + (bookmark-maybe-load-default-file) + (helm-bookmark-normalize-eww-bmks))) + +(defun helm-bookmark-eww-setup-alist () + "Specialized filter function for Eww bookmarks." + (helm-bookmark-filter-setup-alist 'helm-bookmark-eww-bookmark-p)) + +(defun helm-source-bookmark-eww-builder () + (helm-bookmark-build-source "Bookmark EWW" #'helm-bookmark-eww-setup-alist)) + +(defvar helm-source-bookmark-eww (helm-source-bookmark-eww-builder)) + +;;; Woman Man +;; +(defun helm-bookmark-man-setup-alist () + "Specialized filter function for Man pages bookmarks." + (helm-bookmark-filter-setup-alist 'helm-bookmark-woman-man-bookmark-p)) + +(defun helm-source-bookmark-man-builder () + (helm-bookmark-build-source "Bookmark Woman&Man" #'helm-bookmark-man-setup-alist)) + +(defvar helm-source-bookmark-man (helm-source-bookmark-man-builder)) + +;;; Org files +;; +(defun helm-bookmark-org-setup-alist () + "Specialized filter function for Org file bookmarks." + (helm-bookmark-filter-setup-alist 'helm-bookmark-org-file-p)) + +(defun helm-source-bookmark-org-builder () + (helm-bookmark-build-source "Bookmark Org files" #'helm-bookmark-org-setup-alist)) + +(defvar helm-source-bookmark-org (helm-source-bookmark-org-builder)) + +;;; Gnus +;; +(defun helm-bookmark-gnus-setup-alist () + "Specialized filter function for bookmarks gnus." + (helm-bookmark-filter-setup-alist 'helm-bookmark-gnus-bookmark-p)) + +(defun helm-source-bookmark-gnus-builder () + (helm-bookmark-build-source "Bookmark Gnus" #'helm-bookmark-gnus-setup-alist)) + +(defvar helm-source-bookmark-gnus (helm-source-bookmark-gnus-builder)) + +;;; Mu4e +;; +(defun helm-bookmark-mu4e-setup-alist () + (helm-bookmark-filter-setup-alist 'helm-bookmark-mu4e-bookmark-p)) + +(defun helm-source-bookmark-mu4e-builder () + (helm-bookmark-build-source "Bookmark Mu4e" #'helm-bookmark-mu4e-setup-alist)) + +(defvar helm-source-bookmark-mu4e (helm-source-bookmark-mu4e-builder)) + +;;; Info +;; +(defun helm-bookmark-info-setup-alist () + "Specialized filter function for bookmarks info." + (helm-bookmark-filter-setup-alist 'helm-bookmark-info-bookmark-p)) + +(defun helm-source-bookmark-info-builder () + (helm-bookmark-build-source "Bookmark Info" #'helm-bookmark-info-setup-alist)) + +(defvar helm-source-bookmark-info (helm-source-bookmark-info-builder)) + +;;; Files and directories +;; +(defun helm-bookmark-local-files-setup-alist () + "Specialized filter function for bookmarks locals files." + (helm-bookmark-filter-setup-alist 'helm-bookmark-file-p)) + +(defun helm-source-bookmark-files&dirs-builder () + (helm-bookmark-build-source + "Bookmark Files&Directories" #'helm-bookmark-local-files-setup-alist)) + +(defvar helm-source-bookmark-files&dirs + (helm-source-bookmark-files&dirs-builder)) + +;;; Helm find files sessions. +;; +(defun helm-bookmark-helm-find-files-setup-alist () + "Specialized filter function for `helm-find-files' bookmarks." + (helm-bookmark-filter-setup-alist 'helm-bookmark-helm-find-files-p)) + +(defun helm-bookmark-browse-project (candidate) + "Run `helm-browse-project' from action." + (with-helm-default-directory + (bookmark-get-filename candidate) + (helm-browse-project nil))) + +(helm-make-command-from-action helm-bookmark-run-browse-project + "Run `helm-bookmark-browse-project' from keyboard." + 'helm-bookmark-browse-project) + +(defvar helm-bookmark-find-files-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-bookmark-map) + (define-key map (kbd "C-x C-d") #'helm-bookmark-run-browse-project) + map)) + +(defclass helm-bookmark-find-files-class (helm-source-filtered-bookmarks) ()) + +(cl-defmethod helm--setup-source ((source helm-bookmark-find-files-class)) + ;; Ensure `helm-source-in-buffer' method is called. + (setf (slot-value source 'action) + (helm-append-at-nth + (cl-loop for (name . action) in helm-type-bookmark-actions + ;; We don't want those actions in helm-find-files bookmarks. + unless (memq action '(helm-bookmark-jump-other-frame + helm-bookmark-jump-other-window + helm-bookmark-jump-other-tab + bookmark-set)) + collect (cons name action)) + '(("Browse project" . helm-bookmark-browse-project)) 1)) + (setf (slot-value source 'keymap) helm-bookmark-find-files-map)) + +(defun helm-source-bookmark-helm-find-files-builder () + (helm-bookmark-build-source + "Bookmark helm-find-files sessions" + #'helm-bookmark-helm-find-files-setup-alist + 'helm-bookmark-find-files-class + :persistent-action (lambda (_candidate) (ignore)) + :persistent-help "Do nothing")) + +(defvar helm-source-bookmark-helm-find-files + (helm-source-bookmark-helm-find-files-builder)) + +;;; Uncategorized bookmarks +;; +(defun helm-bookmark-uncategorized-setup-alist () + "Specialized filter function for uncategorized bookmarks." + (helm-bookmark-filter-setup-alist 'helm-bookmark-uncategorized-bookmark-p)) + +(defun helm-source-bookmark-uncategorized-builder () + (helm-bookmark-build-source + "Bookmark uncategorized" #'helm-bookmark-uncategorized-setup-alist)) + +(defvar helm-source-bookmark-uncategorized + (helm-source-bookmark-uncategorized-builder)) + + +;;; Transformer +;; +(defun helm-highlight-bookmark (bookmarks _source) + "Used as `filtered-candidate-transformer' to colorize bookmarks." + (let ((non-essential t)) + (cl-loop for i in bookmarks + for isfile = (bookmark-get-filename i) + for hff = (helm-bookmark-helm-find-files-p i) + for handlerp = (and (fboundp 'bookmark-get-handler) + (bookmark-get-handler i)) + for isw3m = (and (fboundp 'helm-bookmark-w3m-bookmark-p) + (helm-bookmark-w3m-bookmark-p i)) + for isgnus = (and (fboundp 'helm-bookmark-gnus-bookmark-p) + (helm-bookmark-gnus-bookmark-p i)) + for ismu4e = (and (fboundp 'helm-bookmark-mu4e-bookmark-p) + (helm-bookmark-mu4e-bookmark-p i)) + for isman = (and (fboundp 'helm-bookmark-man-bookmark-p) ; Man + (helm-bookmark-man-bookmark-p i)) + for iswoman = (and (fboundp 'helm-bookmark-woman-bookmark-p) ; Woman + (helm-bookmark-woman-bookmark-p i)) + for isannotation = (bookmark-get-annotation i) + for isabook = (string= (bookmark-prop-get i 'type) + "addressbook") + for isinfo = (eq handlerp 'Info-bookmark-jump) + for iseww = (eq handlerp 'eww-bookmark-jump) + for loc = (bookmark-location i) + for len = (string-width i) + for trunc = (if (and helm-bookmark-show-location + (> len bookmark-bmenu-file-column)) + (helm-substring + i bookmark-bmenu-file-column) + i) + for icon = (when helm-bookmark-use-icon + (cond ((and isfile hff) + (helm-aif (or (helm-x-icons-match-to-alist + (helm-basename (helm-basedir isfile t)) + 'dir) + (helm-x-icons-match-to-alist + (helm-basename isfile) + 'dir)) + (apply (car it) (cdr it)) + (helm-x-icons-generic "file-directory"))) + ((or isw3m iseww) + (helm-x-icons-generic "firefox")) + ((and isfile isinfo) (helm-x-icons-generic "info")) + ((or iswoman isman) + (helm-x-icons-generic "man-page")) + ((or isgnus ismu4e) + (helm-x-icons-generic "mail-read")) + (isfile (helm-x-icons-icon-for-file (helm-basename isfile))))) + ;; Add a * if bookmark have annotation + if (and isannotation (not (string-equal isannotation ""))) + do (setq trunc (concat helm-bookmark-annotation-sign + (if helm-bookmark-show-location trunc i))) + for sep = (and helm-bookmark-show-location + (make-string (- (+ bookmark-bmenu-file-column 2) + (string-width trunc)) + ? )) + for bmk = (cond ( ;; info buffers + isinfo + (propertize trunc 'face 'helm-bookmark-info + 'help-echo isfile)) + ( ;; w3m buffers + isw3m + (propertize trunc 'face 'helm-bookmark-w3m + 'help-echo isfile)) + ( ;; eww buffers + iseww + (propertize trunc 'face 'helm-bookmark-w3m + 'help-echo isfile)) + ( ;; gnus buffers + isgnus + (propertize trunc 'face 'helm-bookmark-gnus + 'help-echo isfile)) + ( ;; Man Woman + (or iswoman isman) + (propertize trunc 'face 'helm-bookmark-man + 'help-echo isfile)) + ( ;; Addressbook + isabook + (propertize trunc 'face 'helm-bookmark-addressbook)) + (;; Directories (helm-find-files) + hff + (if (and (file-remote-p isfile) + (not (file-remote-p isfile nil t))) + (propertize trunc 'face 'helm-bookmark-file-not-found + 'help-echo isfile) + (propertize trunc 'face 'helm-bookmark-directory + 'help-echo isfile))) + ( ;; Directories (dired) + (and isfile + ;; This is needed because `non-essential' + ;; is not working on Emacs-24.2 and the behavior + ;; of tramp seems to have changed since previous + ;; versions (Need to reenter password even if a + ;; first connection have been established, + ;; probably when host is named differently + ;; i.e machine/localhost) + (and (not (file-remote-p isfile)) + (file-directory-p isfile))) + (propertize trunc 'face 'helm-bookmark-directory + 'help-echo isfile)) + ( ;; Non existing files. + (and isfile + ;; Be safe and call `file-exists-p' + ;; only if file is not remote or + ;; remote but connected. + (or (and (file-remote-p isfile) + (not (file-remote-p isfile nil t))) + (not (file-exists-p isfile)))) + (propertize trunc 'face 'helm-bookmark-file-not-found + 'help-echo isfile)) + ( ;; regular files + t + (propertize trunc 'face 'helm-bookmark-file + 'help-echo isfile))) + collect (if helm-bookmark-show-location + (cons (concat (and icon (propertize " " 'display (concat icon " "))) + bmk + (propertize + " " 'display + (concat sep (if (listp loc) (car loc) loc)))) + i) + (cons (concat (and icon (propertize " " 'display (concat icon " "))) + bmk) + i))))) + + +;;; Edit/rename/save bookmarks. +;; +;; +(defun helm-bookmark-edit-bookmark (bookmark-name) + "Edit bookmark's name and file name, and maybe save them. +BOOKMARK-NAME is the current (old) name of the bookmark to be +renamed." + (let ((bmk (helm-bookmark-get-bookmark-from-name bookmark-name)) + (handler (bookmark-prop-get bookmark-name 'handler))) + (if (eq handler 'addressbook-bookmark-jump) + (addressbook-bookmark-edit + (assoc bmk bookmark-alist)) + (helm-bookmark-edit-bookmark-1 bookmark-name handler)))) + +(defun helm-bookmark-edit-bookmark-1 (bookmark-name handler) + (let* ((helm--reading-passwd-or-string t) + (bookmark-fname (bookmark-get-filename bookmark-name)) + (bookmark-loc (bookmark-prop-get bookmark-name 'location)) + (message-id (bookmark-prop-get bookmark-name 'message-id)) + (new-name (read-from-minibuffer "Name: " bookmark-name)) + (new-loc (and (or bookmark-fname bookmark-loc) + (read-from-minibuffer "FileName or Location: " + (or bookmark-fname + (if (consp bookmark-loc) + (car bookmark-loc) + bookmark-loc))))) + (new-message-id (and (memq handler '(mu4e--jump-to-bookmark + mu4e-bookmark-jump)) + (read-string "Message-id: " message-id)))) + (when (and (not (equal new-name "")) + (or (not (equal new-loc "")) + (not (equal new-message-id ""))) + (y-or-n-p "Save changes? ")) + (if bookmark-fname + (progn + (helm-bookmark-rename bookmark-name new-name 'batch) + (bookmark-set-filename new-name new-loc)) + (bookmark-prop-set + (bookmark-get-bookmark bookmark-name) + (cond (new-loc 'location) + (new-message-id 'message-id)) + (or new-loc new-message-id)) + (helm-bookmark-rename bookmark-name new-name 'batch)) + (helm-bookmark-maybe-save-bookmark) + (list new-name new-loc)))) + +(defun helm-bookmark-maybe-save-bookmark () + "Increment save counter and maybe save `bookmark-alist'." + (setq bookmark-alist-modification-count (1+ bookmark-alist-modification-count)) + (when (bookmark-time-to-save-p) (bookmark-save))) + +(defun helm-bookmark-rename (old &optional new _batch) + "Change bookmark's name from OLD to NEW. +If NEW is nil, then prompt for its string value. + +Unused arg _BATCH is kept for backward compatibility. + +While the user enters the new name, repeated `C-w' inserts +consecutive words from the buffer into the new bookmark name." + (bookmark-maybe-historicize-string old) + (bookmark-maybe-load-default-file) + (save-excursion + (skip-chars-forward " ") (setq bookmark-yank-point (point))) + (setq bookmark-current-buffer (current-buffer)) + (catch 'skip + (let ((newname + (or new (read-from-minibuffer + ;; `format-prompt' is not available in old Emacs. + (format "New name [C-RET to skip] (default %s): " old) nil + (let ((now-map (copy-keymap minibuffer-local-map))) + (define-key now-map "\C-w" #'bookmark-yank-word) + (define-key now-map (kbd "C-") + #'(lambda () (interactive) (throw 'skip 'skip))) + now-map) + nil 'bookmark-history old)))) + (bookmark-set-name old newname) + (helm-bookmark-maybe-save-bookmark) newname))) + +(defun helm-bookmark-rename-marked (_candidate) + "Rename marked bookmarks." + (let* ((bmks (helm-marked-candidates)) + (count 0) + (len (length bmks))) + (cl-loop for bmk in bmks + unless (eq (helm-bookmark-rename bmk) 'skip) + do (cl-incf count)) + (message "(%s/%s) bookmark(s) renamed" count len))) + +(helm-make-command-from-action helm-bookmark-run-edit + "Run `helm-bookmark-edit-bookmark' from keyboard." + 'helm-bookmark-edit-bookmark) + + +(helm-make-command-from-action helm-bookmark-run-jump-other-frame + "Jump to bookmark other frame from keyboard." + 'helm-bookmark-jump-other-frame) + +(helm-make-command-from-action helm-bookmark-run-jump-other-window + "Jump to bookmark other window from keyboard." + 'helm-bookmark-jump-other-window) + +(helm-make-command-from-action helm-bookmark-run-jump-other-tab + "Jump to bookmark other tab from keyboard." + 'helm-bookmark-jump-other-tab) + +(helm-make-command-from-action helm-bookmark-run-delete + "Delete bookmark from keyboard." + 'helm-delete-marked-bookmarks) + +(defun helm-bookmark-get-bookmark-from-name (bmk) + "Return bookmark name even if it is a bookmark with annotation. +E.g. prepended with *." + (let ((bookmark (replace-regexp-in-string "\\`\\*" "" bmk))) + (if (assoc bookmark bookmark-alist) bookmark bmk))) + +(defun helm-delete-marked-bookmarks (_ignore) + "Delete this bookmark or all marked bookmarks." + (dolist (i (helm-marked-candidates)) + (bookmark-delete (helm-bookmark-get-bookmark-from-name i) + 'batch))) + +(defun helm-bookmark-get-defaults () + "Get default bookmark names at point for `bookmark-set'." + (let* (bookmark-current-bookmark no-defaults + (record (condition-case _err + (bookmark-make-record) + (error (setq no-defaults t))))) + ;; Not sure `bookmark-make-record' set 'defaults prop in older Emacs. + (or (bookmark-prop-get record 'defaults) + (unless no-defaults + (list (buffer-name helm-current-buffer)))))) + +;;; bookmark annotations +;; +(defun helm-bookmark-show-annotation (bookmark-name-or-record) + "Display the annotation for BOOKMARK-NAME-OR-RECORD in a buffer." + (let ((annotation (bookmark-get-annotation bookmark-name-or-record))) + (when (and annotation (not (string-equal annotation ""))) + (let ((buf (get-buffer-create "*Bookmark Annotation*"))) + (with-current-buffer buf + (let ((inhibit-read-only t)) + (erase-buffer) + (insert annotation) + (goto-char (point-min)) + (set-buffer-modified-p nil) + (helm-bookmark-annotation-mode) + (insert (substitute-command-keys + "# Edit this buffer with \\[helm-bookmark-edit-annotation]") + (substitute-command-keys + "\n# Quit this buffer with \\[helm-bookmark-quit-annotation]\n")) + (set (make-local-variable 'bookmark-annotation-name) + bookmark-name-or-record) + (put 'bookmark-annotation-name 'permanent-local t))) + (pop-to-buffer buf))))) + +(defun helm-bookmark-edit-annotation () + "Edit bookmark annotation from the show annotation buffer." + (interactive) + (setq buffer-read-only nil) + (bookmark-edit-annotation-mode) + (save-excursion + (goto-char (point-min)) + (delete-region + (point) (save-excursion (forward-line 2) (point))) + (insert (funcall bookmark-edit-annotation-text-func + bookmark-annotation-name)))) +(put 'helm-bookmark-edit-annotation 'no-helm-mx t) + +(defun helm-bookmark-quit-annotation () + "Quit bookmark annotation buffer." + (interactive) + (quit-window t)) +(put 'helm-bookmark-quit-annotation 'no-helm-mx t) + +(defvar helm-bookmark-annotation-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map text-mode-map) + (define-key map (kbd "q") #'helm-bookmark-quit-annotation) + (define-key map (kbd "e") #'helm-bookmark-edit-annotation) + map) + "Map used in show annotation bookmark buffer.") + +(define-derived-mode helm-bookmark-annotation-mode + text-mode "helm-annotation-mode" + "Mode to display bookmark annotations. + +Special commands: +\\{helm-bookmark-annotation-mode-map}" + :interactive nil + (setq-local buffer-read-only t)) + +;;;###autoload +(defun helm-bookmarks () + "Preconfigured `helm' for bookmarks." + (interactive) + (helm :sources '(helm-source-bookmarks + helm-source-bookmark-set) + :buffer "*helm bookmarks*" + :default (buffer-name helm-current-buffer))) + +;;;###autoload +(defun helm-filtered-bookmarks () + "Preconfigured `helm' for bookmarks (filtered by category). +Optional source `helm-source-bookmark-addressbook' is loaded only +if external addressbook-bookmark package is installed." + (interactive) + (helm :sources helm-bookmark-default-filtered-sources + :prompt "Search Bookmark: " + :buffer "*helm filtered bookmarks*" + :default (helm-bookmark-get-defaults))) + +(provide 'helm-bookmark) + +;;; helm-bookmark.el ends here diff --git a/elpa/helm-20260424.1357/helm-buffers.el b/elpa/helm-20260424.1357/helm-buffers.el new file mode 100644 index 00000000..6d1f466c --- /dev/null +++ b/elpa/helm-20260424.1357/helm-buffers.el @@ -0,0 +1,1250 @@ +;;; helm-buffers.el --- helm support for buffers. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2026 Thierry Volpiatto + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Code: + +(require 'cl-lib) +(require 'helm) +(require 'helm-types) +(require 'helm-utils) +(require 'helm-grep) +(require 'helm-regexp) +(require 'helm-help) +(require 'helm-occur) +(require 'helm-x-icons) + +(declare-function helm-comp-read "helm-mode") +(declare-function helm-browse-project "helm-files") +(declare-function helm-ff-switch-to-shell "helm-files") + +(defvar dired-buffers) +(defvar org-directory) +(defvar helm-ff-default-directory) +(defvar major-mode-remap-alist) + + +(defgroup helm-buffers nil + "Buffers related Applications and libraries for Helm." + :group 'helm) + +(defcustom helm-boring-buffer-regexp-list + '("\\` " "\\`\\*helm" "\\`\\*Echo Area" "\\`\\*Minibuf") + "The regexp list that match boring buffers. +Buffer candidates matching these regular expression will be +filtered from the list of candidates if the +`helm-skip-boring-buffers' candidate transformer is used." + :type '(repeat (choice regexp))) + +(defcustom helm-white-buffer-regexp-list nil + "The regexp list of not boring buffers. +These buffers will be displayed even if they match one of +`helm-boring-buffer-regexp-list'." + :type '(repeat (choice regexp))) + +(defcustom helm-buffers-favorite-modes '(lisp-interaction-mode + emacs-lisp-mode + text-mode + org-mode) + "List of preferred mode to open new buffers with." + :type '(repeat (choice function))) + +(defcustom helm-buffer-max-length 20 + "Max length of buffer names before truncate. +When disabled (nil) use the longest `buffer-name' length found." + :type '(choice (const :tag "Disabled" nil) + (integer :tag "Length before truncate"))) + +(defcustom helm-buffer-details-flag t + "Always show details in buffer list when non-nil." + :type 'boolean) + +(defcustom helm-buffers-fuzzy-matching nil + "Fuzzy matching buffer names when non-nil. +Only buffer names are fuzzy matched when this is enabled, +`major-mode' matching is not affected by this." + :type 'boolean) + +(defcustom helm-buffer-skip-remote-checking nil + "Ignore checking for `file-exists-p' on remote files." + :type 'boolean) + +(defcustom helm-buffers-truncate-lines t + "Truncate lines in `helm-buffers-list' when non-nil." + :type 'boolean) + +(defcustom helm-buffers-left-margin-width helm-left-margin-width + "`left-margin-width' value for `helm-mini' and `helm-buffers-list'." + :type 'integer) + +(defcustom helm-mini-default-sources '(helm-source-buffers-list + helm-source-recentf + helm-source-buffer-not-found) + "Default sources list used in `helm-mini'. + +When adding a source here it is up to you to ensure the library +of this source is accessible and properly loaded." + :type '(repeat (choice symbol))) + +(defcustom helm-buffers-end-truncated-string + ;; `truncate-string-ellipsis', the function is not available in 27.1 + ;; See issue#2673. + (if (char-displayable-p ?…) "…" "...") + "The string to display at end of truncated buffer names." + :type 'string) + +(defcustom helm-buffers-column-separator " " + "Separator for columns in buffer listing." + :type 'string) + +(defcustom helm-buffer--pretty-names '((dired-mode . "Dired") + (lisp-interaction-mode . "Lisp Inter")) + "An alist specifying pretty names for modes. +Most of the time buffer's `mode-name' is a string so no need to +add it here as there is no need to compute it, but sometimes it +may be a mode-line specification which may be costly to compute, +in this case add here the pretty name as a string to avoid this +costly computation. Also if some pretty names are too long you +can add your own abbreviation here." + :type '(alist :key-type symbol :value-type string)) + +(defcustom helm-buffers-maybe-switch-to-tab nil + "Switch to buffer in its tab when non nil. +Setting this change `tab-bar-tab-name-function' to `tab-bar-tab-name-all'. +Do not use `setq' to set this variable. + +This variable takes effect only when `tab-bar-mode' is available (emacs-27.1+)." + :type 'boolean + :set (lambda (var val) + ;; We should be able to retrieve all buffers assigned to a tab whatever + ;; the value used for `tab-bar-tab-name-function', unfortunately this + ;; is not the case, it seems the alist contains the buffer names only + ;; when `tab-bar-tab-name-all' is used and set globally. Then when the + ;; mode-line/header-line is rebuilded some code (probably C code in + ;; `force-mode-line-update' or elsewhare) changes the alist so just + ;; let-binding `tab-bar-tab-name-function' is not enough. This is + ;; reproductible when we have more than one window visible and we turn + ;; on `tab-bar-mode', the alist is showing only the first buffer of + ;; window-list omitting the others, however when starting with only one + ;; window, calling `tab-bar-mode' and splitting window afterward the + ;; alist is updated. Looks it is a bug or a limitation of + ;; `tab-bar-mode'. + (set var val) + (if val + (customize-set-variable + 'tab-bar-tab-name-function + #'tab-bar-tab-name-all) + (let* ((sym 'tab-bar-tab-name-function) + (standard-value (eval (car (get sym 'standard-value)) t))) + (unless (equal standard-value (symbol-value sym)) + (set sym standard-value)))))) + +(defcustom helm-buffer-list-reorder-fn #'helm-buffers-reorder-buffer-list + "A function in charge of ordering the initial buffer list. +It takes two arguments VISIBLES buffers and OTHERS buffers. +Arg VISIBLES handles the buffers visibles in this frame. +Arg OTHERS handles all the other buffers. +You can write a function that reorder VISIBLES and OTHERS as you +want. +Default function returns OTHERS buffers on top and VISIBLES +buffer at the end. See `helm-buffers-reorder-buffer-list'." + :type 'function) + +(defcustom helm-buffers-sort-fn helm-fuzzy-sort-fn + "The sort function to use in `helm-buffers-list'. + +Default to `helm-fuzzy-sort-fn' you can use +`helm-fuzzy-matching-sort-fn-preserve-ties-order' as alternative if +you want to keep the recentest order when narrowing candidates." + :type 'function) + +(defcustom helm-buffers-show-icons nil + "Prefix buffer names with an icon when non nil. +Don't use `setq' to set this." + :type 'boolean + :set (lambda (var val) + (set var (and (require helm-x-icons-provider nil t) val)))) + + +;;; Faces +;; +;; +(defgroup helm-buffers-faces nil + "Customize the appearance of helm-buffers." + :prefix "helm-" + :group 'helm-buffers + :group 'helm-faces) + +(defface helm-buffer-saved-out + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :foreground "red" :background "black")) + "Face used for buffer files modified outside of emacs." + :group 'helm-buffers-faces) + +(defface helm-buffer-not-saved + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :foreground "IndianRed2")) + "Face used for buffer files not already saved on disk." + :group 'helm-buffers-faces) + +(defface helm-buffer-modified + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :inherit font-lock-comment-face)) + "Face used for modified buffers." + :group 'helm-buffers-faces) + +(defface helm-no-file-buffer-modified + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :foreground "orange" :background "black")) + "Face used for modified buffers." + :group 'helm-buffers-faces) + +(defface helm-indirect-buffer + `((t :foreground "DimGray" :background "black")) + "Face used for indirect buffers." + :group 'helm-buffers-faces) + +(defface helm-buffer-size + `((((background dark)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :foreground "RosyBrown") + (((background light)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :foreground "SlateGray")) + "Face used for buffer size." + :group 'helm-buffers-faces) + +(defface helm-buffer-process + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :foreground "sienna3")) + "Face used for process status in buffer." + :group 'helm-buffers-faces) + +(defface helm-buffer-directory + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :foreground "DarkRed" :background "LightGray")) + "Face used for directories in `helm-buffers-list'." + :group 'helm-buffers-faces) + +(defface helm-buffer-file + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :inherit font-lock-builtin-face)) + "Face for buffer file names in `helm-buffers-list'." + :group 'helm-buffers-faces) + +(defface helm-buffer-archive + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :foreground "gold")) + "Face for archive file names in `helm-buffers-list'." + :group 'helm-buffers-faces) + +(defface helm-non-file-buffer + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :inherit italic)) + "Face used for non-file buffers in `helm-buffers-list'." + :group 'helm-buffers-faces) + +(defvar helm-buffers-tick-counter nil + "Allows recording local changes to a non-file buffer. +Typical usage of this var is for modes that want to see if their +buffers have changed since last visit. +Such programs may want to record tick counter after visiting +their buffers like this: + + (setq helm-buffers-tick-counter (buffer-modified-tick)) + +See bug#1917. + +Note that this variable is buffer-local.") +(make-variable-buffer-local 'helm-buffers-tick-counter) + + +;;; Buffers keymap +;; +(defvar helm-buffer-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + ;; No need to have separate command for grep and zgrep + ;; as we don't use recursivity for buffers. + ;; So use zgrep for both as it is capable to handle non--compressed files. + (define-key map (kbd "M-g s") #'helm-buffer-run-zgrep) + (define-key map (kbd "C-s") #'helm-buffers-run-occur) + (define-key map (kbd "C-x C-d") #'helm-buffers-run-browse-project) + (define-key map (kbd "C-c o") #'helm-buffer-switch-other-window) + (define-key map (kbd "C-c C-o") #'helm-buffer-switch-other-frame) + (define-key map (kbd "M-g M-g") #'helm-buffer-run-goto-line) + (define-key map (kbd "C-c =") #'helm-buffer-run-ediff) + (define-key map (kbd "M-=") #'helm-buffer-run-ediff-merge) + (define-key map (kbd "C-=") #'helm-buffer-diff-persistent) + (define-key map (kbd "M-G") #'helm-buffer-revert-persistent) + (define-key map (kbd "C-c d") #'helm-buffer-run-kill-persistent) + (define-key map (kbd "M-D") #'helm-buffer-run-kill-buffers) + (define-key map (kbd "C-x C-s") #'helm-buffer-save-persistent) + (define-key map (kbd "C-x s") #'helm-buffer-run-save-some-buffers) + (define-key map (kbd "C-M-%") #'helm-buffer-run-query-replace-regexp) + (define-key map (kbd "M-%") #'helm-buffer-run-query-replace) + (define-key map (kbd "M-R") #'helm-buffer-run-rename-buffer) + (define-key map (kbd "M-e") #'helm-buffer-run-switch-to-shell) + (define-key map (kbd "C-]") #'helm-toggle-buffers-details) + (define-key map (kbd "C-c a") #'helm-buffers-toggle-show-hidden-buffers) + (define-key map (kbd "C-M-SPC") #'helm-buffers-mark-similar-buffers) + (when (fboundp 'tab-bar-mode) + (define-key map (kbd "C-c C-t") #'helm-buffers-switch-to-buffer-new-tab)) + map) + "Keymap for buffer sources in helm.") + + +(defvar helm-buffer-max-len-mode nil) +(defvar helm-buffers-in-project-p nil) +(defvar helm-source-buffers-list nil) + +(defun helm-buffers-list--init () + (require 'dired) + ;; Bug#51 Create the list before `helm-buffer' creation. + ;; We were using a global cache in the past and 'candidates was + ;; bound to this cache, this was a problem when using more than one + ;; source with a different 'buffer-list fn as the same cache was + ;; reused in each source (Bug#1907), now 'candidates attr is set + ;; directly so that each list of candidates is local to source. + (helm-set-attr 'candidates (funcall (helm-get-attr 'buffer-list))) + (let ((result (cl-loop with allbufs = (memq 'helm-shadow-boring-buffers + (helm-get-attr + 'filtered-candidate-transformer + helm-source-buffers-list)) + for b in (if allbufs + (helm-get-attr 'candidates) + (helm-skip-boring-buffers + (helm-get-attr 'candidates) + helm-source-buffers-list)) + maximize (length b) into len-buf + maximize (length (helm-buffer--format-mode-name b)) + into len-mode + finally return (cons len-buf len-mode)))) + (unless (default-value 'helm-buffer-max-length) + (helm-set-local-variable 'helm-buffer-max-length (car result))) + (unless (default-value 'helm-buffer-max-len-mode) + (helm-set-local-variable 'helm-buffer-max-len-mode (cdr result))))) + +(defclass helm-source-buffers (helm-source-sync helm-type-buffer) + ((buffer-list + :initarg :buffer-list + :initform #'helm-buffer-list + :custom function + :documentation + " A function with no arguments to create buffer list.") + (init :initform 'helm-buffers-list--init) + (multimatch :initform nil) + (match :initform 'helm-buffers-match-function) + (persistent-action :initform 'helm-buffers-list-persistent-action) + (keymap :initform 'helm-buffer-map) + (find-file-target :initform #'helm-buffers-quit-and-find-file-fn) + (migemo :initform 'nomultimatch) + (volatile :initform t) + (nohighlight :initform t) + (resume :initform (lambda () (setq helm-buffers-in-project-p nil))) + (help-message :initform 'helm-buffer-help-message))) + +(cl-defun helm-buffers-create-new-buffer-1 (candidate &optional (display-func 'switch-to-buffer)) + (let ((mjm (or (and helm-current-prefix-arg + (intern-soft (helm-comp-read + "Major-mode: " + helm-buffers-favorite-modes))) + (cl-loop for (r . m) in auto-mode-alist + when (string-match r candidate) + return m))) + (buffer (get-buffer-create candidate))) + (helm-aif (and (boundp 'major-mode-remap-alist) + (cdr (assq mjm major-mode-remap-alist))) + (setq mjm it)) + (if mjm + (with-current-buffer buffer (funcall mjm)) + (set-buffer-major-mode buffer)) + (funcall display-func buffer))) + +(defun helm-buffers-create-new-buffer (candidate) + (helm-buffers-create-new-buffer-1 candidate)) + +(defun helm-buffers-create-new-buffer-ow (candidate) + (helm-buffers-create-new-buffer-1 candidate 'switch-to-buffer-other-window)) + +(helm-make-command-from-action helm-buffers-not-found-run-switch-ow + "Run create new buffer other window action from keymap." + 'helm-buffers-create-new-buffer-ow) + +(defun helm-buffers-create-new-buffer-of (candidate) + (helm-buffers-create-new-buffer-1 candidate 'switch-to-buffer-other-frame)) + +(helm-make-command-from-action helm-buffers-not-found-run-switch-of + "Run create new buffer other frame action from keymap." + 'helm-buffers-create-new-buffer-of) + +(defvar helm-buffer-not-found-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (define-key map (kbd "C-c o") #'helm-buffers-not-found-run-switch-ow) + (define-key map (kbd "C-c C-o") #'helm-buffers-not-found-run-switch-of) + map) + "Keymap for `helm-source-buffer-not-found' source.") + +(defvar helm-source-buffer-not-found + (helm-build-dummy-source + "Create buffer" + :action (helm-make-actions + "Create buffer (C-u choose mode)" + #'helm-buffers-create-new-buffer + "Create buffer other window (C-u choose mode)" + #'helm-buffers-create-new-buffer-ow + "Create buffer other frame (C-u choose mode)" + #'helm-buffers-create-new-buffer-of) + :keymap helm-buffer-not-found-map)) + + +(defun helm-buffers-get-visible-buffers () + "Returns buffers visible on visible frames." + (let (result) + (walk-windows + (lambda (x) + (push (buffer-name (window-buffer x)) result)) + nil 'visible) + result)) + +(defun helm-buffer-list-1 (&optional visibles) + "Return list of all buffers except VISIBLES buffers." + (cl-loop for b in (buffer-list) + for bn = (buffer-name b) + unless (member bn visibles) + collect bn)) + +(defun helm-buffers-reorder-buffer-list (visibles others) + "Default function to reorder buffer-list. +Arg VISIBLES handles the buffers visibles in this frame. +Arg OTHERS handles all the other buffers. +This function returns OTHERS buffers on top and VISIBLES buffer +at the end." + (nconc others visibles)) + +(defun helm-buffer-list () + "Return the current list of buffers. +The list is reordered with `helm-buffer-list-reorder-fn'." + (let* ((visibles (helm-buffers-get-visible-buffers)) + (others (helm-buffer-list-1 visibles))) + (funcall helm-buffer-list-reorder-fn visibles others))) + +(defun helm-buffer-size (buffer) + "Return size of BUFFER." + (with-current-buffer buffer + (save-restriction + (widen) + (helm-file-human-size + (- (position-bytes (point-max)) + (position-bytes (point-min))))))) + +(defun helm-buffer--show-details (buf-name prefix help-echo + size mode dir face1 face2 + proc details type) + (append + (list + (let* ((buf-fname (buffer-file-name (get-buffer buf-name))) + (ext (if buf-fname (helm-file-name-extension buf-fname) "")) + (bmode (with-current-buffer buf-name major-mode)) + (icon-alist (helm-x-icons-resolve-alist 'mode)) + (icon (when helm-buffers-show-icons + (helm-aif (and (not (eq type 'indirect)) + (assq bmode icon-alist)) + (and helm-x-icons-provider + (apply (cadr it) (cddr it))) + (cond ((eq type 'dired) + (helm-x-icons-generic "file-directory")) + ((eq type 'indirect) + (helm-x-icons-generic "clone")) + (buf-fname + (helm-x-icons-icon-for-file buf-name)) + (t (helm-x-icons-generic "star" :v-adjust 0.0)))))) + (buf-name (propertize buf-name 'face face1 + 'help-echo help-echo + 'type type))) + (when (condition-case _err + (string-match (format "\\.\\(%s\\)" ext) buf-name) + (invalid-regexp nil)) + (add-face-text-property + (match-beginning 1) (match-end 1) + 'helm-ff-file-extension nil buf-name)) + (if icon + (concat icon " " prefix buf-name) + (concat prefix buf-name)))) + (and details + (list size mode + (propertize + (if proc + (format "(%s %s in `%s')" + (process-name proc) + (process-status proc) dir) + (format "`%s'" dir)) + 'face face2))))) + +(defun helm-buffer--format-mode-name (buf) + "Prevent using `format-mode-line' as much as possible." + (with-current-buffer buf + (helm-acond ((assq major-mode helm-buffer--pretty-names) + (cdr it)) + ((stringp mode-name) mode-name) + (t (format-mode-line mode-name nil nil (get-buffer buf)))))) + +(defun helm-buffer--details (buffer &optional details) + (require 'dired) + (let* ((mode (helm-buffer--format-mode-name buffer)) + (buf (get-buffer buffer)) + (size (propertize (helm-buffer-size buf) + 'face 'helm-buffer-size)) + (proc (get-buffer-process buf)) + (dir (with-current-buffer buffer + (helm-aif default-directory (abbreviate-file-name it)))) + (file-name (helm-aif (buffer-file-name buf) (abbreviate-file-name it))) + (name (buffer-name buf)) + (name-prefix (when (and dir (file-remote-p dir)) + (propertize "@ " 'face 'helm-ff-prefix))) + (archive-p (and (fboundp 'tramp-archive-file-name-p) + (tramp-archive-file-name-p dir)))) + (when name-prefix + ;; Remote tramp buffer names may be hexified, make them more readable. + (setq dir (helm-url-unhex-string dir) + name (helm-url-unhex-string name))) + ;; Handle tramp archive buffers specially. + (if archive-p + (helm-buffer--show-details + name name-prefix file-name size mode dir + 'helm-buffer-archive 'helm-buffer-process nil details 'filebuf) + ;; No fancy things on remote buffers. + (if (and name-prefix helm-buffer-skip-remote-checking) + (helm-buffer--show-details + name name-prefix file-name size mode dir + 'helm-buffer-file 'helm-buffer-process nil details 'filebuf) + (helm-acond + (;; A dired buffer. + (rassoc buf dired-buffers) + (helm-buffer--show-details + name name-prefix dir size mode dir + 'helm-buffer-directory 'helm-buffer-process nil details 'dired)) + ;; A buffer file modified somewhere outside of emacs.=>red + ((and file-name + (file-exists-p file-name) + (not (verify-visited-file-modtime buf))) + (helm-buffer--show-details + name name-prefix file-name size mode dir + 'helm-buffer-saved-out 'helm-buffer-process nil details 'modout)) + ;; A new buffer file not already saved on disk (or a deleted file) .=>indianred2 + ((and file-name (not (file-exists-p file-name))) + (helm-buffer--show-details + name name-prefix file-name size mode dir + 'helm-buffer-not-saved 'helm-buffer-process nil details 'notsaved)) + ;; A buffer file modified and not saved on disk.=>orange + ((and file-name (buffer-modified-p buf)) + (helm-buffer--show-details + name name-prefix file-name size mode dir + 'helm-buffer-modified 'helm-buffer-process nil details 'mod)) + ;; A buffer file not modified and saved on disk.=>green + (file-name + (helm-buffer--show-details + name name-prefix file-name size mode dir + 'helm-buffer-file 'helm-buffer-process nil details 'filebuf)) + ;; Indirect buffer.=>DimGray + ((buffer-base-buffer buf) + (let ((face (if (or (buffer-modified-p it) + (with-current-buffer it + (and helm-buffers-tick-counter + (/= helm-buffers-tick-counter + (buffer-modified-tick))))) + 'helm-buffer-modified + 'helm-indirect-buffer))) + (helm-buffer--show-details + name name-prefix dir size mode dir + face 'helm-buffer-process nil details 'indirect))) + ;; A non-file, modified buffer See bug#1917 + ((with-current-buffer name + (and helm-buffers-tick-counter + (/= helm-buffers-tick-counter (buffer-modified-tick)))) + (helm-buffer--show-details + name (and proc name-prefix) dir size mode dir + 'helm-no-file-buffer-modified 'helm-buffer-process proc details 'nofile-mod)) + ;; Any non--file buffer.=>italic + (t + (helm-buffer--show-details + name (and proc name-prefix) dir size mode dir + 'helm-non-file-buffer 'helm-buffer-process proc details 'nofile))))))) + +(defun helm-highlight-buffers (buffers _source) + "Transformer function to highlight BUFFERS list. +Should be called after others transformers i.e. (boring +buffers)." + (cl-assert helm-fuzzy-matching-highlight-fn nil "Wrong type argument functionp: nil") + (cl-loop for i in buffers + for (name size mode meta) = (if helm-buffer-details-flag + (helm-buffer--details i 'details) + (helm-buffer--details i)) + for truncbuf = (if (> (string-width name) helm-buffer-max-length) + (helm-substring-by-width + name helm-buffer-max-length + helm-buffers-end-truncated-string) + (concat name + (make-string + (- (+ helm-buffer-max-length + (length + helm-buffers-end-truncated-string)) + (string-width name)) + ? ))) + for len = (length mode) + when (> len helm-buffer-max-len-mode) + do (setq helm-buffer-max-len-mode len) + for fmode = (concat (make-string + (- (max helm-buffer-max-len-mode len) len) ? ) + mode) + ;; The max length of a number should be 1023.9X where X is the + ;; units, this is 7 characters. + for formatted-size = (and size (format "%7s" size)) + collect (let ((helm-pattern (helm-buffers--pattern-sans-filters + (and helm-buffers-fuzzy-matching "")))) + (cons (if helm-buffer-details-flag + (concat + (funcall helm-fuzzy-matching-highlight-fn + truncbuf) + helm-buffers-column-separator + formatted-size + helm-buffers-column-separator + fmode + helm-buffers-column-separator + meta) + (funcall helm-fuzzy-matching-highlight-fn name)) + (get-buffer i))))) + +(defun helm-buffer--get-preselection (buffer) + (let* ((bufname (buffer-name buffer)) + (dispbuf (car (helm-buffer--details buffer))) + (len-dispbuf (string-width dispbuf)) + (len-prefix (- len-dispbuf (string-width bufname)))) + (when (and bufname + (file-remote-p (with-current-buffer bufname + default-directory))) + (setq bufname (concat "@ " (helm-url-unhex-string bufname)))) + (concat "^[[:multibyte:] ]*" + (if (and (null helm-buffer-details-flag) + (numberp helm-buffer-max-length) + (> len-dispbuf helm-buffer-max-length)) + (regexp-quote + (helm-substring-by-width + bufname + (- helm-buffer-max-length len-prefix) + helm-buffers-end-truncated-string)) + (concat (regexp-quote bufname) + (if helm-buffer-details-flag + "$" "[[:blank:]]+")))))) + +(defun helm-toggle-buffers-details () + (interactive) + (with-helm-alive-p + (let* ((buf (helm-get-selection)) + (preselect (helm-buffer--get-preselection buf))) + (setq helm-buffer-details-flag (not helm-buffer-details-flag)) + (helm-force-update (lambda () + (helm-awhile (re-search-forward preselect nil t) + (helm-mark-current-line) + (when (equal buf (helm-get-selection)) + (cl-return t)))))))) +(put 'helm-toggle-buffers-details 'helm-only t) + +(defun helm-buffers--pattern-sans-filters (&optional separator) + (cl-loop for p in (helm-mm-split-pattern helm-pattern) + unless (member (substring p 0 1) '("*" "/" "@" "!")) + collect p into lst + finally return (mapconcat #'identity lst (or separator " ")))) + +(defun helm-buffers-sort-transformer (candidates source) + (cl-assert helm-buffers-sort-fn nil "Wrong type argument functionp: nil") + (if (string= helm-pattern "") + candidates + (let ((helm-pattern (helm-buffers--pattern-sans-filters))) + (funcall helm-buffers-sort-fn candidates source)))) + +(defun helm-buffers-mark-similar-buffers-1 (&optional type) + (with-helm-window + (let* ((src (helm-get-current-source)) + (sel (helm-get-selection nil 'withprop src)) + (type (or type (get-text-property + (min 2 (length sel)) 'type sel)))) + (helm-map-candidates-in-source src + (lambda (_cand) (helm-make-visible-mark)) + (lambda (cand) + (and (not (helm-this-visible-mark)) + (eq (get-text-property 2 'type cand) type)))) + (helm-mark-current-line) + (helm-display-mode-line src t) + (when helm-marked-candidates + (message "%s candidates marked" (length helm-marked-candidates)) + (set-window-margins (selected-window) 1))))) + +(defun helm-buffers-mark-similar-buffers () + "Mark All buffers that have same property `type' than current. +I.e. same color." + (interactive) + (with-helm-alive-p + (let ((marked (helm-marked-candidates))) + (if (and (>= (length marked) 1) + (with-helm-window helm-visible-mark-overlays)) + (helm-unmark-all) + (helm-buffers-mark-similar-buffers-1))))) +(put 'helm-buffers-mark-similar-buffers 'helm-only t) + + +;;; match functions +;; +(defun helm-buffer--match-mjm (pattern mjm) + (when (string-match "\\`\\*" pattern) + (cl-loop with patterns = (split-string (substring pattern 1) ",") + for pat in patterns + if (string-match "\\`!" pat) + collect (string-match (substring pat 1) mjm) into neg + else collect (string-match pat mjm) into pos + finally return + (let ((neg-test (cl-loop for i in neg thereis (numberp i))) + (pos-test (cl-loop for i in pos thereis (numberp i)))) + (or + (and neg (not pos) (not neg-test)) + (and pos pos-test) + (and neg neg-test (not neg-test))))))) + +(defvar helm-buffer--memo-hash (make-hash-table :test 'equal)) +(defun helm-buffer--memo-pattern (pattern) + (or (gethash pattern helm-buffer--memo-hash) + (puthash pattern (helm--mapconcat-pattern pattern) + helm-buffer--memo-hash))) + +(defun helm-buffer--match-pattern (pattern candidate &optional nofuzzy) + (let ((bfn (if (and helm-buffers-fuzzy-matching + (not nofuzzy) + (not helm-migemo-mode) + (not (string-match "\\`\\^" pattern))) + #'helm-buffer--memo-pattern + #'identity)) + (mfn (if helm-migemo-mode + #'helm-mm-migemo-string-match #'string-match))) + (if (string-match "\\`!" pattern) + (not (funcall mfn (funcall bfn (substring pattern 1)) + candidate)) + (funcall mfn (funcall bfn pattern) candidate)))) + +(defun helm-buffers--match-from-mjm (candidate) + (let* ((cand (replace-regexp-in-string "^\\s-\\{1\\}" "" candidate)) + (buf (get-buffer cand)) + (regexp (cl-loop with pattern = helm-pattern + for p in (helm-mm-split-pattern pattern) + when (string-match "\\`\\*" p) + return p))) + (if regexp + (when buf + (with-current-buffer buf + (let ((mjm (symbol-name major-mode))) + (helm-buffer--match-mjm regexp mjm)))) + t))) + +(defun helm-buffers--match-from-pat (candidate) + (let* ((regexp-list (cl-loop with pattern = helm-pattern + for p in (helm-mm-split-pattern pattern) + unless (string-match + "\\`\\(\\*\\|/\\|@\\)" p) + collect p)) + (nofuzzy (cdr regexp-list))) + (if regexp-list + (cl-loop for re in regexp-list + always (helm-buffer--match-pattern re candidate nofuzzy)) + t))) + +(defun helm-buffers--match-from-inside (candidate) + (let* ((cand (replace-regexp-in-string "^\\s-\\{1\\}" "" candidate)) + (buf (get-buffer cand)) + (pattern (cl-loop with pat = helm-pattern + for p in (helm-mm-split-pattern pat) + when (string-match "\\`@\\(.*\\)" p) + collect (match-string 1 p) into lst + finally return (mapconcat #'identity lst " "))) + (patterns (helm-mm-3-get-patterns pattern))) + (if (and buf patterns) + (with-current-buffer buf + (save-excursion + (goto-char (point-min)) + (cl-loop for (pred . regexp) in patterns + always + (save-excursion + (funcall + pred + (if helm-migemo-mode + (helm-mm-migemo-forward regexp nil t) + (re-search-forward regexp nil t))))))) + t))) + +(defun helm-buffers--match-from-directory (candidate) + (let* ((cand (replace-regexp-in-string "^\\s-\\{1\\}" "" candidate)) + (buf (get-buffer cand)) + (buf-fname (or (buffer-file-name buf) + (car-safe (rassoc buf dired-buffers)))) + (regexps (cl-loop with pattern = helm-pattern + for p in (helm-mm-split-pattern pattern) + when (string-match "\\`/" p) + collect p))) + (if regexps + (cl-loop for re in regexps + thereis + (and buf-fname + (string-match + (substring re 1) (helm-basedir buf-fname)))) + t))) + +(defun helm-buffers-match-function (candidate) + "Default function to match buffers." + (and (helm-buffers--match-from-pat candidate) + (helm-buffers--match-from-mjm candidate) + (helm-buffers--match-from-inside candidate) + (helm-buffers--match-from-directory candidate))) + + +(defun helm-buffer-query-replace-1 (&optional regexp-flag buffers) + "Query replace in marked buffers. +If REGEXP-FLAG is given use `query-replace-regexp'." + (let ((prompt (if regexp-flag "Query replace regexp" "Query replace")) + (bufs (or buffers (helm-marked-candidates))) + (helm--reading-passwd-or-string t)) + (cl-loop with args = (query-replace-read-args prompt regexp-flag t) + for buf in bufs + do + (save-window-excursion + (switch-to-buffer buf) + (save-excursion + (let ((case-fold-search t)) + (goto-char (point-min)) + (apply #'perform-replace + (list (nth 0 args) (nth 1 args) + t regexp-flag (nth 2 args) nil + multi-query-replace-map)))))))) + +(defun helm-buffer-query-replace-regexp (_candidate) + (helm-buffer-query-replace-1 'regexp)) + +(defun helm-buffer-query-replace (_candidate) + (helm-buffer-query-replace-1)) + +(defun helm-buffer-toggle-diff (candidate) + "Toggle diff buffer CANDIDATE with it's file." + (helm-aif (get-buffer-window "*Diff*" 'visible) + (progn (kill-buffer "*Diff*") + (set-window-buffer it helm-current-buffer)) + ;; Expect the prop at pos 2 because of icon at 1. + (let* ((type (get-text-property 2 'type (helm-get-selection nil 'withprop))) + (buf (helm-aif (get-buffer candidate) + (or (buffer-base-buffer it) it))) + (file (buffer-file-name buf))) + (cl-assert file nil (format "Buffer `%s' is not associated to a file" + (buffer-name buf))) + (if (eq type 'modout) + (diff buf file) ; Buffer modified externally. + (diff file buf))))) ; Buffer modified inside emacs and not saved. + +(helm-make-persistent-command-from-action helm-buffer-diff-persistent + "Toggle diff buffer without quitting helm." + 'diff-action 'helm-buffer-toggle-diff) + +(defun helm-revert-buffer (candidate) + (with-current-buffer candidate + (helm-aif (or (buffer-file-name) + (buffer-file-name (buffer-base-buffer))) + (and (file-exists-p it) (revert-buffer t t))))) + +(defun helm-revert-marked-buffers (_ignore) + (mapc #'helm-revert-buffer (helm-marked-candidates))) + +(defun helm-buffer-revert-and-update (_candidate) + (with-helm-buffer + (let ((marked (helm-marked-candidates)) + (preselect (helm-buffers--quote-truncated-buffer + (helm-get-selection)))) + (cl-loop for buf in marked do (helm-revert-buffer buf)) + (when helm-marked-candidates (helm-unmark-all)) + (helm-force-update preselect)))) + +(helm-make-persistent-command-from-action helm-buffer-revert-persistent + "Revert buffer without quitting helm." + 'revert-action 'helm-buffer-revert-and-update) + +(defun helm-buffer-save-and-update (_candidate) + (with-helm-buffer + (let ((marked (helm-marked-candidates)) + (preselect (helm-get-selection nil t)) + (enable-recursive-minibuffers t)) + (cl-assert marked nil "No buffers need to be saved") + (cl-loop for buf in marked do + (with-current-buffer (get-buffer buf) + (when (or (buffer-file-name) + (buffer-file-name (buffer-base-buffer))) + (save-buffer)))) + (when helm-marked-candidates (helm-unmark-all)) + (helm-force-update (regexp-quote preselect))))) + +(defun helm-buffer-save-some-buffers (_candidate) + (helm-buffers-mark-similar-buffers-1 'mod) + (helm-buffer-save-and-update nil)) + +(helm-make-persistent-command-from-action helm-buffer-run-save-some-buffers + "Save unsaved file buffers without quitting Helm." + 'save-some-action 'helm-buffer-save-some-buffers) + +(helm-make-persistent-command-from-action helm-buffer-save-persistent + "Save buffer without quitting Helm." +'save-action 'helm-buffer-save-and-update) + +(defun helm-buffers-rename-buffer (candidate) + (with-current-buffer candidate + (rename-buffer (helm-read-string "New name: " (buffer-name)) t))) + +(helm-make-command-from-action helm-buffer-run-rename-buffer + "Run rename buffer action from `helm-source-buffers-list'." + 'helm-buffers-rename-buffer) + +(defun helm-switch-to-buffer-at-linum (candidate) + (let ((linum (read-number + "Line number: " + (with-current-buffer candidate + (line-number-at-pos))))) + (switch-to-buffer candidate) + (goto-char (point-min)) + (forward-line (1- linum)))) + +(helm-make-command-from-action helm-buffer-run-goto-line + "Switch to buffer at line number." + 'helm-switch-to-buffer-at-linum) + +(helm-make-persistent-command-from-action helm-buffer-run-kill-persistent + "Kill buffer without quitting Helm." + 'kill-action 'helm-buffers-persistent-kill) + +(defun helm-kill-marked-buffers (_ignore) + (let* ((bufs (helm-marked-candidates)) + (killed-bufs (cl-count-if 'kill-buffer bufs))) + (when (buffer-live-p helm-buffer) + (with-helm-buffer + (setq helm-marked-candidates nil + helm-visible-mark-overlays nil))) + (message "Killed %s buffer(s)" killed-bufs))) + +(helm-make-command-from-action helm-buffer-run-kill-buffers + "Run kill buffer action from `helm-source-buffers-list'." + 'helm-kill-marked-buffers) + +(defun helm-buffer-switch-to-shell (candidate) + (require 'helm-files) + (let ((helm-ff-default-directory + (with-current-buffer candidate + default-directory))) + (helm-ff-switch-to-shell nil))) + +(helm-make-command-from-action helm-buffer-run-switch-to-shell + "Run switch to shell action from helm-buffers-list." + 'helm-buffer-switch-to-shell) + +(helm-make-command-from-action helm-buffer-run-grep + "Run Grep action from `helm-source-buffers-list'." + 'helm-grep-buffers) + +(helm-make-command-from-action helm-buffer-run-zgrep + "Run Zgrep action from `helm-source-buffers-list'." + 'helm-zgrep-buffers) + +(helm-make-command-from-action helm-buffer-run-query-replace-regexp + "Run Query replace regexp action from `helm-source-buffers-list'." +'helm-buffer-query-replace-regexp) + +(helm-make-command-from-action helm-buffer-run-query-replace + "Run Query replace action from `helm-source-buffers-list'." +'helm-buffer-query-replace) + +(helm-make-command-from-action helm-buffer-switch-other-window + "Run switch to other window action from `helm-source-buffers-list'." + 'helm-buffer-switch-buffers-other-window) + +(defun helm-buffer-switch-to-buffer-other-frame (_candidate) + "Display marked buffers in other frame." + (let ((bufs (helm-marked-candidates))) + (select-frame (make-frame)) + (helm-window-show-buffers bufs))) + +(defun helm-buffers-maybe-raise-buffer-frame (candidate) + "Raise buffer frame handling buffer CANDIDATE and switch to it." + (let ((oframe (window-frame (get-buffer-window candidate 0)))) + (unless (eql oframe (selected-frame)) + (raise-frame oframe)) + (with-selected-frame oframe + (switch-to-buffer candidate)))) + +(helm-make-command-from-action helm-buffer-switch-other-frame + "Run switch to other frame action from `helm-source-buffers-list'." + 'helm-buffer-switch-to-buffer-other-frame) + +(defun helm-buffers-switch-buffers-in-tab (_candidate) + "Display marked buffers in a new tab. +See `helm-buffers-switch-buffers-in-tab-1' for more infos." + (helm-buffers-switch-buffers-in-tab-1 (helm-marked-candidates))) + +(helm-make-command-from-action helm-buffers-switch-to-buffer-new-tab + "Run switch to buffer in other tab action from `helm-source-buffers-list'." + 'helm-buffers-switch-buffers-in-tab + (cl-assert (fboundp 'tab-bar-mode) nil "Tab-bar-mode not available")) + +(defun helm-buffer-switch-buffers (_candidate) + "Switch to buffer candidates and replace current buffer. + +If more than one buffer marked switch to these buffers in +separate windows. If a prefix arg is given split windows +vertically." + (let ((buffers (helm-marked-candidates))) + (helm-window-show-buffers buffers))) + +(defun helm-buffer-switch-buffers-other-window (_candidate) + "Switch to marked buffers in other windows." + (let ((buffers (helm-marked-candidates))) + (helm-window-show-buffers buffers t))) + +(helm-make-command-from-action helm-buffer-run-ediff + "Run ediff action from `helm-source-buffers-list'." + 'helm-ediff-marked-buffers) + +(helm-make-command-from-action helm-buffer-run-ediff-merge + "Run ediff action from `helm-source-buffers-list'." + 'helm-ediff-marked-buffers-merge) + +(defun helm-buffers-persistent-kill-1 (buffer-or-name) + "Persistent action to kill buffer." + (let ((buf (get-buffer buffer-or-name)) helm-buf-or-cur) + (if (or (and (eql buf (get-buffer helm-current-buffer)) + (setq helm-buf-or-cur "helm-current-buffer")) + (and (eql buf (get-buffer helm-buffer)) + (setq helm-buf-or-cur "helm-buffer"))) + (progn + (message "Can't kill `%s' without quitting session" helm-buf-or-cur) + (sit-for 1)) + (kill-buffer buf) + (helm-delete-current-selection)))) + +(defun helm-buffers--quote-truncated-buffer (buffer) + "Quote the truncated buffer-name of BUFFER. +buffer-name is truncated according to `helm-buffer-max-length' minus the length +of icon if one." + (let ((bufname (and (bufferp buffer) + (buffer-name buffer))) + (maxlen (if helm-buffers-show-icons + (- helm-buffer-max-length 2) + helm-buffer-max-length))) + (when (and bufname + (file-remote-p (with-current-buffer bufname + default-directory))) + (setq bufname (concat "@ " (helm-url-unhex-string bufname)))) + (when bufname + (regexp-quote + (if (and helm-buffer-max-length + helm-buffer-details-flag) + (helm-substring-by-width bufname maxlen "") + bufname))))) + +(defun helm-buffers-persistent-kill (_buffer) + (let* ((marked (helm-marked-candidates)) + (msg "Buffer `%s' modified, please save it before kill") + ;; After marking, selection should be after the last marked unless user + ;; has not moved, if deleting current, use current selection after + ;; having deleted. + (sel (and (cdr marked) (helm-get-selection)))) + (with-helm-buffer + (unwind-protect + (dolist (b marked) + (if (and (buffer-file-name b) (buffer-modified-p b)) + (progn (message msg (buffer-name b)) (sit-for 1)) + ;; We need to preselect each marked because + ;; helm-buffers-persistent-kill-1 is deleting + ;; current selection. + (helm-preselect + (format "^[[:multibyte:] ]*%s" + (helm-buffers--quote-truncated-buffer b))) + (helm-buffers-persistent-kill-1 b) + (helm--remove-marked-and-update-mode-line b))) + (setq helm-marked-candidates nil + helm-visible-mark-overlays nil)) + (helm-force-update (format "^[[:multibyte:] ]*%s" + (helm-buffers--quote-truncated-buffer + ;; Ensure user has not moved selection on one + ;; of marked. + (or (and (buffer-live-p sel) sel) + (helm-get-selection)))))))) + +(defun helm-buffers-list-persistent-action (candidate) + (let ((current (window-buffer helm-persistent-action-display-window))) + (if (or (helm-follow-mode-p) + (eql current (get-buffer helm-current-buffer)) + (not (eql current (get-buffer candidate)))) + (display-buffer candidate) + (if (and helm-persistent-action-display-window + (window-dedicated-p + (next-window helm-persistent-action-display-window 1))) + (delete-window helm-persistent-action-display-window) + (switch-to-buffer helm-current-buffer))))) + +(defun helm-ediff-marked-buffers (_candidate &optional merge) + "Ediff 2 marked buffers or CANDIDATE and `helm-current-buffer'. +With optional arg MERGE call `ediff-merge-buffers'." + (let* ((mkd (helm-marked-candidates)) + (lg-lst (length mkd)) + buf1 buf2) + (cl-case lg-lst + (0 + (error "Error:You have to mark at least 1 buffer")) + (1 + (setq buf1 helm-current-buffer + buf2 (cl-first mkd))) + (2 + (setq buf1 (cl-first mkd) + buf2 (cl-second mkd))) + (t + (error "Error:Too many buffers marked!"))) + (if merge + (ediff-merge-buffers buf1 buf2) + (ediff-buffers buf1 buf2)))) + +(defun helm-ediff-marked-buffers-merge (candidate) + "Ediff merge `helm-current-buffer' with CANDIDATE. +See `helm-ediff-marked-buffers'." + (helm-ediff-marked-buffers candidate t)) + +(defun helm-multi-occur-as-action (_candidate) + "Multi occur action for `helm-source-buffers-list'. +Can be used by any source that list buffers." + (let ((helm-occur-always-search-in-current + (if helm-current-prefix-arg + (not helm-occur-always-search-in-current) + helm-occur-always-search-in-current)) + (buffers (helm-marked-candidates)) + (input (cl-loop for i in (split-string (or (buffer-local-value + 'helm-input-local + (get-buffer helm-buffer)) + helm-pattern) + " " t) + thereis (and (string-match "\\`@\\([^!]*\\)" i) + (match-string 1 i))))) + (helm-multi-occur-1 buffers input))) + +(helm-make-command-from-action helm-buffers-run-occur + "Run `helm-multi-occur-as-action' by key." + 'helm-multi-occur-as-action) + +(defun helm-buffers-toggle-show-hidden-buffers () + (interactive) + (with-helm-alive-p + (let ((filter-attrs (helm-get-attr 'filtered-candidate-transformer + helm-source-buffers-list)) + (sel (helm-get-selection))) + (if (memq 'helm-shadow-boring-buffers filter-attrs) + (helm-set-attr 'filtered-candidate-transformer + (cons 'helm-skip-boring-buffers + (remove 'helm-shadow-boring-buffers + filter-attrs)) + helm-source-buffers-list) + (helm-set-attr 'filtered-candidate-transformer + (cons 'helm-shadow-boring-buffers + (remove 'helm-skip-boring-buffers + filter-attrs)) + helm-source-buffers-list)) + (helm-force-update (helm-buffers--quote-truncated-buffer sel))))) +(put 'helm-buffers-toggle-show-hidden-buffers 'helm-only t) + +(defun helm-buffers-browse-project (buf) + "Browse project from buffer BUF." + (with-current-buffer buf + (helm-browse-project helm-current-prefix-arg))) + +(helm-make-command-from-action helm-buffers-run-browse-project + "Run `helm-buffers-browse-project' from key." + 'helm-buffers-browse-project + (cl-assert (not helm-buffers-in-project-p) + nil "You are already browsing this project")) + +;;;###autoload +(defun helm-buffers-quit-and-find-file-fn (source) + (let* ((sel (get-buffer (helm-get-selection nil nil source))) + (bname (and (bufferp sel) (buffer-name sel)))) + (when bname + (or (buffer-file-name sel) + (car (rassoc bname dired-buffers)) + (and (with-current-buffer bname + (eq major-mode 'org-agenda-mode)) + org-directory + (expand-file-name org-directory)) + (with-current-buffer bname + (expand-file-name default-directory)))))) + +;;; Candidate Transformers +;; +;; +(defun helm-skip-boring-buffers (buffers _source) + "Remove buffers matching `helm-boring-buffer-regexp-list' in BUFFERS. +Where BUFFERS is a list of buffer names." + (helm-skip-entries buffers + helm-boring-buffer-regexp-list + helm-white-buffer-regexp-list)) + +(defun helm-shadow-boring-buffers (buffers _source) + "Buffers matching `helm-boring-buffer-regexp' will be +displayed with the `file-name-shadow' face if available." + (helm-shadow-entries buffers helm-boring-buffer-regexp-list)) + + +;;;###autoload +(defun helm-buffers-list () + "Preconfigured `helm' to list buffers." + (interactive) + (unless helm-source-buffers-list + (setq helm-source-buffers-list + (helm-make-source "Buffers" 'helm-source-buffers))) + (helm :sources '(helm-source-buffers-list + helm-source-buffer-not-found) + :buffer "*helm buffers*" + :truncate-lines helm-buffers-truncate-lines + :left-margin-width helm-buffers-left-margin-width)) + +;;;###autoload +(defun helm-mini () + "Preconfigured `helm' displaying `helm-mini-default-sources'." + (interactive) + (require 'helm-x-files) + (unless helm-source-buffers-list + (setq helm-source-buffers-list + (helm-make-source "Buffers" 'helm-source-buffers))) + (helm :sources helm-mini-default-sources + :buffer "*helm mini*" + :ff-transformer-show-only-basename nil + :truncate-lines helm-buffers-truncate-lines + :left-margin-width helm-buffers-left-margin-width)) + +(defun helm-quit-and-helm-mini () + "Drop into `helm-mini' from `helm'." + (interactive) + (with-helm-alive-p + (helm-run-after-exit 'helm-mini))) + +(provide 'helm-buffers) + +;;; helm-buffers.el ends here diff --git a/elpa/helm-20260424.1357/helm-color.el b/elpa/helm-20260424.1357/helm-color.el new file mode 100644 index 00000000..cda00dde --- /dev/null +++ b/elpa/helm-20260424.1357/helm-color.el @@ -0,0 +1,158 @@ +;;; helm-color.el --- colors and faces -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2026 Thierry Volpiatto + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Code: +(require 'cl-lib) +(require 'helm) +(require 'helm-help) +(require 'helm-elisp) + +(declare-function list-colors-display "facemenu") + +;;; Customize Face +;; +;; +(defun helm-custom-faces-init () + "Initialize buffer for `helm-source-customize-face'." + (save-selected-window + (list-faces-display) + (message nil)) + (helm-init-candidates-in-buffer + 'global + (with-current-buffer (get-buffer "*Faces*") + (buffer-substring + (next-single-char-property-change (point-min) 'category) + (point-max)))) + (kill-buffer "*Faces*")) + +(defvar helm-source-customize-face + (helm-build-in-buffer-source "Customize Face" + :init 'helm-custom-faces-init + :get-line 'buffer-substring + :persistent-action (lambda (candidate) + (helm-elisp--persistent-help + (intern (car (split-string candidate))) + 'helm-describe-face)) + :persistent-help "Describe face" + :action `(("Customize" + . ,(lambda (line) + (customize-face (intern (car (split-string line)))))) + ("Copy name" + . ,(lambda (line) + (kill-new (car (split-string line " " t))))))) + "See (info \"(emacs)Faces\")") + +;;; Colors browser +;; +;; +(defun helm-colors-init () + (require 'facemenu) + (unless (helm-candidate-buffer) + (save-selected-window + (list-colors-display) + (message nil)) + (helm-init-candidates-in-buffer + 'global + (with-current-buffer (get-buffer "*Colors*") + (buffer-string))) + (kill-buffer "*Colors*"))) + +(defun helm-color-insert-name (candidate) + (with-helm-current-buffer + (insert (helm-colors-get-name candidate)))) + +(defun helm-color-kill-name (candidate) + (kill-new (helm-colors-get-name candidate))) + +(defun helm-color-insert-rgb (candidate) + (with-helm-current-buffer + (insert (helm-colors-get-rgb candidate)))) + +(defun helm-color-kill-rgb (candidate) + (kill-new (helm-colors-get-rgb candidate))) + +(helm-make-command-from-action helm-color-run-insert-name + "Insert name of color from `helm-source-colors'." + 'helm-color-insert-name) + +(helm-make-command-from-action helm-color-run-kill-name + "Kill name of color from `helm-source-colors'." + 'helm-color-kill-name) + +(helm-make-command-from-action helm-color-run-insert-rgb + "Insert RGB of color from `helm-source-colors'." + 'helm-color-insert-rgb) + +(helm-make-command-from-action helm-color-run-kill-rgb + "Kill RGB of color from `helm-source-colors'." + 'helm-color-kill-rgb) + +(defvar helm-color-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (define-key map (kbd "C-c n") #'helm-color-run-insert-name) + (define-key map (kbd "C-c N") #'helm-color-run-kill-name) + (define-key map (kbd "C-c r") #'helm-color-run-insert-rgb) + (define-key map (kbd "C-c R") #'helm-color-run-kill-rgb) + map)) + +(defvar helm-source-colors + (helm-build-in-buffer-source "Colors" + :init 'helm-colors-init + :get-line 'buffer-substring + :keymap helm-color-map + :persistent-help "Kill entry in RGB format." + :persistent-action 'helm-color-kill-rgb + :help-message 'helm-colors-help-message + :action + '(("Copy Name (C-c N)" . helm-color-kill-name) + ("Copy RGB (C-c R)" . helm-color-kill-rgb) + ("Insert Name (C-c n)" . helm-color-insert-name) + ("Insert RGB (C-c r)" . helm-color-insert-rgb)))) + +(defun helm-colors-get-name (candidate) + "Get color name." + (replace-regexp-in-string + " " "" + (with-temp-buffer + (insert (capitalize candidate)) + (goto-char (point-min)) + (search-forward-regexp "\\s-\\{2,\\}") + (delete-region (point) (point-max)) + (buffer-string)))) + +(defun helm-colors-get-rgb (candidate) + "Get color RGB." + (replace-regexp-in-string + " " "" + (with-temp-buffer + (insert (capitalize candidate)) + (goto-char (point-max)) + (search-backward-regexp "\\s-\\{2,\\}") + (delete-region (point) (point-min)) + (buffer-string)))) + +;;;###autoload +(defun helm-colors () + "Preconfigured `helm' for color." + (interactive) + (helm :sources '(helm-source-colors helm-source-customize-face) + :buffer "*helm colors*")) + +(provide 'helm-color) + +;;; helm-color.el ends here diff --git a/elpa/helm-20260424.1357/helm-command.el b/elpa/helm-20260424.1357/helm-command.el new file mode 100644 index 00000000..3b3c3851 --- /dev/null +++ b/elpa/helm-20260424.1357/helm-command.el @@ -0,0 +1,477 @@ +;;; helm-command.el --- Helm execute-exended-command. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2026 Thierry Volpiatto + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Code: + +(require 'cl-lib) +(require 'helm) +(require 'helm-help) +(require 'helm-mode) +(require 'helm-elisp) + + +(defvar helm-M-x-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-comp-read-map) + (define-key map (kbd "C-u") nil) + (define-key map (kbd "C-u") #'helm-M-x-universal-argument) + (define-key map (kbd "C-]") #'helm-M-x-toggle-short-doc) + map)) + + +(defgroup helm-command nil + "Emacs command related Applications and libraries for Helm." + :group 'helm) + +(defcustom helm-M-x-always-save-history nil + "`helm-M-x' save command in `extended-command-history' even when it fails." + :type 'boolean) + +(defcustom helm-M-x-reverse-history nil + "The history source of `helm-M-x' appear in second position when non-nil." + :type 'boolean) + +(defcustom helm-M-x-fuzzy-match t + "Helm-M-x fuzzy matching when non nil." + :type 'boolean) + +(defcustom helm-M-x-show-short-doc nil + "Show short docstring of command when non nil. +This value can be toggled with +\\\\[helm-M-x-toggle-short-doc] while in helm-M-x session." + :type 'boolean) + +(defcustom helm-M-x-history-transformer-sort t + "When nil, do not sort helm-M-x's commands history." + :type 'boolean) + +(defcustom helm-M-x-exclude-unusable-commands-in-mode t + "When non nil exclude commands not usable in current buffer. +This will exclude only commands defined with `interactive' MODES argument, for +other commands, they will be displayed even if unusable as long as they satisfies +`commandp'. +NOTE: As `interactive' MODES argument is relatively recent, not all commands are +using it when they should, so do not expect ALL unuseful commands to be excluded +in `helm-M-x'. Also in Emacsen with a version of `interactive' not handling +MODES, this will have no effect. Regardless of this Helm commands unrelated to +Helm will never appear in `helm-M-x' whatever the value of this var is." + :type 'boolean) + +;;; Faces +;; +;; +(defgroup helm-command-faces nil + "Customize the appearance of helm-command." + :prefix "helm-" + :group 'helm-command + :group 'helm-faces) + +(defface helm-M-x-key + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :foreground "orange" :box (:line-width -1))) + "Face used in helm-M-x to show keybinding." + :group 'helm-command-faces) + +(defface helm-command-major-active-mode + '((t :inherit font-lock-builtin-face)) + "Face used by `helm-M-x' for activated major modes." + :group 'helm-command-faces) + +(defface helm-command-minor-active-mode + '((t :inherit font-lock-type-face)) + "Face used by `helm-M-x' for activated minor modes." + :group 'helm-command-faces) + +(defface helm-command-debug-active + '((t :inherit font-lock-warning-face)) + "Face used by `helm-M-x' for activated toggle-debug-on-* commands." + :group 'helm-command-faces) + +(defface helm-M-x-short-doc + '((t :box (:line-width -1) :foreground "DimGray")) + "Face used by `helm-M-x' for short docstring." + :group 'helm-command-faces) + +(defvar helm-M-x-input-history nil) +(defvar helm-M-x-prefix-argument nil + "Prefix argument before calling `helm-M-x'.") +(defvar helm-M-x--timer nil) +(defvar helm-M-x--unwind-forms-done nil) + +(defun helm-M-x-get-major-mode-command-alist (mode-map) + "Return alist of MODE-MAP." + (when mode-map + (cl-loop for key being the key-seqs of mode-map using (key-bindings com) + for str-key = (key-description key) + for ismenu = (string-match "" str-key) + unless ismenu collect (cons str-key com)))) + +(defun helm-get-mode-map-from-mode (mode) + "Guess the mode-map name according to MODE. +Some modes don't use conventional mode-map name so we need to +guess mode-map name. E.g. `python-mode' ==> py-mode-map. +Return nil if no mode-map found." + (cl-loop ;; Start with a conventional mode-map name. + with mode-map = (intern-soft (format "%s-map" mode)) + with mode-string = (symbol-name mode) + with mode-name = (replace-regexp-in-string "-mode" "" mode-string) + while (not mode-map) + for count downfrom (length mode-name) + ;; Return when no result after parsing entire string. + when (eq count 0) return nil + for sub-name = (substring mode-name 0 count) + do (setq mode-map (intern-soft (format "%s-map" (concat sub-name "-mode")))) + finally return mode-map)) + +(defun helm-M-x-current-mode-map-alist () + "Return mode-map alist of current `major-mode'." + (let ((map-sym (helm-get-mode-map-from-mode major-mode))) + (when (and map-sym (boundp map-sym)) + (helm-M-x-get-major-mode-command-alist (symbol-value map-sym))))) + +(defun helm-M-x-toggle-short-doc () + "Toggle short doc display in helm-M-x." + (interactive) + (setq helm-M-x-show-short-doc (not helm-M-x-show-short-doc)) + (helm-force-update (concat "^" (helm-get-selection)) (helm-get-current-source))) +(put 'helm-M-x-toggle-short-doc 'no-helm-mx t) + +(defun helm-M-x-transformer-1 (candidates &optional sort ignore-props) + "Transformer function to show bindings in emacs commands. +Show global bindings and local bindings according to current +`major-mode'. +If SORT is non nil sort list with `helm-generic-sort-fn'. +Note that SORT should not be used when fuzzy matching because +fuzzy matching is running its own sort function with a different +algorithm." + (with-helm-current-buffer + (cl-loop with local-map = (helm-M-x-current-mode-map-alist) + for cand in candidates + for local-key = (car (rassq cand local-map)) + for key = (substitute-command-keys (format "\\[%s]" cand)) + for sym = (intern (if (consp cand) (car cand) cand)) + for doc = (when helm-M-x-show-short-doc + (helm-get-first-line-documentation (intern-soft cand))) + for disp = (cond ((eq sym major-mode) + (propertize cand 'face 'helm-command-major-active-mode)) + ((and (memq sym minor-mode-list) + (boundp sym) + (buffer-local-value + sym helm-current-buffer)) + (propertize cand 'face 'helm-command-minor-active-mode)) + ((or (and (eq sym 'toggle-debug-on-error) + debug-on-error) + (and (eq sym 'toggle-debug-on-quit) + debug-on-quit)) + (propertize cand 'face 'helm-command-debug-active)) + (t cand)) + unless (and (null ignore-props) + (or (get sym 'helm-only) (get sym 'no-helm-mx) + (eq sym 'helm-M-x))) + collect + (cons (cond ((and (string-match "^M-x" key) local-key) + (propertize + (format "%s%s%s %s" + disp + (if doc (helm-make-separator cand) "") + (if doc + (propertize + doc 'face 'helm-M-x-short-doc) + "") + (propertize + " " 'display + (propertize local-key 'face 'helm-M-x-key))) + 'match-part disp)) + ((and (string-match "^M-x" key) + (not (string= key "M-x"))) + (propertize + (format "%s%s%s" + disp + (if doc (helm-make-separator cand) "") + (if doc + (propertize + doc 'face 'helm-M-x-short-doc) + "")) + 'match-part disp)) + (t (propertize + (format "%s%s%s %s" + disp + (if doc (helm-make-separator cand) "") + (if doc + (propertize + doc 'face 'helm-M-x-short-doc) + "") + (propertize + " " 'display + (propertize key 'face 'helm-M-x-key))) + 'match-part disp))) + cand) + into ls + finally return + (if sort (sort ls #'helm-generic-sort-fn) ls)))) + +(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-no-sort (candidates _source) + "Transformer function for `helm-M-x' candidates." + (helm-M-x-transformer-1 candidates)) + +(defun helm-M-x-transformer-no-sort-no-props (candidates _source) + "Transformer function for `helm-M-x' candidates." + (helm-M-x-transformer-1 candidates nil t)) + +(defun helm-M-x--notify-prefix-arg () + ;; Notify a prefix-arg set AFTER calling M-x. + (when prefix-arg + (with-helm-window + (helm-display-mode-line (helm-get-current-source) 'force)))) + +(defun helm-cmd--get-current-function-name () + (save-excursion + (beginning-of-defun) + (cadr (split-string (buffer-substring-no-properties + (pos-bol) (pos-eol)))))) + +(defun helm-cmd--get-preconfigured-commands (&optional dir) + (let* ((helm-dir (or dir (helm-basedir (locate-library "helm")))) + (helm-autoload-file (expand-file-name "helm-autoloads.el" helm-dir)) + results) + (when (file-exists-p helm-autoload-file) + (with-temp-buffer + (insert-file-contents helm-autoload-file) + (while (re-search-forward "Preconfigured" nil t) + (push (substring (helm-cmd--get-current-function-name) 1) results)))) + results)) + +(defun helm-M-x-universal-argument () + "Same as `universal-argument' but for `helm-M-x'." + (interactive) + (if helm-M-x-prefix-argument + (progn (setq helm-M-x-prefix-argument nil) + (let ((inhibit-read-only t)) + (with-selected-window (minibuffer-window) + (save-excursion + (goto-char (point-min)) + (delete-char (- (minibuffer-prompt-width) (length "M-x ")))))) + (message "Initial prefix arg disabled")) + (setq prefix-arg (list 4)) + (universal-argument--mode))) +(put 'helm-M-x-universal-argument 'helm-only t) + +(defun helm-M-x-persistent-action (candidate) + (helm-elisp--persistent-help + candidate 'helm-describe-function)) + +(defun helm-M-x--move-selection-after-hook () + (setq current-prefix-arg nil)) + +(defun helm-M-x--before-action-hook () + (remove-hook 'helm-move-selection-after-hook + #'helm-M-x--move-selection-after-hook)) + +(defclass helm-M-x-class (helm-source-in-buffer helm-type-command) + ((requires-pattern :initform 0) + (must-match :initform t) + (filtered-candidate-transformer :initform #'helm-M-x-transformer) + (persistent-help :initform "Describe this command") + (help-message :initform 'helm-M-x-help-message) + (nomark :initform t) + (cleanup :initform #'helm-M-x--unwind-forms) + (keymap :initform 'helm-M-x-map) + (resume :initform 'helm-M-x-resume-fn))) + +(defun helm-M-x-resume-fn () + (when (and helm-M-x--timer (timerp helm-M-x--timer)) + (cancel-timer helm-M-x--timer) + (setq helm-M-x--timer nil)) + (setq helm-M-x--timer (run-at-time 1 0.1 #'helm-M-x--notify-prefix-arg)) + (setq helm--mode-line-display-prefarg t) + ;; Prevent displaying a wrong prefix arg when helm-resume is called + ;; from prefix arg. + (setq current-prefix-arg nil)) + +(defun helm-M-x-read-extended-command (collection &optional predicate history) + "Read or execute action on command name in COLLECTION or HISTORY. + +Helm completion is not provided when executing or defining kbd macros. + +Arg COLLECTION should be an `obarray'. +Arg PREDICATE is a function that default to `commandp'. +Arg HISTORY default to `extended-command-history'." + (setq helm--mode-line-display-prefarg t) + (let* ((pred (or predicate #'commandp)) + (helm-fuzzy-sort-fn (lambda (candidates _source) + (if helm-M-x-history-transformer-sort + ;; Sort on real candidate otherwise + ;; "symbol ()" is used when sorting. + (helm-fuzzy-matching-default-sort-fn-1 candidates t) + candidates))) + (sources `(,(helm-make-source "Emacs Commands history" 'helm-M-x-class + :data (lambda () + (helm-comp-read-get-candidates + ;; History should be quoted to + ;; force `helm-comp-read-get-candidates' + ;; to use predicate against + ;; symbol and not string. + (or history 'extended-command-history) + ;; Ensure using empty string to + ;; not defeat helm matching fns [1] + pred nil nil "")) + :filtered-candidate-transformer + (if helm-M-x-history-transformer-sort + #'helm-M-x-transformer + #'helm-M-x-transformer-no-sort) + :fuzzy-match helm-M-x-fuzzy-match) + ,(helm-make-source "Emacs Commands" 'helm-M-x-class + :data (lambda () + (helm-comp-read-get-candidates + ;; [1] Same comment as above. + collection pred nil nil "")) + :fuzzy-match helm-M-x-fuzzy-match))) + (prompt (concat (helm-acase helm-M-x-prefix-argument + (- "-") + ;; Why &rest? isn't this always a list of one arg? + ((dst* (l &rest args)) + (if (eq l 4) "C-u " (format "%d " l))) + ((guard* (integerp it)) (format "%d " it))) + "M-x "))) + (setq helm-M-x--timer (run-at-time 1 0.1 #'helm-M-x--notify-prefix-arg)) + ;; Fix Bug#2250, add `helm-move-selection-after-hook' which + ;; reset prefix arg to nil only for this helm session. + (add-hook 'helm-move-selection-after-hook + #'helm-M-x--move-selection-after-hook) + (add-hook 'helm-before-action-hook + #'helm-M-x--before-action-hook) + (when (and sources helm-M-x-reverse-history) + (setq sources (nreverse sources))) + (unwind-protect + (progn + (setq current-prefix-arg nil) + (helm :sources sources + :prompt prompt + :buffer "*helm M-x*" + :history 'helm-M-x-input-history + :truncate-lines t)) + (helm-M-x--unwind-forms)))) + +;; When running a command involving again helm from helm-M-x, the +;; unwind-protect UNWINDS forms are executed only once this helm +;; command exit leaving the helm-M-x timer running and other variables +;; and hooks not unset, so the timer is now in a global var and all +;; the forms that should normally run in unwind-protect are running as +;; well as soon as helm-M-x-execute-command is called. +(defun helm-M-x--unwind-forms (&optional done) + ;; helm-M-x--unwind-forms-done is non nil when it have been called + ;; once from helm-M-x-execute-command. + (unless helm-M-x--unwind-forms-done + (when (timerp helm-M-x--timer) + (cancel-timer helm-M-x--timer) + (setq helm-M-x--timer nil)) + (setq helm--mode-line-display-prefarg nil + helm-fuzzy-sort-fn (default-toplevel-value 'helm-fuzzy-sort-fn)) + ;; Be sure to remove it here as well in case of quit. + (remove-hook 'helm-move-selection-after-hook + #'helm-M-x--move-selection-after-hook) + (remove-hook 'helm-before-action-hook + #'helm-M-x--before-action-hook)) + ;; Reset helm-M-x--unwind-forms-done to nil when DONE is + ;; unspecified. + (setq helm-M-x--unwind-forms-done done)) + +(defun helm-M-x-execute-command (command) + "Execute COMMAND as an editor command. +COMMAND must be a symbol that satisfies the `commandp' predicate. +Save COMMAND to `extended-command-history'." + (helm-M-x--unwind-forms t) + (when command + ;; Avoid having `this-command' set to *exit-minibuffer. + (setq this-command command + ;; Handle C-x z (repeat) Bug#322 + real-this-command command) + ;; If helm-M-x is called with regular emacs completion (kmacro) + ;; use the value of arg otherwise use helm-current-prefix-arg. + (let ((prefix-arg (or helm-current-prefix-arg helm-M-x-prefix-argument)) + (command-name (symbol-name command))) + (condition-case-unless-debug err + (progn + (command-execute command 'record) + (add-to-history 'extended-command-history command-name)) + (error + (when helm-M-x-always-save-history + (add-to-history 'extended-command-history command-name)) + (signal (car err) (cdr err))))))) + +(defun helm-M-x--vanilla-M-x () + (helm-M-x-execute-command + (intern-soft + (if helm-mode + (unwind-protect + (progn + (helm-mode -1) + (read-extended-command)) + (helm-mode 1)) + (read-extended-command))))) + +(defun helm-M-x--mode-predicate (symbol mj-mode lmm-modes) + "Check if SYMBOL is suitable for current buffer. +MJ-MODE is used to pass major-mode and LMM-MODES to pass local-minor-modes. +This predicate honors commands defined with the `interactive' MODES argument." + (let* ((sym (helm-symbolify symbol)) + (modes (command-modes sym))) + (and (commandp sym) + (if modes + (or (memq mj-mode modes) + (cl-loop for m in modes thereis + (or (memq m lmm-modes) + (memq m global-minor-modes)))) + t)))) + +;;;###autoload +(defun helm-M-x (_arg) + "Preconfigured `helm' for Emacs commands. +It is `helm' replacement of regular `M-x' +`execute-extended-command'. + +Unlike regular `M-x' Emacs vanilla `execute-extended-command' +command, the prefix args if needed, can be passed AFTER starting +`helm-M-x'. When a prefix arg is passed BEFORE starting +`helm-M-x', the first `C-u' while in `helm-M-x' session will +disable it. + +You can get help on each command by persistent action." + (interactive + (progn + (setq helm-M-x-prefix-argument current-prefix-arg) + (list current-prefix-arg))) + (if (or defining-kbd-macro executing-kbd-macro) + (helm-M-x--vanilla-M-x) + (let ((lmm-modes (and (boundp 'local-minor-modes) ; Only 28+ (issue#2719) + (buffer-local-value 'local-minor-modes (current-buffer)))) + (mj-mode major-mode)) + (helm-M-x-read-extended-command + obarray (if (and (fboundp 'command-modes) + helm-M-x-exclude-unusable-commands-in-mode) + (lambda (sym) (helm-M-x--mode-predicate sym mj-mode lmm-modes)) + #'commandp))))) +(put 'helm-M-x 'interactive-only 'command-execute) + +(provide 'helm-command) + +;;; helm-command.el ends here diff --git a/elpa/helm-20260424.1357/helm-dabbrev.el b/elpa/helm-20260424.1357/helm-dabbrev.el new file mode 100644 index 00000000..5395416b --- /dev/null +++ b/elpa/helm-20260424.1357/helm-dabbrev.el @@ -0,0 +1,388 @@ +;;; helm-dabbrev.el --- Helm implementation of dabbrev. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2026 Thierry Volpiatto + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Code: + +(require 'helm) +(require 'helm-lib) +(require 'helm-help) +(require 'helm-elisp) ; For show-completion. + +(defgroup helm-dabbrev nil + "Dabbrev related Applications and libraries for Helm." + :group 'helm) + +(defcustom helm-dabbrev-always-search-all t + "Always search in all buffers when non--nil. +Note that even if nil, a search in all buffers will occur if the +length of candidates is <= than +`helm-dabbrev-max-length-result'." + :type 'boolean) + +(defcustom helm-dabbrev-candidates-number-limit 1000 + "Maximum number of candidates to collect. + +The higher this number is, the slower the computation of +candidates will be. You can use safely a higher value with +emacs-26+. +Note that this have nothing to do with +`helm-candidate-number-limit', this means that computation of +candidates stop when this value is reached but only +`helm-candidate-number-limit' candidates are displayed in the +Helm buffer." + :type 'integer) + +(defcustom helm-dabbrev-ignored-buffers-regexps + '("\\*helm" "\\*Messages" "\\*Echo Area" "\\*Buffer List") + "List of regexps matching names of buffers that `helm-dabbrev' should not check." + :type '(repeat regexp)) + +(defcustom helm-dabbrev-related-buffer-fn #'helm-dabbrev--same-major-mode-p + "A function that decide if a buffer to search in its related to `current-buffer'. + +This is currently determined by comparing `major-mode' of the +buffer to search and the `current-buffer'. + +The function take one arg, the buffer which is current, look at +`helm-dabbrev--same-major-mode-p' for an example. + +When nil all buffers are considered related to `current-buffer'." + :type 'function) + +(defcustom helm-dabbrev-major-mode-assoc nil + "Major mode association alist. + +This allow helm-dabbrev searching in buffers with the associated +`major-mode'. +E.g. (emacs-lisp-mode . lisp-interaction-mode) + +will allow searching in the lisp-interaction-mode buffer when +`current-buffer' is an `emacs-lisp-mode' buffer and vice versa +i.e. no need to provide (lisp-interaction-mode . +emacs-lisp-mode) association. + +When nil check is the searched buffer has same `major-mode' than +the `current-buffer'. + +This has no effect when `helm-dabbrev-related-buffer-fn' is nil +or of course bound to a function that doesn't handle this var." + :type '(alist :key-type symbol :value-type symbol)) + +(defcustom helm-dabbrev-lineno-around 30 + "Search first in this number of lines before and after point." + :type 'integer) + +(defcustom helm-dabbrev-cycle-threshold 5 + "Number of time helm-dabbrev cycle before displaying helm completion. +When nil or 0 disable cycling." + :type '(choice (const :tag "Cycling disabled" nil) integer)) + +(defcustom helm-dabbrev-case-fold-search 'smart + "Set `case-fold-search' in `helm-dabbrev'. +Same as `helm-case-fold-search' but for `helm-dabbrev'. +Note that this is not affecting searching in Helm buffer, but the +initial search for all candidates in buffer(s)." + :type '(choice (const :tag "Ignore case" t) + (const :tag "Respect case" nil) + (other :tag "Smart" smart))) + +(defvaralias 'helm-dabbrev--regexp 'helm-dabbrev-separator-regexp) +(make-obsolete-variable 'helm-dabbrev--regexp + 'helm-dabbrev-separator-regexp "2.8.3") +;; Check for beginning of line should happen last (^\n\\|^). +(defvar helm-dabbrev-separator-regexp + "\\s-\\|\t\\|[(\\[\\{\"'`=<>$;,@.#+]\\|\\s\\\\|^\n\\|^" + "Regexp matching the start of a dabbrev candidate.") + + +(defvar helm-dabbrev-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (define-key map (kbd "M-/") #'helm-next-line) + (define-key map (kbd "M-:") #'helm-previous-line) + map)) + +;; Internal +(defvar helm-dabbrev--cache nil) +(defvar helm-dabbrev--data nil) +(cl-defstruct helm-dabbrev-info dabbrev limits iterator) +(defvar helm-dabbrev--already-tried nil) +(defvar helm-dabbrev--computing-cache nil + "[INTERNAL] Flag to notify helm-dabbrev is blocked. +Do nothing when non nil.") + +(defun helm-dabbrev--buffer-list () + (cl-loop for buf in (buffer-list) + unless (cl-loop for r in helm-dabbrev-ignored-buffers-regexps + thereis (string-match r (buffer-name buf))) + collect buf)) + +(defun helm-dabbrev--same-major-mode-p (start-buffer) + "Decide if current-buffer is related to START-BUFFER." + (helm-same-major-mode-p start-buffer helm-dabbrev-major-mode-assoc)) + +(defun helm-dabbrev--collect (str limit ignore-case all) + (let* ((case-fold-search ignore-case) + (buffer1 (current-buffer)) ; start buffer. + (minibuf (minibufferp buffer1)) + results pos-before pos-after) + (catch 'break + (dolist (buf (if all (helm-dabbrev--buffer-list) + (list (current-buffer)))) + (with-current-buffer buf + (when (or minibuf ; check against all buffers when in minibuffer. + (if helm-dabbrev-related-buffer-fn + (funcall helm-dabbrev-related-buffer-fn buffer1) + t)) + (save-excursion + ;; Start searching before thing before point. + (goto-char (- (point) (length str))) + ;; Search the last 30 lines BEFORE point and set POS-BEFORE. + (cl-multiple-value-bind (res _pa pb) + (helm-dabbrev--search-and-store str -2 limit results) + (setq results res + ;; No need to set POS-AFTER here. + pos-before pb))) + (save-excursion + ;; Search the next 30 lines AFTER point and set POS-AFTER. + (cl-multiple-value-bind (res pa _pb) + (helm-dabbrev--search-and-store str 2 limit results) + (setq results res + ;; No need to set POS-BEFORE, we keep the last + ;; value found. + pos-after pa))) + (save-excursion + ;; Search all BEFORE point maybe starting from + ;; POS-BEFORE to not search again what previously found. + ;; If limit is reached in previous call of + ;; `helm-dabbrev--search-and-store' POS-BEFORE is nil and + ;; goto-char will fail, so check it. + (when pos-before (goto-char pos-before)) + (cl-multiple-value-bind (res _pa _pb) + (helm-dabbrev--search-and-store str -1 limit results) + ;; No need to set POS-BEFORE and POS-AFTER here. + (setq results res))) + (save-excursion + ;; Search all AFTER point maybe starting from POS-AFTER. + ;; Same comment as above for POS-AFTER. + (when pos-after (goto-char pos-after)) + (cl-multiple-value-bind (res _pa _pb) + (helm-dabbrev--search-and-store str 1 limit results) + ;; No need to set POS-BEFORE and POS-AFTER here. + (setq results res))))) + (when (>= (length results) limit) (throw 'break nil)))) + (nreverse results))) + +(defun helm-dabbrev--search-and-store (pattern direction limit results) + "Search words or symbols matching PATTERN in DIRECTION up to LIMIT. +Finally returns all matched candidates appended to RESULTS. +Argument DIRECTION can be: + - (1): Search forward from point. + - (-1): Search backward from point. + - (2): Search forward from the + `helm-dabbrev-lineno-around' + lines after point. + - (-2): Search backward from the + `helm-dabbrev-lineno-around' + lines before point." + (let ((res results) + after before) + (while (and (<= (length res) limit) + (cl-case direction + (1 (search-forward pattern nil t)) + (-1 (search-backward pattern nil t)) + (2 (let ((pos + (save-excursion + (forward-line + helm-dabbrev-lineno-around) + (point)))) + (setq after pos) + (search-forward pattern pos t))) + (-2 (let ((pos + (save-excursion + (forward-line + (- helm-dabbrev-lineno-around)) + (point)))) + (setq before pos) + (search-backward pattern pos t))))) + (let* ((mb (match-beginning 0)) + (replace-regexp (concat "\\(" helm-dabbrev-separator-regexp + "\\)\\'")) + (match-word (helm-dabbrev--search + pattern mb replace-regexp))) + (when (and match-word (not (member match-word res))) + (push match-word res)))) + (list res after before))) + +(defun helm-dabbrev--search (pattern beg sep-regexp) + "Search word or symbol at point matching PATTERN. +Argument BEG is corresponding to the previous `match-beginning' +search. +The search starts at (1- BEG) with a regexp starting with +`helm-dabbrev-separator-regexp' followed by PATTERN followed by a +regexp matching syntactically any word or symbol. +The possible false positives matching SEP-REGEXP at end are +finally removed." + (let ((eol (pos-eol))) + (save-excursion + (goto-char (1- beg)) + (when (re-search-forward + (concat "\\(" + helm-dabbrev-separator-regexp + "\\)" + "\\(?99:\\(" + (regexp-quote pattern) + "\\(\\sw\\|\\s_\\)+\\)\\)") + eol t) + (replace-regexp-in-string + sep-regexp "" + (match-string-no-properties 99)))))) + +(defun helm-dabbrev--get-candidates (dabbrev &optional limit) + (cl-assert dabbrev nil "[No Match]") + (helm-dabbrev--collect + dabbrev (or limit helm-dabbrev-candidates-number-limit) + (cl-case helm-dabbrev-case-fold-search + (smart (helm-set-case-fold-search-1 dabbrev)) + (t helm-dabbrev-case-fold-search)) + helm-dabbrev-always-search-all)) + +(defun helm-dabbrev-default-action (candidate) + (with-helm-current-buffer + (let* ((limits (helm-bounds-of-thing-before-point + helm-dabbrev-separator-regexp)) + (beg (car limits)) + (end (point))) + (run-with-timer + 0.01 nil + #'helm-insert-completion-at-point + beg end candidate)))) + +;;;###autoload +(cl-defun helm-dabbrev () + "Preconfigured helm for dynamic abbreviations." + (interactive) + (unless helm-dabbrev--computing-cache + (let ((dabbrev (helm-thing-before-point + nil helm-dabbrev-separator-regexp)) + (limits (helm-bounds-of-thing-before-point + helm-dabbrev-separator-regexp)) + (enable-recursive-minibuffers t) + (cycling-disabled-p (or (null helm-dabbrev-cycle-threshold) + (zerop helm-dabbrev-cycle-threshold))) + (helm-execute-action-at-once-if-one t) + (helm-quit-if-no-candidate + (lambda () + (message "[Helm-dabbrev: No expansion found]")))) + (cl-assert (and (stringp dabbrev) (not (string= dabbrev ""))) + nil "[Helm-dabbrev: Nothing found before point]") + (when (and + ;; have been called at least once. + (helm-dabbrev-info-p helm-dabbrev--data) + ;; But user have moved with some other command + ;; in the meaning time. + (not (eq last-command 'helm-dabbrev))) + (setq helm-dabbrev--data nil)) + ;; When candidates are requested in helm directly without cycling, + ;; we need them right now before running helm. + (when cycling-disabled-p + (message "Waiting for helm-dabbrev candidates...") + (setq helm-dabbrev--cache (helm-dabbrev--get-candidates dabbrev))) + (unless (or cycling-disabled-p + (helm-dabbrev-info-p helm-dabbrev--data)) + (setq helm-dabbrev--data + (make-helm-dabbrev-info + :dabbrev dabbrev + :limits limits + :iterator + (helm-iter-list + (cl-loop for i in (helm-dabbrev--get-candidates + dabbrev helm-dabbrev-cycle-threshold) + when (string-match-p + (concat "^" (regexp-quote dabbrev)) i) + collect i))))) + (let ((iter (and (helm-dabbrev-info-p helm-dabbrev--data) + (helm-dabbrev-info-iterator helm-dabbrev--data))) + deactivate-mark) + ;; Cycle until iterator is consumed. + (helm-aif (and iter (helm-iter-next iter)) + (progn + (helm-insert-completion-at-point + (car (helm-dabbrev-info-limits helm-dabbrev--data)) + ;; END is the end of the previous inserted string, not + ;; the end (apart for first insertion) of the initial string. + (cdr limits) it) + ;; Move already tried candidates to end of list. + (push it helm-dabbrev--already-tried)) + ;; Iterator is now empty, or cycling was disabled, maybe + ;; reset dabbrev to initial value and start helm completion. + (let* ((old-dabbrev (if (helm-dabbrev-info-p helm-dabbrev--data) + (helm-dabbrev-info-dabbrev helm-dabbrev--data) + dabbrev)) + (only-one (eq (length helm-dabbrev--already-tried) 1))) + (unless helm-dabbrev--cache ; Already computed when + ; cycling is disabled. + (message "Waiting for helm-dabbrev candidates...") + (setq helm-dabbrev--computing-cache t) + (setq helm-dabbrev--cache + (helm-dabbrev--get-candidates old-dabbrev)) + ;; If user continues typing M-/ while display is blocked by + ;; helm-dabbrev--get-candidates delete these events. + (setq unread-command-events nil)) + ;; If the length of candidates is only one when computed + ;; that's mean the unique matched item have already been + ;; inserted by the iterator, so no need to reinsert the old dabbrev, + ;; just let helm exiting with "No expansion found". + (unless (or only-one cycling-disabled-p) + (setq dabbrev old-dabbrev + limits (helm-dabbrev-info-limits helm-dabbrev--data)) + (setq helm-dabbrev--data nil) + (delete-region (car limits) (point)) + (insert dabbrev)) + (when (and (null cycling-disabled-p) only-one) + (setq helm-dabbrev--cache nil + helm-dabbrev--already-tried nil + helm-dabbrev--computing-cache nil) + (cl-return-from helm-dabbrev + (message "[Helm-dabbrev: No expansion found]"))) + (with-helm-show-completion (car limits) (cdr limits) + (unwind-protect + (helm :sources + (helm-build-in-buffer-source "Dabbrev Expand" + :data + (append + (cl-loop with lst = helm-dabbrev--cache + for cand in helm-dabbrev--already-tried + do (setq lst (delete cand lst)) + finally return lst) + helm-dabbrev--already-tried) + :persistent-action 'ignore + :persistent-help "DoNothing" + :keymap helm-dabbrev-map + :action 'helm-dabbrev-default-action + :group 'helm-dabbrev) + :buffer "*helm dabbrev*" + :input (concat "^" dabbrev " ") + :resume 'noresume + :allow-nest t) + (setq helm-dabbrev--computing-cache nil + helm-dabbrev--already-tried nil + helm-dabbrev--cache nil))))))))) + +(provide 'helm-dabbrev) + +;;; helm-dabbrev.el ends here diff --git a/elpa/helm-20260424.1357/helm-easymenu.el b/elpa/helm-20260424.1357/helm-easymenu.el new file mode 100644 index 00000000..8609b8d1 --- /dev/null +++ b/elpa/helm-20260424.1357/helm-easymenu.el @@ -0,0 +1,85 @@ +;;; helm-easymenu.el --- Helm easymenu definitions. -*- lexical-binding: t -*- + +;; Copyright (C) 2015 ~ 2026 Thierry Volpiatto + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Code: + +(require 'easymenu) + +(easy-menu-add-item + nil '("Tools") + '("Helm" + ["Find any Files/Buffers" helm-multi-files t] + ["Helm Everywhere (Toggle)" helm-mode t] + ["Helm resume" helm-resume t] + "----" + ("Files" + ["Find files" helm-find-files t] + ["Recent Files" helm-recentf t] + ["Locate" helm-locate t] + ["Search Files with find" helm-find t] + ["Bookmarks" helm-filtered-bookmarks t] + ["Locate library" helm-locate-library t]) + ("Buffers" + ["Find buffers" helm-buffers-list t]) + ("Projects" + ["Browse project" helm-browse-project] + ["Projects history" helm-projects-history]) + ("Commands" + ["Emacs Commands" helm-M-x t] + ["Externals Commands" helm-run-external-command t]) + ("Help" + ["Helm Apropos" helm-apropos t]) + ("Info" + ["Info at point" helm-info-at-point t] + ["Emacs Manual index" helm-info-emacs t] + ["Gnus Manual index" helm-info-gnus t] + ["Helm documentation" helm-documentation t]) + ("Packages" + ["Elisp packages" helm-packages t] + ["Finder" helm-finder t]) + ("Tools" + ["Occur" helm-occur t] + ["Grep current directory with AG" helm-do-grep-ag t] + ["Gid" helm-gid t] + ["Etags" helm-etags-select t] + ["Lisp complete at point" helm-lisp-completion-at-point t] + ["Browse Kill ring" helm-show-kill-ring t] + ["Browse register" helm-register t] + ["Mark Ring" helm-all-mark-rings t] + ["Regexp handler" helm-regexp t] + ["Colors & Faces" helm-colors t] + ["Show xfonts" helm-select-xfont t] + ["Ucs Symbols" helm-ucs t] + ["Imenu" helm-imenu t] + ["Imenu all" helm-imenu-in-all-buffers t] + ["Semantic or Imenu" helm-semantic-or-imenu t] + ["Google Suggest" helm-google-suggest t] + ["Eval expression" helm-eval-expression-with-eldoc t] + ["Calcul expression" helm-calcul-expression t] + ["Man pages" helm-man-woman t] + ["Top externals process" helm-top t] + ["Emacs internals process" helm-list-emacs-process t]) + "----" + ["Preferred Options" helm-configuration t]) + "Spell Checking") + +(easy-menu-add-item nil '("Tools") '("----") "Spell Checking") + + +(provide 'helm-easymenu) + +;;; helm-easymenu.el ends here diff --git a/elpa/helm-20260424.1357/helm-elisp.el b/elpa/helm-20260424.1357/helm-elisp.el new file mode 100644 index 00000000..81fde337 --- /dev/null +++ b/elpa/helm-20260424.1357/helm-elisp.el @@ -0,0 +1,1174 @@ +;;; helm-elisp.el --- Elisp symbols completion for helm. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2026 Thierry Volpiatto + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Code: +(require 'cl-lib) +(require 'helm) +(require 'helm-lib) +(require 'helm-help) +(require 'helm-types) +(require 'helm-utils) +(require 'helm-info) +(require 'helm-eval) +(require 'helm-files) + +(declare-function helm-describe-function "helm-lib") +(declare-function helm-describe-variable "helm-lib") +(declare-function helm-describe-face "helm-lib") +(declare-function helm-read-file-name "helm-mode") +(declare-function helm-comp-read "helm-mode") +(declare-function helm-M-x-transformer-no-sort-no-props "helm-command") +(defvar helm-M-x-show-short-doc) +(defvar completions-detailed) +(defvar helm-completions-detailed) + + +;;; Customizable values + +(defgroup helm-elisp nil + "Elisp related Applications and libraries for Helm." + :group 'helm) + +(defcustom helm-turn-on-show-completion t + "Display candidate in `current-buffer' while moving selection when non--nil." + :group 'helm-elisp + :type 'boolean) + +(defcustom helm-show-completion-min-window-height 7 + "Minimum completion window height used in show completion. +This is used in macro `with-helm-show-completion'." + :group 'helm-elisp + :type 'integer) + +(defcustom helm-lisp-quoted-function-list + '(funcall apply mapc cl-mapc mapcar cl-mapcar + callf callf2 cl-callf cl-callf2 fset + fboundp fmakunbound symbol-function) + "List of function where quoted function completion happen. +E.g. give only function names after (funcall \\='." + :group 'helm-elisp + :type '(repeat (choice symbol))) + +(defcustom helm-lisp-unquoted-function-list + '(function defadvice) + "List of function where unquoted function completion happen. +E.g. give only function names after (function ." + :group 'helm-elisp + :type '(repeat (choice symbol))) + +(defcustom helm-apropos-fuzzy-match nil + "Enable fuzzy matching for `helm-apropos' when non-nil." + :group 'helm-elisp + :type 'boolean) + +(defcustom helm-lisp-fuzzy-completion nil + "Enable fuzzy matching in emacs-lisp completion when non-nil. +NOTE: This enables fuzzy matching in Helm native implementation of +elisp completion, but not on helmized elisp completion, i.e. fuzzy +completion is not available in `completion-at-point'." + :group 'helm-elisp + :type 'boolean) + +(defcustom helm-apropos-function-list '(helm-def-source--emacs-commands + helm-def-source--emacs-functions + helm-def-source--eieio-classes + helm-def-source--eieio-generic + helm-def-source--emacs-variables + helm-def-source--emacs-faces) + "A list of functions that build helm sources to use in `helm-apropos'." + :group 'helm-elisp + :type '(repeat (choice symbol))) + +(defcustom helm-apropos-defaut-info-lookup-sources '(helm-source-info-elisp + helm-source-info-cl + helm-source-info-eieio) + "A list of sources to look into when searching info page of a symbol." + :group 'helm-elisp + :type '(repeat (choice symbol))) + +(defcustom helm-show-completion-display-function + (if (display-graphic-p) + #'helm-display-buffer-in-own-frame + #'helm-show-completion-default-display-function) + "The function used to display helm completion buffer. + +This function is used by `with-helm-show-completion', when nil +fallback to `helm-default-display-buffer'. + +Default is to use a separate frame on graphic display and +`helm-show-completion-default-display-function' on non graphic +display." + :group 'helm-elisp + :type 'function) + +;;; Faces +;; +;; +(defgroup helm-elisp-faces nil + "Customize the appearance of helm-elisp." + :prefix "helm-" + :group 'helm-elisp + :group 'helm-faces) + +(defface helm-lisp-show-completion + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :background "DarkSlateGray")) + "Face used for showing candidates in `helm-lisp-completion'." + :group 'helm-elisp-faces) + +(defface helm-lisp-completion-info + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :foreground "red")) + "Face used for showing info in `helm-lisp-completion'." + :group 'helm-elisp-faces) + +(defcustom helm-elisp-help-function + 'helm-elisp-show-help + "Function for displaying help for Lisp symbols." + :group 'helm-elisp + :type '(choice (function :tag "Open help for the symbol." + helm-elisp-show-help) + (function :tag "Show one liner in modeline." + helm-elisp-show-doc-modeline))) + +(defcustom helm-locate-library-fuzzy-match t + "Enable fuzzy-matching in `helm-locate-library' when non--nil." + :type 'boolean + :group 'helm-elisp) + + +;;; Show completion. +;; +;; Provide show completion with macro `with-helm-show-completion'. + +(defvar helm-show-completion-overlay nil) + +;; Called each time cursor move in helm-buffer. +(defun helm-show-completion () + (with-helm-current-buffer + (helm-aif (helm-get-selection) + (overlay-put helm-show-completion-overlay + 'display (substring-no-properties it))))) + +(defun helm-show-completion-init-overlay (beg end) + (setq helm-show-completion-overlay (make-overlay beg end)) + (overlay-put helm-show-completion-overlay + 'face 'helm-lisp-show-completion)) + +(defun helm-show-completion-default-display-function (buffer &rest _args) + "A special resized Helm window is used depending on position in BUFFER." + (with-selected-window (selected-window) + (if (window-dedicated-p) + (helm-default-display-buffer buffer) + (let* ((screen-size (+ (count-screen-lines (window-start) (point) t) + 1 ; mode-line + (if header-line-format 1 0))) ; header-line + (def-size (- (window-height) + helm-show-completion-min-window-height)) + (upper-height (max window-min-height (min screen-size def-size))) + split-window-keep-point) + (recenter -1) + (set-window-buffer (if (active-minibuffer-window) + (minibuffer-selected-window) + (split-window nil upper-height + helm-split-window-default-side)) + buffer))))) + +(defmacro with-helm-show-completion (beg end &rest body) + "Show Helm candidate in an overlay at point. +BEG and END are the beginning and end position of the current +completion in `helm-current-buffer'. +BODY is an Helm call where we want to enable show completion. +If `helm-turn-on-show-completion' is nil do nothing." + (declare (indent 2) (debug t)) + `(unwind-protect + (if helm-turn-on-show-completion + (let ((helm-move-selection-after-hook + (append (list 'helm-show-completion) + helm-move-selection-after-hook)) + (helm-split-window-default-side + (if (eq helm-split-window-default-side 'same) + 'below helm-split-window-default-side)) + helm-split-window-inside-p + helm-reuse-last-window-split-state) + (helm-set-local-variable + 'helm-display-function + (or helm-show-completion-display-function + 'helm-default-display-buffer)) + (with-helm-after-update-hook + ;; Show immediately first candidate as soon as helm popup. + (helm-show-completion)) + (helm-show-completion-init-overlay ,beg ,end) + ,@body) + ,@body) + (when (and helm-show-completion-overlay + (overlayp helm-show-completion-overlay)) + (delete-overlay helm-show-completion-overlay)))) + + +;;; Lisp symbol completion. +;; +;; +(defun helm-lisp-completion--predicate-at-point (beg) + ;; Return a predicate for `all-completions'. + (let ((fn-sym-p (lambda () + (or + (and (eq (char-before) ?\ ) + (save-excursion + (skip-syntax-backward " " (pos-bol)) + (memq (symbol-at-point) + helm-lisp-unquoted-function-list))) + (and (eq (char-before) ?\') + (save-excursion + (forward-char -1) + (eq (char-before) ?\#))))))) + (save-excursion + (goto-char beg) + (cond ((or + ;; Complete on all symbols in non--lisp modes (logs mail etc..) + (not (memq major-mode '(emacs-lisp-mode + lisp-interaction-mode + inferior-emacs-lisp-mode))) + (not (or (funcall fn-sym-p) + (and (eq (char-before) ?\') + (save-excursion + (forward-char (if (funcall fn-sym-p) -2 -1)) + (skip-syntax-backward " " (pos-bol)) + (memq (symbol-at-point) + helm-lisp-quoted-function-list))) + (eq (char-before) ?\())) ; no paren before str. + ;; Looks like we are in a let statement. + (condition-case nil + (progn (up-list -2) (forward-char 1) + (eq (char-after) ?\()) + (error nil))) + (lambda (sym) + (or (boundp sym) (fboundp sym) (symbol-plist sym)))) + (t #'fboundp))))) + +(defun helm-thing-before-point (&optional limits regexp) + "Return symbol name before point. +If REGEXP is specified return what REGEXP find before point. +By default match the beginning of symbol before point. +With LIMITS arg specified return the beginning and end position +of symbol before point." + (save-excursion + (let (beg + (end (point)) + (boundary (field-beginning nil nil (pos-bol)))) + (if (re-search-backward (or regexp "\\_<") boundary t) + (setq beg (match-end 0)) + (setq beg boundary)) + (unless (= beg end) + (if limits + (cons beg end) + (buffer-substring-no-properties beg end)))))) + +(defun helm-bounds-of-thing-before-point (&optional regexp) + "Get the beginning and end position of `helm-thing-before-point'. +Return a cons (beg . end)." + (helm-thing-before-point 'limits regexp)) + +(defun helm-insert-completion-at-point (beg end str) + ;; When there is no space after point + ;; we are completing inside a symbol or + ;; after a partial symbol with the next arg aside + ;; without space, in this case mark the region. + ;; deleting it would remove the + ;; next arg which is unwanted. + (delete-region beg end) + (insert str) + (let ((pos (cdr (or (bounds-of-thing-at-point 'symbol) + ;; needed for helm-dabbrev. + (bounds-of-thing-at-point 'filename))))) + (when (and pos (< (point) pos)) + (push-mark pos t t)))) + +(defconst helm-lisp-completion-re-chars-classes + '(":xdigit:" ":word:" ":upper:" + ":unibyte:" ":space:" ":punct:" + ":print:" ":nonascii:" ":ascii:" + ":multibyte:" ":lower:" + ":graph:" ":digit:" ":cntrl:" + ":blank:" ":alpha:" ":alnum:") + "Table of Char Classes for regexps.") + +;;;###autoload +(defun helm-lisp-completion-at-point () + "Preconfigured Helm for Lisp symbol completion at point." + (interactive) + (let* ((target (helm-thing-before-point)) + (beg (car (helm-bounds-of-thing-before-point))) + (end (point)) + (pred (and beg (helm-lisp-completion--predicate-at-point beg))) + (re-class-p (and (eq 'string (syntax-ppss-context (syntax-ppss (point)))) + (save-excursion + (re-search-backward "\\[:[[:alpha:]]*" (pos-bol) t)))) + (loc-vars (and (fboundp 'elisp--local-variables) + (ignore-errors + (mapcar #'symbol-name (elisp--local-variables))))) + (glob-syms (and target pred (not re-class-p) (all-completions target obarray pred))) + (candidates (if re-class-p + helm-lisp-completion-re-chars-classes + (append loc-vars glob-syms))) + (helm-quit-if-no-candidate t) + (helm-execute-action-at-once-if-one t) + (enable-recursive-minibuffers t)) + (if candidates + (with-helm-show-completion beg end + ;; Overlay is initialized now in helm-current-buffer. + (helm + :sources (helm-build-in-buffer-source "Lisp completion" + :data candidates + :persistent-action `(helm-lisp-completion-persistent-action . + ,(and (eq helm-elisp-help-function + 'helm-elisp-show-doc-modeline) + 'never-split)) + :nomark t + :match-part (lambda (c) (car (split-string c))) + :fuzzy-match helm-lisp-fuzzy-completion + :popup-info (lambda (c) (helm-get-first-line-documentation + (if (string-match "\\`:[[:alpha:]]+:\\'" c) + c (intern-soft c)))) + :persistent-help (helm-lisp-completion-persistent-help) + :filtered-candidate-transformer + #'helm-lisp-completion-transformer + :action (lambda (candidate) + (with-helm-current-buffer + (run-with-timer + 0.01 nil + #'helm-insert-completion-at-point + beg end candidate)))) + :input target + :resume 'noresume + :truncate-lines t + :buffer "*helm lisp completion*" + :allow-nest t)) + (message "[No Match]")))) + +(defun helm-lisp-completion-persistent-action (candidate &optional name) + "Show documentation for the function. +Documentation is shown briefly in mode-line or completely in +other window according to the value of +`helm-elisp-help-function'." + (funcall helm-elisp-help-function candidate name)) + +(defun helm-lisp-completion-persistent-help () + "Return persistent-help according to the value of `helm-elisp-help-function'" + (cl-ecase helm-elisp-help-function + (helm-elisp-show-doc-modeline "Show brief doc in mode-line") + (helm-elisp-show-help "Toggle show help for the symbol"))) + +(defun helm-elisp--show-help-1 (candidate &optional name) + (helm-acase (if (member candidate helm-lisp-completion-re-chars-classes) + candidate + (intern-soft candidate)) + ((guard* (stringp it)) + (helm-describe-re-char-classes it)) + ((guard* (and (fboundp it) (boundp it))) + (if (member name `(,helm-describe-function-function + ,helm-describe-variable-function)) + (funcall (intern (format "helm-%s" name)) it) + ;; When there is no way to know what to describe + ;; prefer describe-function. + (helm-describe-function it))) + ((guard* (fboundp it)) (helm-describe-function it)) + ((guard* (boundp it)) (helm-describe-variable it)) + ((guard* (facep it)) (helm-describe-face it)))) + +(defun helm-elisp-show-help (candidate &optional name) + "Show full help for the function CANDIDATE. +Arg NAME specifies the name of the top level function calling +Helm generic completion (e.g., \"describe-function\") which +allows calling the right function when CANDIDATE symbol refers at +the same time to variable and a function." + (helm-elisp--persistent-help + candidate 'helm-elisp--show-help-1 name)) + +(defun helm-elisp-show-doc-modeline (candidate &optional name) + "Show brief documentation for the function in the mode-line." + (let ((cursor-in-echo-area t) + mode-line-in-non-selected-windows) + (helm-show-info-in-mode-line + (propertize + (helm-get-first-line-documentation + (intern candidate) name) + 'face 'helm-lisp-completion-info)))) + +(defun helm-lisp-completion-transformer (candidates _source) + "Helm candidates transformer for Lisp completion." + (cl-loop for c in candidates + for sym = (if (string-match "\\`:[[:alpha:]]+:\\'" c) + c (intern-soft c)) + for annot = (helm-acase sym + ((guard* (stringp it)) + (propertize " " 'face 'font-lock-regexp-face)) + ((guard* (commandp it)) + (propertize " " 'face 'font-lock-function-name-face)) + ((guard* (class-p it)) + (propertize " " 'face 'font-lock-type-face)) + ((guard* (cl-generic-p it)) + (propertize " " 'face 'font-lock-function-name-face)) + ((guard* (fboundp it)) + (propertize " " 'face 'font-lock-function-name-face)) + ((guard* (keywordp it)) + (propertize " " 'face 'font-lock-keyword-face)) + ((guard* (boundp it)) + (propertize " " 'face 'font-lock-variable-name-face)) + ((guard* (facep it)) + (propertize " " 'face 'font-lock-variable-name-face)) + ((guard* (helm-group-p it)) + (propertize " " 'face 'font-lock-type-face)) + (t " ")) + collect (cons (concat (propertize " " 'display annot) c) c) + into lst + finally return (sort lst #'helm-generic-sort-fn))) + +;;;###autoload +(defun helm-get-first-line-documentation (sym &optional name end-column) + "Return first line documentation of symbol SYM truncated at END-COLUMN. +If SYM is not documented, return \"Not documented\". +Argument NAME allows specifiying what function to use to display +documentation when SYM name is the same for function and variable." + (unless name (setq name "describe-function")) + (unless end-column (setq end-column 72)) + (let ((doc (condition-case _err + (helm-acase sym + ((guard* (stringp it)) + (cadr (split-string (helm-describe-re-char-classes-1 it) "\n"))) + ((guard* (class-p it)) + (cl--class-docstring (cl--find-class it))) + ((guard* (and (fboundp it) (boundp it))) + (if (string= name "describe-variable") + (documentation-property it 'variable-documentation t) + (documentation it t))) + ((guard* (custom-theme-p it)) + (documentation-property it 'theme-documentation t)) + ((guard* (and (helm-group-p it) (not (fboundp it)))) + (documentation-property it 'group-documentation t)) + ((guard* (fboundp it)) + (documentation it t)) + ((guard* (boundp it)) + (documentation-property it 'variable-documentation t)) + ((guard* (facep it)) (face-documentation it))) + (void-function "Void function -- Not documented")))) + (if (and doc (not (string= doc "")) + ;; `documentation' return "\n\n(args...)" + ;; for CL-style functions. + (not (string-match-p "\\`\n\n" doc))) + ;; Some commands specify key bindings or keymap in their first line, + ;; e.g.: "\A mode for editing binary [...]. As a result + ;; (substitute-command-keys doc) returns a string like "\nUses + ;; keymap...\nFirst line docstring. See + ;; . + (truncate-string-to-width + (helm-acase (split-string (substitute-command-keys doc) "\n") + ((dst* (l &rest args)) + (if (string= l "") (cadr args) l))) + end-column nil nil t) + (if (or (symbol-function sym) (boundp sym) (facep sym) (helm-group-p sym)) + "Not documented" + ;; Symbol exist but has no definition yet e.g. + ;; (advice-add 'foo-test :override (lambda () (message "invalid + ;; function"))) and foo-test is not already defined. + "Not already defined or loaded")))) + +;;; File completion. +;; +;; Complete file name at point. + +;;;###autoload +(defun helm-complete-file-name-at-point (&optional force) + "Preconfigured Helm to complete file name at point." + (interactive) + (require 'helm-mode) + (let* ((tap (or (thing-at-point 'filename t) "")) + beg + (init (and tap + (or force + (save-excursion + (end-of-line) + (search-backward tap (pos-bol) t) + (setq beg (point)) + (looking-back "[^'`( ]" (1- (point))))) + (expand-file-name tap))) + (end (point)) + (helm-quit-if-no-candidate t) + (helm-execute-action-at-once-if-one t) + completion) + (with-helm-show-completion beg end + (setq completion (helm-read-file-name "FileName: " + :initial-input init))) + (when (and completion (not (string= completion ""))) + (delete-region beg end) (insert (if (string-match "^~" tap) + (abbreviate-file-name completion) + completion))))) +(make-obsolete 'helm-complete-file-name-at-point 'helm-find-files "3.9.6") + +;;;###autoload +(defun helm-lisp-indent () + ;; It is meant to use with `helm-define-multi-key' which + ;; does not support args for functions yet, so use `current-prefix-arg' + ;; for now instead of (interactive "P"). + (interactive) + (let ((tab-always-indent (or (eq tab-always-indent 'complete) + tab-always-indent))) + (indent-for-tab-command current-prefix-arg))) + + +;;; Apropos +;; +;; +(defvar helm-apropos-history nil) + +(defcustom helm-apropos-show-short-doc nil + "Show short docstring of symbols when non nil. + +NOTE: When displaying helm-apropos in a frame, i.e. when +`helm-apropos' is member of `helm-commands-using-frame' setting this +to non nil have no effect, you have first to remove `helm-apropos' +from `helm-commands-using-frame'." + :group 'helm-elisp + :type 'boolean) + +(defvar helm-apropos-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (define-key map (kbd "C-]") #'helm-apropos-toggle-details) + map)) + +(defun helm-apropos-init (test default &optional fn) + "Setup `helm-candidate-buffer' for `helm-apropos' sources. +A list of symbols fetched with FN is inserted in +`helm-candidate-buffer', if FN is not provided symbols are fetched +against obarray with predicate TEST. When FN is provided predicate TEST +is only used to test DEFAULT." + (require 'helm-help) + (helm-init-candidates-in-buffer 'global + (let ((default-symbol (and (stringp default) + (intern-soft default))) + (symbols (if fn (funcall fn) (all-completions "" obarray test)))) + (if (and default-symbol (funcall test default-symbol)) + (cons default-symbol symbols) + symbols)))) + +(defun helm-apropos-short-doc-transformer (candidates _source) + (if helm-apropos-show-short-doc + (cl-loop for cand in candidates + for doc = (helm-get-first-line-documentation (intern-soft cand)) + collect (cons (format "%s%s%s" + cand + (if doc + (helm-make-separator cand) + "") + (if doc + (propertize + doc 'face 'helm-M-x-short-doc) + "")) + cand)) + candidates)) + +(defun helm-apropos-default-sort-fn (candidates _source) + (if (string= helm-pattern "") + candidates + (sort candidates #'helm-generic-sort-fn))) + +(defun helm-apropos-clean-history-variable (candidate) + (with-helm-current-buffer ; var is maybe local + (let* ((sym (intern-soft candidate)) + (cands (symbol-value sym)) + (mkds (and (listp cands) + (helm-comp-read "Delete entry: " + cands :marked-candidates t)))) + (cl-assert (listp mkds) nil "Variable value is not a list") + (cl-loop for elm in mkds do + (if (local-variable-p sym) + (set (make-local-variable sym) + (setq cands (delete elm cands))) + (set sym (setq cands (delete elm cands)))))))) + +(defun helm-apropos-clean-ring (candidate) + (with-helm-current-buffer ; var is maybe local + (let* ((sym (intern-soft candidate)) + (val (symbol-value sym)) + (cands (and (ring-p val) (ring-elements val))) + (mkds (and cands (helm-comp-read + "Delete entry: " + cands :marked-candidates t)))) + (when mkds + (cl-loop for elm in mkds do + (ring-remove + val (helm-position + elm + (ring-elements val) + :test 'equal)) + and do (if (local-variable-p sym) + (set (make-local-variable sym) val) + (set sym val))))))) + +(defun helm-apropos-action-transformer (actions candidate) + (let* ((sym (helm-symbolify candidate)) + (val (with-helm-current-buffer (symbol-value sym)))) + (cond ((custom-variable-p sym) + (append + actions + (let ((standard-value (eval (car (get sym 'standard-value)) t))) + (unless (equal standard-value (symbol-value sym)) + `(("Reset Variable to default value" + . ,(lambda (candidate) + (let ((sym (helm-symbolify candidate))) + (set sym standard-value))))))) + `(("Customize variable" + . ,(lambda (candidate) + (customize-option (helm-symbolify candidate))))))) + ((and val (with-helm-current-buffer (ring-p (symbol-value sym)))) + (append actions + '(("Clean ring" . helm-apropos-clean-ring)))) + ((and (string-match-p "history" candidate) (listp val)) + (append actions + '(("Clean variable" . + helm-apropos-clean-history-variable)))) + (t actions)))) + +(defun helm-def-source--emacs-variables (&optional default) + (helm-build-in-buffer-source "Variables" + :init (lambda () + (helm-apropos-init + (lambda (x) + (and (boundp x) (not (keywordp x)) (not (class-p x)))) + default)) + :fuzzy-match helm-apropos-fuzzy-match + :filtered-candidate-transformer + (delq nil (list (and (null helm-apropos-fuzzy-match) + 'helm-apropos-default-sort-fn) + (and (null (memq 'helm-apropos helm-commands-using-frame)) + #'helm-apropos-short-doc-transformer))) + :nomark t + :persistent-action (lambda (candidate) + (helm-elisp--persistent-help + candidate 'helm-describe-variable)) + :persistent-help "Toggle describe variable" + :keymap helm-apropos-map + :action '(("Describe variable" . helm-describe-variable) + ("Find variable" . helm-find-variable) + ("Info lookup" . helm-info-lookup-symbol) + ("Set variable" . helm-set-variable)) + :action-transformer 'helm-apropos-action-transformer)) + +(defun helm-def-source--emacs-faces (&optional default) + "Create `helm' source for faces to be displayed with +`helm-apropos'." + (helm-build-in-buffer-source "Faces" + :init (lambda () (helm-apropos-init 'facep default #'face-list)) + :fuzzy-match helm-apropos-fuzzy-match + :filtered-candidate-transformer + (delq nil (list + (and (null helm-apropos-fuzzy-match) + #'helm-apropos-default-sort-fn) + (lambda (candidates _source) + (cl-loop for c in candidates + collect (propertize c 'face (intern c)))) + (and (null (memq 'helm-apropos helm-commands-using-frame)) + #'helm-apropos-short-doc-transformer))) + :persistent-action (lambda (candidate) + (helm-elisp--persistent-help + candidate 'helm-describe-face)) + :persistent-help "Toggle describe face" + :keymap helm-apropos-map + :action '(("Describe face" . helm-describe-face) + ("Find face" . helm-find-face-definition) + ("Customize face" . (lambda (candidate) + (customize-face (helm-symbolify candidate))))))) + +(defun helm-def-source--emacs-commands (&optional default) + (require 'helm-command) + (helm-build-in-buffer-source "Commands" + :init (lambda () + (helm-apropos-init 'commandp default)) + :fuzzy-match helm-apropos-fuzzy-match + :filtered-candidate-transformer + (append (list #'helm-M-x-transformer-no-sort-no-props) + (and (null helm-apropos-fuzzy-match) + '(helm-apropos-default-sort-fn))) + :display-to-real 'helm-symbolify + :nomark t + :persistent-action (lambda (candidate) + (helm-elisp--persistent-help + candidate 'helm-describe-function)) + :persistent-help "Toggle describe command" + :keymap helm-apropos-map + :action 'helm-type-function-actions)) + +(defun helm-def-source--emacs-functions (&optional default) + (helm-build-in-buffer-source "Functions" + :init (lambda () + (helm-apropos-init (lambda (x) + (and (fboundp x) + (not (commandp x)) + (not (cl-generic-p x)) + (not (class-p x)))) + default)) + :fuzzy-match helm-apropos-fuzzy-match + :filtered-candidate-transformer + (delq nil (list (and (null helm-apropos-fuzzy-match) + 'helm-apropos-default-sort-fn) + (and (null (memq 'helm-apropos helm-commands-using-frame)) + #'helm-apropos-short-doc-transformer))) + :display-to-real 'helm-symbolify + :persistent-action (lambda (candidate) + (helm-elisp--persistent-help + candidate 'helm-describe-function)) + :persistent-help "Toggle describe function" + :keymap helm-apropos-map + :nomark t + :action 'helm-type-function-actions)) + +(defun helm-def-source--eieio-classes (&optional default) + (helm-build-in-buffer-source "Classes" + :init (lambda () + (helm-apropos-init (lambda (x) + (class-p x)) + default)) + :fuzzy-match helm-apropos-fuzzy-match + :filtered-candidate-transformer + (delq nil (list (and (null helm-apropos-fuzzy-match) + 'helm-apropos-default-sort-fn) + (and (null (memq 'helm-apropos helm-commands-using-frame)) + #'helm-apropos-short-doc-transformer))) + :nomark t + :persistent-action (lambda (candidate) + (helm-elisp--persistent-help + candidate 'helm-describe-class)) + :persistent-help "Toggle describe class" + :keymap helm-apropos-map + :action '(("Describe Class" . helm-describe-class) + ("Find Class (C-u for source)" . helm-find-function) + ("Info lookup" . helm-info-lookup-symbol) + ("Describe slots" . helm-elisp-describe-slots)))) + +(defun helm-def-source--eieio-generic (&optional default) + (helm-build-in-buffer-source "Generic functions" + :init (lambda () + (helm-apropos-init (lambda (x) + (cl-generic-p x)) + default)) + :fuzzy-match helm-apropos-fuzzy-match + :filtered-candidate-transformer + (delq nil (list (and (null helm-apropos-fuzzy-match) + 'helm-apropos-default-sort-fn) + (and (null (memq 'helm-apropos helm-commands-using-frame)) + #'helm-apropos-short-doc-transformer))) + :nomark t + :persistent-action (lambda (candidate) + (helm-elisp--persistent-help + candidate 'helm-describe-function)) + :persistent-help "Toggle describe generic function" + :keymap helm-apropos-map + :action '(("Describe function" . helm-describe-function) + ("Find function (C-u for source)" . helm-find-function) + ("Info lookup" . helm-info-lookup-symbol)))) + +(defun helm-info-lookup-fallback-source (candidate) + (cl-multiple-value-bind (fn src-name) + (helm-acase (helm-symbolify candidate) + ((guard* (class-p it)) + (list #'helm-describe-function + "Describe class")) + ((guard* (cl-generic-p it)) + (list #'helm-describe-function + "Describe generic function")) + ((guard* (fboundp it)) + (list #'helm-describe-function + "Describe function")) + ((guard* (facep it)) + (list #'helm-describe-face + "Describe face")) + (t + (list #'helm-describe-variable + "Describe variable"))) + (helm-build-sync-source src-name + :candidates (list candidate) + :persistent-action (lambda (candidate) + (helm-elisp--persistent-help + candidate fn)) + :persistent-help src-name + :nomark t + :action fn))) + +(defun helm-info-lookup-symbol-1 (c) + (let ((helm-execute-action-at-once-if-one 'current-source)) + (helm :sources (append helm-apropos-defaut-info-lookup-sources + (list (helm-info-lookup-fallback-source c))) + :resume 'noresume + :buffer "*helm lookup*" + :input (helm-stringify c)))) + +(defun helm-info-lookup-symbol (candidate) + ;; ???:Running an idle-timer allows not catching RET when exiting + ;; with the fallback source. + ;; (run-with-idle-timer 0.01 nil #'helm-info-lookup-symbol-1 candidate) + (helm-info-lookup-symbol-1 candidate)) + +(defun helm-elisp-describe-slots (class) + (helm :sources (helm-build-sync-source "Class slots" + :header-name (lambda (name) (format "%s in `%s'" name class)) + :candidates (helm-elisp-collect-slots-in-class + (intern-soft class)) + :candidate-transformer + (lambda (candidates) + (cl-loop for (disp . real) in candidates + collect (cons (propertize + disp 'face 'font-lock-keyword-face + 'display (concat ":" disp)) + real))) + :persistent-action (lambda (candidate) + (helm-elisp--persistent-help + candidate + #'helm-elisp--describe-slot)) + :persistent-help "Describe slot" + :popup-info (lambda (c) (caddr (split-string c "\n" t))) + :action (helm-make-actions + "Describe slot" 'helm-elisp--describe-slot)) + :buffer "*helm class slots*")) + +(defun helm-elisp--describe-slot (slot) + (with-output-to-temp-buffer (help-buffer) + (princ slot))) + +(defun helm-apropos-toggle-details () + "Toggle details in `helm-apropos'." + (interactive) + (with-helm-buffer + (unless (memq 'helm-apropos helm-commands-using-frame) + (setq helm-M-x-show-short-doc (not helm-M-x-show-short-doc) + helm-apropos-show-short-doc (not helm-apropos-show-short-doc)) + (helm-force-update (concat "^" (helm-stringify (helm-get-selection))) + (helm-get-current-source))))) + +(defun helm-apropos-get-default () + (with-syntax-table emacs-lisp-mode-syntax-table + (symbol-name (intern-soft + (helm-aand (thing-at-point 'symbol t) + (replace-regexp-in-string "\\`[~=]" "" it) + (replace-regexp-in-string "[~=]\\'" "" it)))))) + +;;;###autoload +(defun helm-apropos (default) + "Preconfigured Helm to describe commands, functions, variables and faces. +In non interactives calls DEFAULT argument should be provided as +a string, i.e. the `symbol-name' of any existing symbol." + (interactive (list (helm-apropos-get-default))) + (let ((helm-M-x-show-short-doc + (and helm-apropos-show-short-doc + (null (memq 'helm-apropos helm-commands-using-frame))))) + (helm :sources + (mapcar (lambda (func) + (funcall func default)) + helm-apropos-function-list) + :history 'helm-apropos-history + :buffer "*helm apropos*" + :preselect (and default (concat "^\\_<" (regexp-quote default) "\\_>")) + :truncate-lines t))) + + +;;; Locate elisp library +;; +;; +(defvar helm--locate-library-cache nil) +(defvar helm--locate-library-doc-cache (make-hash-table :test 'equal)) +(defun helm-locate-library-scan-list () + (cl-loop for dir in load-path + when (file-directory-p dir) + nconc (directory-files + dir nil (concat (regexp-opt (find-library-suffixes)) "\\'")))) + +;;;###autoload +(defun helm-locate-library (&optional arg) + "Preconfigured helm to locate elisp libraries. + +When `completions-detailed' or `helm-completions-detailed' is non +nil, a description of libraries is provided. The libraries are +partially cached in the variables +`helm--locate-library-doc-cache' and +`helm--locate-library-cache'. TIP: You can make these vars +persistent for faster start with the psession package, using M-x +psession-make-persistent-variable. NOTE: The caches affect as +well `find-libray' and `locate-library' when `helm-mode' is +enabled and `completions-detailed' is non nil. There is no need +to refresh the caches, they will be updated automatically if some +new libraries are found, however when a library update its +headers and the description change you can reset the caches with +a prefix arg." + (interactive "P") + (require 'helm-mode) + (let (done) + (when arg + (setq helm--locate-library-cache nil) + (clrhash helm--locate-library-doc-cache)) + (helm :sources + (helm-build-in-buffer-source "Elisp libraries (Scan)" + :data #'helm-locate-library-scan-list + :fuzzy-match helm-locate-library-fuzzy-match + :keymap helm-generic-files-map + :candidate-transformer + (lambda (candidates) + (cl-loop with reporter = (unless done + (make-progress-reporter + "Scanning libraries..." 0 (length candidates))) + with lgst = (helm-in-buffer-get-longest-candidate) + for c in candidates + for count from 0 + for bn = (helm-basename c 2) + for sep = (helm-make-separator bn lgst) + for path = (or (assoc-default bn helm--locate-library-cache) + ;; A lock file in LOAD-PATH (bug#2626). + (unless (string-match "\\`\\.#" bn) + (let ((p (find-library-name bn))) + (push (cons bn p) helm--locate-library-cache) + p))) + for doc = (and path + (or completions-detailed helm-completions-detailed) + (or (gethash bn helm--locate-library-doc-cache) + (puthash bn (helm-locate-lib-get-summary path) + helm--locate-library-doc-cache))) + for disp = (and path + (if (and doc + (or completions-detailed helm-completions-detailed)) + (helm-aand (propertize doc 'face 'helm-completions-detailed) + (propertize " " 'display (concat sep it)) + (concat bn it)) + bn)) + when (and disp path) + collect (cons disp path) + when reporter do (progress-reporter-update reporter count) + finally do (setq done t))) + :action (helm-actions-from-type-file)) + :buffer "*helm locate library*"))) + + +;;; Modify variables from Helm +;; +;; +(defun helm-set-variable (var) + "Set VAR value interactively." + (let* ((sym (helm-symbolify var)) + (val (default-value sym)) + (strv (prin1-to-string val))) + (if (> (length strv) 25) + (helm-edit-variable var) + (set-default sym (eval-minibuffer + (format "Set `%s': " var) + (if (or (arrayp val) + (memq val '(nil t)) + (numberp val)) + strv + (format "'%s" strv))))))) + +(defvar helm-edit-variable-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "C-c C-c") 'helm-set-variable-from-pp-buffer) + (define-key map (kbd "C-c C-k") 'helm-edit-variable-quit) + (define-key map (kbd "C-c =") 'helm-edit-variable-toggle-diff) + map)) + +(define-derived-mode helm-edit-variable-mode + emacs-lisp-mode "helm-edit-variable" + "A mode to edit variables values. + +Special commands: +\\{helm-edit-variable-mode-map}") + +(defvar helm-pretty-print-temp-file-name + (expand-file-name "helm-edit-variable.el" temporary-file-directory)) +(defvar helm-pretty-print-buffer-name "*pretty print output*") +(defvar helm-pretty-print-current-symbol nil) +(defun helm-edit-variable (var) + (let* ((sym (intern-soft var)) + (val (symbol-value sym)) + (pp (pp-to-string val)) + start) + (with-current-buffer (get-buffer-create helm-pretty-print-buffer-name) + (erase-buffer) + (helm-edit-variable-mode) + (setq start (point)) + ;; Any number of lines starting with ";;;" + one empty line. + (insert (format ";;; Edit variable `%s' and hit C-c C-c when done\n" sym) + ";;; Abort with C-c C-k\n\n") + (add-text-properties start (1- (point)) '(read-only t)) + (add-text-properties (1- (point)) (point) '(read-only t rear-nonsticky t)) + (set (make-local-variable 'helm-pretty-print-current-symbol) sym) + (add-hook 'kill-buffer-hook + (lambda () + (when (file-exists-p helm-pretty-print-temp-file-name) + (delete-file helm-pretty-print-temp-file-name))) + nil t) + (save-excursion (insert pp)) + (write-region + (point-min) (point-max) helm-pretty-print-temp-file-name nil 1) + (setq buffer-file-name helm-pretty-print-temp-file-name)) + (display-buffer helm-pretty-print-buffer-name))) + +(defun helm-edit-variable-toggle-diff () + "Show diff in edit variable buffer." + (interactive) + (if (get-buffer-window "*Diff*" 'visible) + (kill-buffer "*Diff*") + (diff-buffer-with-file))) + +(defun helm-set-variable-from-pp-buffer () + "Set variable associated with buffer to buffer contents. + +The associated variable is the local variable +`helm-pretty-print-current-symbol'." + (interactive) + (with-current-buffer helm-pretty-print-buffer-name + (goto-char (point-min)) + (when (re-search-forward "^$" nil t) + (forward-line 1)) + (let ((val (symbol-value helm-pretty-print-current-symbol))) + (save-excursion + (if (or (arrayp val) + (memq val '(nil t)) + (numberp val) + (looking-at "[`']")) + (set-default helm-pretty-print-current-symbol + (read (current-buffer))) + (set-default helm-pretty-print-current-symbol + `(,@(read (current-buffer)))))) + (if (equal val (symbol-value helm-pretty-print-current-symbol)) + (message "No changes done") + (message "`%s' value modified" helm-pretty-print-current-symbol)) + (helm-edit-variable-quit)))) + +(defun helm-edit-variable-quit () + "Quit edit variable buffer." + (interactive) + (set-buffer-modified-p nil) + (quit-window t) + (helm-aif (get-buffer-window "*Diff*" 'visible) + (quit-window t it))) + + +;;; Elisp Timers. +;; +;; +(defclass helm-absolute-time-timers-class (helm-source-sync helm-type-timers) + ((candidates :initform 'timer-list) + (allow-dups :initform t) + (candidate-transformer + :initform + (lambda (candidates) + (cl-loop for timer in candidates + collect (cons (helm-elisp--format-timer timer) timer)))))) + +(defvar helm-source-absolute-time-timers + (helm-make-source "Absolute Time Timers" 'helm-absolute-time-timers-class)) + +(defclass helm-idle-time-timers-class (helm-source-sync helm-type-timers) + ((candidates :initform 'timer-idle-list) + (allow-dups :initform t) + (candidate-transformer + :initform + (lambda (candidates) + (cl-loop for timer in candidates + collect (cons (helm-elisp--format-timer timer) timer)))))) + +(defvar helm-source-idle-time-timers + (helm-make-source "Idle Time Timers" 'helm-idle-time-timers-class)) + +(defun helm-elisp--format-timer (timer) + (format "%s repeat=%s %s(%s)" + (let ((time (timer--time timer))) + (if (timer--idle-delay timer) + (format "idle-for=[%s]" + (format-seconds "%dd %hh %mmin %z%,3ss" + (time-to-seconds time))) + (format-time-string "%m/%d %T" time))) + (or (timer--repeat-delay timer) "nil") + (mapconcat #'identity (split-string + (prin1-to-string (timer--function timer)) + "\n") + " ") + (mapconcat #'prin1-to-string (timer--args timer) " "))) + +;;;###autoload +(defun helm-timers () + "Preconfigured `helm' for timers." + (interactive) + (helm :sources '(helm-source-absolute-time-timers + helm-source-idle-time-timers) + :buffer "*helm timers*")) + + +;;; Complex command history +;; +;; + +(defvar helm-sexp--last-sexp nil) +;; This wont work compiled. +(defun helm-sexp-eval-1 () + (interactive) + (unwind-protect + (progn + ;; Trick called-interactively-p into thinking that `cand' is + ;; an interactive call, See `repeat-complex-command'. + (add-hook 'called-interactively-p-functions + #'helm-complex-command-history--called-interactively-skip) + (eval (read helm-sexp--last-sexp) t)) + (remove-hook 'called-interactively-p-functions + #'helm-complex-command-history--called-interactively-skip))) + +(defun helm-complex-command-history--called-interactively-skip (i _frame1 frame2) + (and (eq 'eval (cadr frame2)) + (eq 'helm-sexp-eval-1 + (cadr (backtrace-frame (+ i 2) #'called-interactively-p))) + 1)) + +(defun helm-sexp-eval (_candidate) + (call-interactively #'helm-sexp-eval-1)) + +(defvar helm-source-complex-command-history + (helm-build-sync-source "Complex Command History" + :candidates (lambda () + ;; Use cdr to avoid adding + ;; `helm-complex-command-history' here. + (cl-loop for i in command-history + unless (equal i '(helm-complex-command-history)) + collect (prin1-to-string i))) + :action (helm-make-actions + "Eval" (lambda (candidate) + (and (boundp 'helm-sexp--last-sexp) + (setq helm-sexp--last-sexp candidate)) + (let ((command (read candidate))) + (unless (equal command (car command-history)) + (setq command-history (cons command command-history)))) + (run-with-timer 0.1 nil #'helm-sexp-eval candidate)) + "Edit and eval" (lambda (candidate) + (edit-and-eval-command "Eval: " (read candidate)))) + :persistent-action #'helm-sexp-eval + :multiline t)) + +;;;###autoload +(defun helm-complex-command-history () + "Preconfigured `helm' for complex command history." + (interactive) + (helm :sources 'helm-source-complex-command-history + :buffer "*helm complex commands*")) + +(provide 'helm-elisp) + +;;; helm-elisp.el ends here diff --git a/elpa/helm-20260424.1357/helm-epa.el b/elpa/helm-20260424.1357/helm-epa.el new file mode 100644 index 00000000..194bf9b4 --- /dev/null +++ b/elpa/helm-20260424.1357/helm-epa.el @@ -0,0 +1,269 @@ +;;; helm-epa.el --- helm interface for epa/epg -*- lexical-binding: t; -*- + +;; Copyright (C) 2012 ~ 2026 Thierry Volpiatto + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + + +;;; Code: + +(require 'helm) + +(eval-when-compile (require 'epg)) +(defvar epa-protocol) +(defvar epa-last-coding-system-specified) +(defvar epg-key-validity-alist) +(defvar mail-header-separator) +(declare-function epg-list-keys "epg") +(declare-function epg-make-context "epg") +(declare-function epg-key-sub-key-list "epg") +(declare-function epg-sub-key-id "epg") +(declare-function epg-key-user-id-list "epg") +(declare-function epg-user-id-string "epg") +(declare-function epg-user-id-validity "epg") +(declare-function epa-sign-region "epa") +(declare-function epa--read-signature-type "epa") +(declare-function epa-display-error "epa") +(declare-function epg-export-keys-to-string "epg") +(declare-function epg-context-armor "epg") +(declare-function epg-context-set-armor "epg") +(declare-function epg-delete-keys "epg") +(declare-function helm-read-file-name "helm-mode") + +(defvar helm-epa--list-only-secrets nil + "[INTERNAL] Used to pass MODE argument to `epg-list-keys'.") + +(defcustom helm-epa-actions '(("Show key" . epa--show-key) + ("encrypt file with key" . helm-epa-encrypt-file) + ("Copy keys to kill ring" . helm-epa-kill-keys-armor) + ("Delete keys" . helm-epa-delete-keys)) + "Actions for `helm-epa-list-keys'." + :type '(alist :key-type string :value-type symbol) + :group 'helm-misc) + +(defclass helm-epa (helm-source-sync) + ((init :initform (lambda () + (require 'epg) + (require 'epa))) + (candidates :initform 'helm-epa-get-key-list) + (keymap :initform 'helm-comp-read-map) + (mode-line :initform 'helm-comp-read-mode-line)) + "Allow building helm sources for GPG keys.") + +(defun helm-epa-get-key-list (&optional keys) + "Build candidate list for `helm-epa-list-keys'." + (cl-loop with all-keys = (or keys (epg-list-keys (epg-make-context epa-protocol) + nil helm-epa--list-only-secrets)) + for key in all-keys + for sublist = (car (epg-key-sub-key-list key)) + for subkey-id = (epg-sub-key-id sublist) + for uid-list = (epg-key-user-id-list key) + for uid = (epg-user-id-string (car uid-list)) + for validity = (epg-user-id-validity (car uid-list)) + collect (cons (format " %s %s %s" + (helm-aif (rassq validity epg-key-validity-alist) + (string (car it)) + "?") + (propertize + subkey-id + 'face (cl-case validity + (none 'epa-validity-medium) + ((revoked expired) + 'epa-validity-disabled) + (t 'epa-validity-high))) + (propertize + uid 'face 'font-lock-warning-face)) + key))) + +(defun helm-epa--select-keys (prompt keys) + "A helm replacement for `epa--select-keys'." + (catch 'nokey + (let ((result (helm :sources (helm-make-source "Epa select keys" 'helm-epa + :candidates (lambda () + (helm-epa-get-key-list keys)) + :action (lambda (_candidate) + (helm-marked-candidates))) + :prompt (and prompt (helm-epa--format-prompt prompt)) + :buffer "*helm epa*"))) + (if (or (equal result "") (null result)) + (throw 'nokey + (error "No keys selected, aborting")) + result)))) + +(defun helm-epa--format-prompt (prompt) + (let ((split (split-string prompt "\n"))) + (if (cdr split) + (format "%s\n(%s): " + (replace-regexp-in-string "\\.[\t ]*\\'" "" (car split)) + (replace-regexp-in-string "\\.[\t ]*\\'" "" (cadr split))) + (format "%s: " (replace-regexp-in-string "\\.[\t ]*\\'" "" (car split)))))) + +(defun helm-epa--read-signature-type-help () + (with-temp-buffer + (save-excursion + (insert + "n: Create a normal signature)\n" + "c: Create a cleartext signature)\n" + "d: Create a detached signature)")) + (while (re-search-forward "^\\(.\\):" nil t) + (helm-add-face-text-properties (match-beginning 1) (match-end 1) + 'font-lock-variable-name-face)) + (buffer-string))) + +(defun helm-epa--read-signature-type () + "A helm replacement for `epa--read-signature-type'." + (let ((answer (helm-read-answer "Signature type? [n,c,d,h]" + '("n" "c" "d") + #'helm-epa--read-signature-type-help))) + (helm-acase answer + ("n" 'normal) + ("c" 'clear) + ("d" 'detached)))) + +(defun helm-epa-collect-keys-from-candidates (candidates) + (cl-loop for c in candidates + collect (epg-sub-key-id + (car (epg-key-sub-key-list c))))) + +(defun helm-epa-collect-id-from-candidates (candidates) + (cl-loop for c in candidates + collect (epg-user-id-string + (car (epg-key-user-id-list c))))) + +(defun helm-epa-success-message (str keys ids) + (message str + (mapconcat (lambda (pair) + (concat (car pair) " " (cdr pair))) + (cl-loop for k in keys + for i in ids + collect (cons k i)) + "\n"))) + +;;;###autoload +(define-minor-mode helm-epa-mode + "Enable helm completion on gpg keys in epa functions." + :group 'helm-misc + :global t + (require 'epa) + (if helm-epa-mode + (progn + (advice-add 'epa--select-keys :override #'helm-epa--select-keys) + (advice-add 'epa--read-signature-type :override #'helm-epa--read-signature-type)) + (advice-remove 'epa--select-keys #'helm-epa--select-keys) + (advice-remove 'epa--read-signature-type #'helm-epa--read-signature-type))) + +(defun helm-epa-action-transformer (actions _candidate) + "Helm epa action transformer function." + (cond ((with-helm-current-buffer + (derived-mode-p 'message-mode 'mail-mode)) + (helm-append-at-nth + actions '(("Sign mail with key" . helm-epa-mail-sign) + ("Encrypt mail with key" . helm-epa-mail-encrypt)) + 3)) + (t actions))) + +(defun helm-epa-delete-keys (_candidate) + "Delete gpg marked keys from helm-epa." + (let ((context (epg-make-context epa-protocol)) + (keys (helm-marked-candidates))) + (message "Deleting gpg keys..") + (condition-case error + (epg-delete-keys context keys) + (error + (epa-display-error context) + (signal (car error) (cdr error)))) + (message "Deleting gpg keys done"))) + +(defun helm-epa-encrypt-file (_candidate) + "Select a file to encrypt with key CANDIDATE." + (let* ((file (helm-read-file-name "Encrypt file: ")) + (cands (helm-marked-candidates)) + (keys (helm-epa-collect-keys-from-candidates cands)) + (ids (helm-epa-collect-id-from-candidates cands))) + (epa-encrypt-file file cands) + (helm-epa-success-message "File encrypted with key(s):\n %s" + keys ids))) + +(defun helm-epa-kill-keys-armor (_candidate) + "Copy marked keys to kill ring." + (let ((keys (helm-marked-candidates)) + (context (epg-make-context epa-protocol))) + (with-no-warnings + (setf (epg-context-armor context) t)) + (condition-case error + (kill-new (epg-export-keys-to-string context keys)) + (error + (epa-display-error context) + (signal (car error) (cdr error)))))) + +(defun helm-epa-mail-sign (candidate) + "Sign email with key CANDIDATE." + (let ((key (epg-sub-key-id (car (epg-key-sub-key-list candidate)))) + (id (epg-user-id-string (car (epg-key-user-id-list candidate)))) + start end mode) + (save-excursion + (goto-char (point-min)) + (if (search-forward mail-header-separator nil t) + (forward-line)) + (setq epa-last-coding-system-specified + (or coding-system-for-write + (select-safe-coding-system (point) (point-max)))) + (let ((verbose current-prefix-arg)) + (setq start (point) + end (point-max) + mode (if verbose + (epa--read-signature-type) + 'clear)))) + ;; TODO Make non-interactive functions to replace epa-sign-region + ;; and epa-encrypt-region and inline them. + (with-no-warnings + (epa-sign-region start end candidate mode)) + (message "Mail signed with key `%s %s'" key id))) + +(defun helm-epa-mail-encrypt (_candidate) + "Encrypt email with key CANDIDATE." + (let ((cands (helm-marked-candidates)) + start end) + (save-excursion + (goto-char (point-min)) + (when (search-forward mail-header-separator nil t) + (forward-line)) + (setq start (point) + end (point-max)) + (setq epa-last-coding-system-specified + (or coding-system-for-write + (select-safe-coding-system start end)))) + ;; Don't let some read-only text stop us from encrypting. + (let ((inhibit-read-only t) + (keys (helm-epa-collect-keys-from-candidates cands)) + (ids (helm-epa-collect-id-from-candidates cands))) + (with-no-warnings + (epa-encrypt-region start end cands nil nil)) + (helm-epa-success-message "Mail encrypted with key(s):\n %s" + keys ids)))) + +;;;###autoload +(defun helm-epa-list-keys () + "List all gpg keys. +This is the helm interface for `epa-list-keys'." + (interactive) + (helm :sources + (helm-make-source "Epg list keys" 'helm-epa + :action-transformer 'helm-epa-action-transformer + :action 'helm-epa-actions) + :buffer "*helm epg list keys*")) + +(provide 'helm-epa) + +;;; helm-epa.el ends here diff --git a/elpa/helm-20260424.1357/helm-eshell.el b/elpa/helm-20260424.1357/helm-eshell.el new file mode 100644 index 00000000..5b36ab64 --- /dev/null +++ b/elpa/helm-20260424.1357/helm-eshell.el @@ -0,0 +1,495 @@ +;;; helm-eshell.el --- pcomplete and eshell completion for helm. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2026 Thierry Volpiatto + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: +;; +;; Enable like this in .emacs: +;; (add-hook 'eshell-mode-hook +;; (lambda () +;; (eshell-cmpl-initialize) +;; (define-key eshell-mode-map [remap eshell-pcomplete] 'helm-esh-pcomplete) +;; (define-key eshell-mode-map (kbd "M-s f") 'helm-eshell-prompts-all))) +;; (define-key eshell-mode-map (kbd "M-r") 'helm-eshell-history))) + + +;;; Code: +(require 'cl-lib) +(require 'helm) +(require 'helm-lib) +(require 'helm-help) +(require 'helm-elisp) + +(declare-function eshell-read-aliases-list "em-alias") +(declare-function eshell-send-input "esh-mode" (&optional use-region queue-p no-newline)) +(declare-function eshell-bol "esh-mode") +(declare-function eshell-parse-arguments "esh-arg" (beg end)) +(declare-function eshell-backward-argument "esh-mode" (&optional arg)) +(declare-function helm-quote-whitespace "helm-lib") +(declare-function eshell-skip-prompt "em-prompt") +(defvar eshell-special-chars-outside-quoting) + + +(defgroup helm-eshell nil + "Helm completion and history for Eshell." + :group 'helm) + + +(defcustom helm-eshell-fuzzy-match nil + "Enable fuzzy matching in `helm-esh-pcomplete' when non-nil." + :type 'boolean) + + +(defvar helm-eshell-history-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (define-key map (kbd "M-p") #'helm-next-line) + map) + "Keymap for `helm-eshell-history'.") + +(defvar helm-esh-completion-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (define-key map (kbd "TAB") #'helm-next-line) + map) + "Keymap for `helm-esh-pcomplete'.") + +(defvar helm-eshell--quit-flag nil) + + +;; Internal. +(defvar helm-ec-target "") +(defun helm-ec-insert (_candidate) + "Replace text at point with CANDIDATE. +The function that call this should set `helm-ec-target' to thing +at point." + (set (make-local-variable 'comint-file-name-quote-list) + eshell-special-chars-outside-quoting) + (let ((pt (point))) + (when (and helm-ec-target + (search-backward helm-ec-target nil t) + (string= (buffer-substring (point) pt) helm-ec-target)) + (delete-region (point) pt))) + (when (string-match "\\`\\*" helm-ec-target) (insert "*")) + (let ((marked (helm-marked-candidates))) + (prog1 t ;; Makes helm returns t on action. + (insert + (mapconcat + (lambda (x) + (cond ((string-match "\\`~/" helm-ec-target) + ;; Strip out the first escape char added by + ;; `comint-quote-filename' before "~" (Bug#1803). + (substring (comint-quote-filename (abbreviate-file-name x)) 1)) + ((string-match "\\`/" helm-ec-target) + (comint-quote-filename x)) + (t + (concat (and (string-match "\\`[.]/" helm-ec-target) "./") + (comint-quote-filename + (file-relative-name x)))))) + marked " ") + (or (helm-aand (car (last marked)) + (string-match-p "/\\'" it) + "") + " "))))) + +(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 + (with-helm-current-buffer + (let* ((pcomplete-stub) + pcomplete-seen pcomplete-norm-func + pcomplete-args pcomplete-last pcomplete-index + (pcomplete-autolist pcomplete-autolist) + (pcomplete-suffix-list pcomplete-suffix-list) + (table (pcomplete-completions)) + (entry (or (try-completion helm-pattern + (pcomplete-entries)) + helm-pattern))) + (cl-loop ;; expand entry too to be able to compare it with file-cand. + with exp-entry = (and (stringp entry) + (not (string= entry "")) + (file-name-as-directory + (expand-file-name entry default-directory))) + with comps = (all-completions pcomplete-stub table) + unless comps return (prog1 nil + ;; Don't add final space when + ;; there is no completion (Bug#1990). + (setq helm-eshell--quit-flag t) + (message "No completions of %s" pcomplete-stub)) + for i in comps + ;; Transform the relative names to abs names. + for file-cand = (and exp-entry + (if (file-remote-p i) i + (expand-file-name + i (file-name-directory + (if (directory-name-p pcomplete-stub) + entry + (directory-file-name entry)))))) + ;; Compare them to avoid dups. + for file-entry-p = (and (stringp exp-entry) + (stringp file-cand) + ;; Fix :/tmp/foo/ $ cd foo + (not (file-directory-p file-cand)) + (file-equal-p exp-entry file-cand)) + if (and file-cand (or (file-remote-p file-cand) + (file-exists-p file-cand)) + (not file-entry-p)) + collect file-cand into ls + else + ;; Avoid adding entry here. + unless file-entry-p collect i into ls + finally return + (if (and exp-entry + (file-directory-p exp-entry) + ;; If the car of completion list is + ;; an executable, probably we are in + ;; command completion, so don't add a + ;; possible file related entry here. + (and ls (not (executable-find (car ls)))) + ;; Don't add entry if already in prompt. + (not (file-equal-p exp-entry pcomplete-stub))) + (append (list exp-entry) + ;; Entry should not be here now but double check. + (remove entry ls)) + ls)))))) + +;;; Eshell history. +;; +;; +(defclass helm-eshell-history-source (helm-source-sync) + ((init :initform + (lambda () + ;; Same comment as in `helm-source-esh'. + (remove-hook 'minibuffer-setup-hook 'eshell-mode))) + (candidates + :initform + (lambda () + (with-helm-current-buffer + (cl-loop for c from 0 to (ring-length eshell-history-ring) + for elm = (eshell-get-history c) + unless (and (member elm lst) + eshell-hist-ignoredups) + collect elm into lst + finally return lst)))) + (nomark :initform t) + (multiline :initform t) + (keymap :initform 'helm-eshell-history-map) + (candidate-number-limit :initform 9999) + (action :initform (lambda (candidate) + (eshell-kill-input) + (insert candidate)))) + "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 Bug#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 + :keymap helm-esh-completion-map)) + +(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*" + :resume 'noresume + :input input)) + +;;;###autoload +(defun helm-esh-pcomplete () + "Preconfigured `helm' to provide Helm completion in Eshell." + (interactive) + (let* ((helm-quit-if-no-candidate t) + (helm-execute-action-at-once-if-one t) + (end (point-marker)) + (beg (save-excursion (eshell-bol) (point))) + (args (catch 'eshell-incomplete + (eshell-parse-arguments beg end))) + (target + (or (and (looking-back " " (1- (point))) " ") + (buffer-substring-no-properties + (save-excursion + (eshell-backward-argument 1) (point)) + end))) + (users-comp (string= target "~")) + (first (car args)) ; Maybe lisp delimiter "(". + last ; Will be the last but parsed by pcomplete. + del-space + del-dot) + (setq helm-ec-target (or target " ") + end (point) + ;; Reset beg for `with-helm-show-completion'. + beg (or (and target (not (string= target " ")) + (- end (length target))) + ;; Nothing at point. + (progn (insert " ") (setq del-space t) (point)))) + (when (string-match "\\`[~.]*.*/[.]\\'" target) + ;; Fix completion on + ;; "~/.", "~/[...]/.", and "../." + (delete-char -1) (setq del-dot t) + (setq helm-ec-target (substring helm-ec-target 0 (1- (length helm-ec-target))))) + (cond ((eq first ?\() + (helm-lisp-completion-at-point)) + ;; In eshell `pcomplete-parse-arguments' is called + ;; with `pcomplete-parse-arguments-function' + ;; locally bound to `eshell-complete-parse-arguments' + ;; which is calling `lisp-complete-symbol', + ;; calling it before would popup the + ;; *completions* buffer. + (t (setq last (replace-regexp-in-string + "\\`\\*" "" + (car (last (ignore-errors + (pcomplete-parse-arguments)))))) + ;; Set helm-eshell--quit-flag to non-nil only on + ;; quit, this tells to not add final suffix when quitting + ;; helm. + (add-hook 'helm-quit-hook #'helm-eshell--quit-hook-fn) + (with-helm-show-completion beg end + (unwind-protect + (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 + ;; it when nothing found. + (and del-space (looking-back "\\s-" (1- (point))) + (delete-char -1)) + (if (and (null helm-eshell--quit-flag) + (and (stringp last) (file-directory-p last)) + (looking-back "\\([.]\\{1,2\\}\\|[^/]\\)\\'" + (1- (point)))) + (prog1 t (insert "/")) + ;; We need another flag for space here, but + ;; global to pass it to `helm-quit-hook', this + ;; space is added when point is just after + ;; previous completion and there is no + ;; more completion, see Bug#1832. + (unless (or helm-eshell--quit-flag + (looking-back "/\\'" (1- (point)))) + (prog1 t (insert " "))) + (when (and helm-eshell--quit-flag + (string-match-p "[.]\\{2\\}\\'" last)) + (insert "/")))) + (remove-hook 'helm-quit-hook #'helm-eshell--quit-hook-fn) + (setq helm-eshell--quit-flag nil))))))) + +(defun helm-eshell--quit-hook-fn () + (setq helm-eshell--quit-flag t)) + +;;;###autoload +(defun helm-eshell-history () + "Preconfigured Helm for Eshell history." + (interactive) + (let* ((end (point)) + (beg (save-excursion (eshell-bol) (point))) + (input (buffer-substring beg end)) + flag-empty) + (when (eq beg end) + (insert " ") + (setq flag-empty t) + (setq end (point))) + (unwind-protect + (with-helm-show-completion beg end + (helm :sources (helm-make-source "Eshell history" + 'helm-eshell-history-source + :fuzzy-match helm-eshell-fuzzy-match) + :buffer "*helm eshell history*" + :resume 'noresume + :input input)) + (when (and flag-empty + (looking-back " " (1- (point)))) + (delete-char -1))))) + + +;;; Eshell prompts +;; +(defface helm-eshell-prompts-promptidx + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :foreground "cyan")) + "Face used to highlight Eshell prompt index.") + +(defface helm-eshell-prompts-buffer-name + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :foreground "green")) + "Face used to highlight Eshell buffer name.") + +(defcustom helm-eshell-prompts-promptidx-p t + "Show prompt number." + :type 'boolean) + +(defvar helm-eshell-prompts-keymap + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (define-key map (kbd "C-c o") #'helm-eshell-prompts-other-window) + (define-key map (kbd "C-c C-o") #'helm-eshell-prompts-other-frame) + map) + "Keymap for `helm-eshell-prompt-all'.") + +(defvar eshell-prompt-regexp) +(defvar eshell-highlight-prompt) + +(defun helm-eshell-prompts-list (&optional buffer) + "List the prompts in Eshell BUFFER. + +Return a list of (\"prompt\" (point) (buffer-name) prompt-index)) +E.g. (\"ls\" 162 \"*eshell*\" 3). +If BUFFER is nil, use current buffer." + (with-current-buffer (or buffer (current-buffer)) + (when (eq major-mode 'eshell-mode) + (save-excursion + (goto-char (point-min)) + (let (result (count 1)) + (helm-awhile (re-search-forward eshell-prompt-regexp nil t) + (when (or (and eshell-highlight-prompt + (get-text-property (match-beginning 0) 'read-only)) + (null eshell-highlight-prompt)) + (push (list (buffer-substring-no-properties + it (pos-eol)) + it (buffer-name) count) + result) + (setq count (1+ count)))) + (nreverse result)))))) + +(defun helm-eshell-prompts-list-all () + "List the prompts of all Eshell buffers. +See `helm-eshell-prompts-list'." + (cl-loop for b in (buffer-list) + append (helm-eshell-prompts-list b))) + +(defun helm-eshell-prompts-transformer (candidates &optional all) + ;; ("ls" 162 "*eshell*" 3) => ("*eshell*:3:ls" . ("ls" 162 "*eshell*" 3)) + (cl-loop for (prt pos buf id) in candidates + collect `(,(concat + (when all + (concat (propertize + buf + 'face 'helm-eshell-prompts-buffer-name) + ":")) + (when helm-eshell-prompts-promptidx-p + (concat (propertize + (number-to-string id) + 'face 'helm-eshell-prompts-promptidx) + ":")) + prt) + . ,(list prt pos buf id)))) + +(defun helm-eshell-prompts-all-transformer (candidates) + (helm-eshell-prompts-transformer candidates t)) + +(defun helm-eshell-prompts-goto (candidate &optional action) + ;; Candidate format: ("ls" 162 "*eshell*" 3) + (unless action (setq action #'switch-to-buffer)) + (let ((buf (nth 2 candidate))) + (unless (and (string= (buffer-name) buf) + (eq action 'switch-to-buffer)) + (funcall action buf)) + (goto-char (nth 1 candidate)) + (recenter))) + +(defun helm-eshell-prompts-goto-other-window (candidate) + (helm-eshell-prompts-goto candidate 'switch-to-buffer-other-window)) + +(defun helm-eshell-prompts-goto-other-frame (candidate) + (helm-eshell-prompts-goto candidate 'switch-to-buffer-other-frame)) + +(helm-make-command-from-action helm-eshell-prompts-other-window + "Switch to eshell prompt in other window." + 'helm-eshell-prompts-goto-other-window) + +(helm-make-command-from-action helm-eshell-prompts-other-frame + "Switch to eshell prompt in other frame." + 'helm-eshell-prompts-goto-other-frame) + +;;;###autoload +(defun helm-eshell-prompts () + "Pre-configured `helm' to browse the prompts of the current Eshell." + (interactive) + (if (eq major-mode 'eshell-mode) + (helm :sources + (helm-build-sync-source "Eshell prompts" + :candidates (helm-eshell-prompts-list) + :candidate-transformer 'helm-eshell-prompts-transformer + :action '(("Go to prompt" . helm-eshell-prompts-goto))) + :buffer "*helm Eshell prompts*") + (message "Current buffer is not an Eshell buffer"))) + +;;;###autoload +(defun helm-eshell-prompts-all () + "Pre-configured `helm' to browse the prompts of all Eshell sessions." + (interactive) + (helm :sources + (helm-build-sync-source "All Eshell prompts" + :candidates (helm-eshell-prompts-list-all) + :candidate-transformer 'helm-eshell-prompts-all-transformer + :action '(("Go to prompt" . helm-eshell-prompts-goto) + ("Go to prompt in other window `C-c o`" . + helm-eshell-prompts-goto-other-window) + ("Go to prompt in other frame `C-c C-o`" . + helm-eshell-prompts-goto-other-frame)) + :keymap helm-eshell-prompts-keymap) + :buffer "*helm Eshell all prompts*")) + +(provide 'helm-eshell) + +;;; helm-eshell ends here diff --git a/elpa/helm-20260424.1357/helm-eval.el b/elpa/helm-20260424.1357/helm-eval.el new file mode 100644 index 00000000..bb92947f --- /dev/null +++ b/elpa/helm-20260424.1357/helm-eval.el @@ -0,0 +1,221 @@ +;;; helm-eval.el --- eval expressions from helm. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2026 Thierry Volpiatto + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Code: +(require 'cl-lib) +(require 'helm) +(require 'helm-help) +(require 'eldoc) +(require 'edebug) + +(declare-function helm-lisp-completion-at-point "helm-elisp.el") +(declare-function helm-elisp-show-doc-modeline "helm-elisp.el") +(defvar helm-elisp-help-function) + +(defgroup helm-eval nil + "Eval related Applications and libraries for Helm." + :group 'helm) + +(defcustom helm-eldoc-in-minibuffer-show-fn + 'helm-show-info-in-mode-line + "A function to display eldoc info. +Should take one arg: the string to display." + :group 'helm-eval + :type 'symbol) + +(defcustom helm-show-info-in-mode-line-delay 12 + "Eldoc will show info in mode-line during this delay if user is idle." + :type 'integer + :group 'helm-eval) + + +;;; Eldoc compatibility between emacs-24 and emacs-25 +;; +(if (require 'elisp-mode nil t) ; emacs-25 + ;; Maybe the eldoc functions have been + ;; already aliased by eldoc-eval. + (cl-loop for (f . a) in '((eldoc-current-symbol . + elisp--current-symbol) + (eldoc-fnsym-in-current-sexp . + elisp--fnsym-in-current-sexp) + (eldoc-get-fnsym-args-string . + elisp-get-fnsym-args-string) + (eldoc-get-var-docstring . + elisp-get-var-docstring)) + unless (fboundp f) + do (defalias f a)) + ;; Emacs-24. + (declare-function eldoc-current-symbol "eldoc") + (declare-function eldoc-get-fnsym-args-string "eldoc" (sym &optional index)) + (declare-function eldoc-get-var-docstring "eldoc" (sym)) + (declare-function eldoc-fnsym-in-current-sexp "eldoc")) + +;;; Evaluation Result +;; +;; +;; Internal +(defvar helm-eldoc-active-minibuffers-list nil) + +(defvar helm-eval-expression-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (define-key map (kbd "") #'helm-eval-new-line-and-indent) + (define-key map (kbd "") #'lisp-indent-line) + (define-key map (kbd "") #'helm-lisp-completion-at-point) + (define-key map (kbd "C-p") #'previous-line) + (define-key map (kbd "C-n") #'next-line) + (define-key map (kbd "") #'previous-line) + (define-key map (kbd "") #'next-line) + (define-key map (kbd "") #'forward-char) + (define-key map (kbd "") #'backward-char) + map)) + +(defclass helm-evaluation-result-class (helm-source-dummy) + ((echo-input-in-header-line + :initarg :echo-input-in-header-line + :initform 'never))) + +(defun helm-build-evaluation-result-source () + (helm-make-source "Evaluation Result" 'helm-evaluation-result-class + :multiline t + :mode-line "C-RET: nl-and-indent, M-tab: reindent, C-tab:complete, C-p/n: next/prec-line." + :filtered-candidate-transformer + (lambda (_candidates _source) + (list + (condition-case nil + (with-helm-current-buffer + (pp-to-string + (if edebug-active + (edebug-eval-expression + (read helm-pattern)) + (eval (read helm-pattern) t)))) + (error "Error")))) + :nohighlight t + :keymap helm-eval-expression-map + :action `(("Copy result to kill-ring" . ,(lambda (candidate) + (kill-new + (replace-regexp-in-string + "\n" "" candidate)) + (message "Result copied to kill-ring"))) + ("copy sexp to kill-ring" . ,(lambda (_candidate) + (kill-new helm-input) + (message "Sexp copied to kill-ring")))))) + +(defun helm-eval-new-line-and-indent () + (interactive) + (newline) (lisp-indent-line)) + +(defun helm-eldoc-store-minibuffer () + "Store minibuffer buffer name in `helm-eldoc-active-minibuffers-list'." + (with-selected-window (minibuffer-window) + (push (current-buffer) helm-eldoc-active-minibuffers-list))) + +;; From emacs-28.1: As the eldoc API is nowaday a pain to use, try to +;; provide some eldoc in mode-line the best as possible (may break at +;; some point). +(defun helm-eldoc-show-in-eval () + "Return eldoc in mode-line for current minibuffer input." + (let ((buf (window-buffer (active-minibuffer-window)))) + (condition-case err + (when (member buf helm-eldoc-active-minibuffers-list) + (with-current-buffer buf + (let* ((info-fn (eldoc-fnsym-in-current-sexp)) + (vsym (eldoc-current-symbol)) + (sym (car info-fn)) + (vardoc (eldoc-get-var-docstring vsym)) + (doc (or vardoc + (eldoc-get-fnsym-args-string + sym (cadr info-fn)))) + (all (format "%s: %s" + (propertize + (symbol-name (if vardoc vsym sym)) + 'face (if vardoc + 'font-lock-variable-name-face + 'font-lock-function-name-face)) + doc))) + (when doc (funcall helm-eldoc-in-minibuffer-show-fn all))))) + (error (message "Eldoc in minibuffer error: %S" err) nil)))) + +(defun helm-show-info-in-mode-line (str) + "Display string STR in mode-line." + (save-selected-window + (with-helm-window + (let ((mode-line-format (concat " " str))) + (force-mode-line-update) + (sit-for helm-show-info-in-mode-line-delay)) + (force-mode-line-update)))) + +;;; Calculation Result +;; +;; +(defvar helm-source-calculation-result + (helm-build-dummy-source "Calculation Result" + :filtered-candidate-transformer (lambda (_candidates _source) + (list + (condition-case err + (let ((result (calc-eval helm-pattern))) + (if (listp result) + (error "At pos %s: %s" + (car result) (cadr result)) + result)) + (error (cdr err))))) + :nohighlight t + :action `(("Copy result to kill-ring" . ,(lambda (candidate) + (kill-new candidate) + (message "Result \"%s\" copied to kill-ring" + candidate))) + ("Copy operation to kill-ring" . ,(lambda (_candidate) + (kill-new helm-input) + (message "Calculation copied to kill-ring")))))) + +;;;###autoload +(defun helm-eval-expression (arg) + "Preconfigured `helm' for `helm-source-evaluation-result'." + (interactive "P") + (let ((helm-elisp-help-function #'helm-elisp-show-doc-modeline)) + (helm :sources (helm-build-evaluation-result-source) + :input (when arg (thing-at-point 'sexp)) + :buffer "*helm eval*" + :echo-input-in-header-line nil + :history 'read-expression-history))) + +(defvar eldoc-idle-delay) +;;;###autoload +(defun helm-eval-expression-with-eldoc () + "Preconfigured `helm' for `helm-source-evaluation-result' with `eldoc' support." + (interactive) + (let ((timer (run-with-idle-timer + eldoc-idle-delay 'repeat + #'helm-eldoc-show-in-eval))) + (unwind-protect + (minibuffer-with-setup-hook + #'helm-eldoc-store-minibuffer + (call-interactively 'helm-eval-expression)) + (and timer (cancel-timer timer)) + (setq helm-eldoc-active-minibuffers-list + (cdr helm-eldoc-active-minibuffers-list))))) + +;;;###autoload +(defun helm-calcul-expression () + "Preconfigured `helm' for `helm-source-calculation-result'." + (interactive) + (helm :sources 'helm-source-calculation-result + :buffer "*helm calcul*")) + +(provide 'helm-eval) + +;;; helm-eval.el ends here diff --git a/elpa/helm-20260424.1357/helm-external.el b/elpa/helm-20260424.1357/helm-external.el new file mode 100644 index 00000000..2179354c --- /dev/null +++ b/elpa/helm-20260424.1357/helm-external.el @@ -0,0 +1,264 @@ +;;; helm-external.el --- Run Externals commands within Emacs with helm completion. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2026 Thierry Volpiatto + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Code: + +(require 'cl-lib) +(require 'helm) +(require 'helm-help) +(require 'helm-net) + +(declare-function helm-comp-read "helm-mode") + + +(defgroup helm-external nil + "External related Applications and libraries for Helm." + :group 'helm) + +(defcustom helm-raise-command nil + "A shell command to jump to a window running specific program. +Need external program wmctrl. +This will be use with `format', so use something like \"wmctrl -xa %s\"." + :type 'string + :group 'helm-external) + +(defcustom helm-external-programs-associations nil + "Alist to store externals programs associated with file extension. +This variable overhide setting in .mailcap file. +E.g.: \\='((\"jpg\" . \"gqview\") (\"pdf\" . \"xpdf\")) " + :type '(alist :key-type string :value-type string) + :group 'helm-external) + +(defcustom helm-default-external-file-browser "nautilus" + "Default external file browser for your system. +Directories will be opened externally with it when opening file +externally in `helm-find-files'. +Set to nil if you do not have an external file browser or do not +want to use it. +Windows users should set that to \"explorer.exe\"." + :group 'helm-external + :type 'string) + +(defvar helm-open-file-externally-after-hook nil + "Hook that run after opening a file with external program.") + +(defvar helm-open-file-externally-after-finish-hook nil + "Hook that run after external program finish.") + +;;; Internals +(defvar helm-external-command-history nil) +(defvar helm-external-commands-list nil + "A list of all external commands the user can execute. +If this variable is not set by the user, it will be calculated +automatically.") + +(defun helm-external-commands-list-1 (&optional sort) + "Return a list of all external commands the user can execute. +If `helm-external-commands-list' is non-nil it will return its +contents. Else it calculates all external commands and sets +`helm-external-commands-list'." + (or helm-external-commands-list + (setq helm-external-commands-list + (cl-loop for dir in (split-string (getenv "PATH") path-separator) + when (and (file-exists-p dir) + (file-accessible-directory-p dir)) + for lsdir = (cl-loop for i in (directory-files dir t) + for bn = (file-name-nondirectory i) + when (and (not (member bn completions)) + (not (file-directory-p i)) + (file-executable-p i)) + collect bn) + append lsdir into completions + finally return + (if sort (sort completions 'string-lessp) completions))))) + +(defun helm-run-or-raise (exe &optional files detached) + "Run asynchronously EXE or jump to the application window. +If EXE is already running just jump to his window if +`helm-raise-command' is non-nil. +When FILES argument is provided run EXE with FILES. +When argument DETACHED is non nil, detach process from Emacs." + (let* ((proc-name (replace-regexp-in-string + "(" "" (car (split-string exe)))) + (fmt-file (lambda (file) + (shell-quote-argument + (if (eq system-type 'windows-nt) + (helm-w32-prepare-filename file) + (expand-file-name file))))) + (file-arg (and files (mapconcat fmt-file files " "))) + process-connection-type proc) + (when (and files detached (not (string-match "%s &)\\'" exe))) + (setq exe (format "(%s &)" exe))) + (when (member proc-name helm-external-commands-list) + ;; Allow adding more files to the current process if it is + ;; already running (i.e. Don't just raise it without sending + ;; files) we assume program doesn't start a new + ;; process (like firefox, transmission etc...). + (if files + (cond ((string-match "%s &)\\'" exe) + (message "Starting and detaching `%s' from Emacs" proc-name) + (call-process-shell-command (format exe file-arg))) + (t + (message "Starting %s..." proc-name) + (setq proc + (start-process-shell-command + proc-name nil (if (string-match "%s" exe) + (format exe file-arg) + (format "%s %s" exe file-arg)))))) + ;; Just jump to the already running program instance or start + ;; a new process. + (if (get-process proc-name) + (if helm-raise-command + (run-at-time 0.1 nil #'shell-command + (format helm-raise-command proc-name)) + (error "Error: %s is already running" proc-name)) + (if (and detached (not (memq system-type '(windows-nt ms-dos)))) + (progn + (message "Starting and detaching `%s' from Emacs" proc-name) + (call-process-shell-command (format "(%s &)" exe))) + (when detached + (user-error "Detaching programs not supported on `%s'" system-type)) + (setq proc (start-process-shell-command proc-name nil exe))))) + (when proc + (set-process-sentinel + proc + (lambda (process event) + (when (and (string= event "finished\n") + helm-raise-command + (not (helm-get-pid-from-process-name proc-name))) + (run-hooks 'helm-open-file-externally-after-finish-hook) + (shell-command (format helm-raise-command "emacs"))) + (message "%s process...Finished." process)))) + ;; Move command on top list. + (setq helm-external-commands-list + (cons proc-name + (delete proc-name helm-external-commands-list)))))) + +(defun helm-get-mailcap-for-file (filename) + "Get the command to use for FILENAME from mailcap files." + (mailcap-parse-mailcaps) + (let* ((ext (file-name-extension filename)) + (mime (when ext (mailcap-extension-to-mime ext))) + (result (when mime (mailcap-mime-info mime)))) + ;; If elisp file have no associations in .mailcap + ;; `mailcap-maybe-eval' is returned, in this case just return nil. + (when (stringp result) (helm-basename result)))) + +(defun helm-get-default-program-for-file (filename) + "Try to find a default program to open FILENAME. +Try first in `helm-external-programs-associations' and then in +mailcap file. If nothing found return nil." + (let* ((ext (file-name-extension filename)) + (def-prog (assoc-default ext helm-external-programs-associations))) + (cond ((and def-prog (not (string= def-prog ""))) def-prog) + ((and helm-default-external-file-browser (file-directory-p filename)) + helm-default-external-file-browser) + (t (helm-get-mailcap-for-file filename))))) + +(defun helm-open-file-externally (_file) + "Open FILE with an external program. +Try to guess which program to use with +`helm-get-default-program-for-file'. +If not found or a prefix arg is given query the user which tool +to use." + (let* ((files (helm-marked-candidates :with-wildcard t)) + (fname (expand-file-name (car files))) + (collection (helm-external-commands-list-1 'sort)) + (def-prog (helm-get-default-program-for-file fname)) + (program (if (or helm-current-prefix-arg (not def-prog)) + ;; Prefix arg or no default program. + (prog1 + (helm-comp-read + "Program: " collection + :must-match t + :name "Open file Externally" + :history 'helm-external-command-history) + ;; Always prompt to set this program as default. + (setq def-prog nil)) + ;; No prefix arg or default program exists. + def-prog))) + (unless (or def-prog ; Association exists, no need to record it. + ;; Don't try to record non--filenames associations (e.g urls). + (not (file-exists-p fname))) + (when + (y-or-n-p + (format + "Do you want to make `%s' the default program for this kind of files? " + program)) + (helm-aif (assoc (file-name-extension fname) + helm-external-programs-associations) + (setq helm-external-programs-associations + (delete it helm-external-programs-associations))) + (push (cons (file-name-extension fname) + (helm-read-string + "Program (Add args maybe and confirm): " program)) + helm-external-programs-associations) + (customize-save-variable 'helm-external-programs-associations + helm-external-programs-associations))) + (helm-run-or-raise program files) + (run-hooks 'helm-open-file-externally-after-hook) + (setq helm-external-command-history + (cl-loop for i in helm-external-command-history + when (executable-find i) collect i)))) + +(defun helm-run-external-command-action (candidate &optional detached) + (helm-run-or-raise candidate nil detached) + (setq helm-external-command-history + (cons candidate + (delete candidate + helm-external-command-history)))) + +(defclass helm-external-commands (helm-source-in-buffer) + ((filtered-candidate-transformer + :initform (lambda (candidates _source) + (cl-loop for c in candidates + if (get-process c) + collect (propertize c 'face 'font-lock-type-face) + else collect c))) + (must-match :initform t) + (nomark :initform t) + (action :initform + (helm-make-actions + "Run program" 'helm-run-external-command-action + (lambda () + (unless (memq system-type '(windows-nt ms-dos)) + "Run program detached")) + (lambda (candidate) + (helm-run-external-command-action candidate 'detached)))))) + +;;;###autoload +(defun helm-run-external-command () + "Preconfigured `helm' to run External PROGRAM asyncronously from Emacs. +If program is already running try to run `helm-raise-command' if +defined otherwise exit with error. You can set your own list of +commands with `helm-external-commands-list'." + (interactive) + (helm :sources `(,(helm-make-source "External Commands history" 'helm-external-commands + :data helm-external-command-history) + ,(helm-make-source "External Commands" 'helm-external-commands + :data (helm-external-commands-list-1 'sort))) + :buffer "*helm externals commands*" + :prompt "RunProgram: ") + ;; Remove from history no more valid executables. + (setq helm-external-command-history + (cl-loop for i in helm-external-command-history + when (executable-find i) collect i))) + + +(provide 'helm-external) + +;;; helm-external.el ends here diff --git a/elpa/helm-20260424.1357/helm-fd.el b/elpa/helm-20260424.1357/helm-fd.el new file mode 100644 index 00000000..f9c2a4bc --- /dev/null +++ b/elpa/helm-20260424.1357/helm-fd.el @@ -0,0 +1,153 @@ +;;; helm-fd.el --- helm interface for fd command line tool. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2026 Thierry Volpiatto + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Code: + +(require 'helm) +(require 'helm-types) + +(declare-function ansi-color-apply "ansi-color.el") +(declare-function split-string-shell-command "shell.el") + +(defvar helm-fd-executable "fd" + "The fd shell command executable.") + +(defcustom helm-fd-switches '("--no-ignore" "--hidden" "--type" "f" "--type" "d" "--color" "always") + "A list of options to pass to fd shell command." + :type '(repeat string) + :group 'helm-files) + +(defcustom helm-fd-mode-line-function 'helm-fd-default-mode-line + "Function called when `fd' process is finished to format mode-line." + :type 'function + :group 'helm-files) + +(defface helm-fd-finish + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :foreground "green")) + "Face used in mode line when fd process ends." + :group 'helm-grep-faces) + +(defvar helm-fd-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-generic-files-map) + (define-key map (kbd "C-]") 'undefined) + (define-key map (kbd "DEL") 'helm-delete-backward-no-update) + (define-key map (kbd "M-") 'helm-fd-next-directory) + (define-key map (kbd "M-") 'helm-fd-previous-directory) + map)) + +(defun helm-fd-next-directory-1 (arg) + (with-helm-window + (let ((cur-dir (helm-basedir (helm-get-selection)))) + (while (equal cur-dir (helm-basedir (helm-get-selection))) + (if (> arg 0) + (helm-next-line) + (helm-previous-line)))))) + +(defun helm-fd-next-directory () + "Move to next directory in a helm-fd source." + (interactive) + (with-helm-alive-p + (helm-fd-next-directory-1 1))) + +(defun helm-fd-previous-directory () + "Move to previous directory in a helm-fd source." + (interactive) + (with-helm-alive-p + (helm-fd-next-directory-1 -1))) + +(defclass helm-fd-class (helm-source-async) + ((candidates-process :initform 'helm-fd-process) + (requires-pattern :initform 2) + (candidate-number-limit :initform 20000) + (nohighlight :initform t) + (help-message :initform 'helm-fd-help-message) + (filtered-candidate-transformer :initform 'helm-fd-fct) + (action :initform 'helm-type-file-actions) + (keymap :initform 'helm-fd-map))) + +(defun helm-fd-process () + "Initialize fd process in an helm async source." + (let* (process-connection-type + (cmd (append helm-fd-switches + (or (and (fboundp #'split-string-shell-command) + (split-string-shell-command helm-pattern)) + (split-string helm-pattern)))) + (proc (apply #'start-process "fd" nil helm-fd-executable cmd)) + (start-time (float-time)) + (fd-version (replace-regexp-in-string + "\n" "" + (shell-command-to-string + (concat helm-fd-executable " --version"))))) + (helm-log "helm-fd-process" "Fd command:\nfd %s" + (mapconcat 'identity cmd " ")) + (helm-log "helm-fd-process" "VERSION: %s" fd-version) + (prog1 + proc + (set-process-sentinel + proc (lambda (process event) + (if (or (string= event "finished\n") + (process-get process 'reach-limit)) + (with-helm-window + (when helm-fd-mode-line-function + (funcall helm-fd-mode-line-function start-time fd-version) + (force-mode-line-update))) + (helm-log "helm-fd-process sentinel" "Error: Fd %s" + (replace-regexp-in-string "\n" "" event)))))))) + +(defun helm-fd-default-mode-line (start-time fd-version) + "Format mode-line with START-TIME and FD-VERSION, as well as `fd' results." + (setq mode-line-format + `(" " mode-line-buffer-identification " " + (:eval (format "L%s" (helm-candidate-number-at-point))) " " + (:eval (propertize + (format + "[%s process finished in %.2fs - (%s results)] " + ,fd-version + ,(- (float-time) start-time) + (helm-get-candidate-number)) + 'face 'helm-fd-finish))))) + +(defun helm-fd-fct (candidates _source) + "The filtered-candidate-transformer function for helm-fd." + (cl-loop for i in candidates + for fname = (ansi-color-apply i) + if helm-ff-icon-mode collect + (let* ((abs (expand-file-name fname default-directory)) + (icon (if (file-directory-p abs) + (helm-x-icons-generic "file-directory") + (helm-x-icons-icon-for-file (helm-basename fname))))) + (cons (concat icon fname) fname)) + else collect fname)) + +(defun helm-fd-1 (directory) + "Run fd shell command on DIRECTORY with helm interface." + (cl-assert (executable-find helm-fd-executable) nil "Could not find fd executable") + (cl-assert (not (file-remote-p directory)) nil "Fd not supported on remote directories") + (let ((default-directory directory)) + (helm :sources (helm-make-source "Fd" 'helm-fd-class + :header-name + (lambda (name) + (format "%s (%s)" + name (abbreviate-file-name default-directory)))) + :buffer "*helm fd*"))) + + +(provide 'helm-fd) + +;;; helm-fd.el ends here diff --git a/elpa/helm-20260424.1357/helm-files.el b/elpa/helm-20260424.1357/helm-files.el new file mode 100644 index 00000000..6196a0c2 --- /dev/null +++ b/elpa/helm-20260424.1357/helm-files.el @@ -0,0 +1,7268 @@ +;;; helm-files.el --- helm file browser and related. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2026 Thierry Volpiatto + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Code: + +(require 'cl-lib) +(require 'helm) +(require 'helm-types) +(require 'helm-utils) +(require 'helm-grep) +(require 'helm-help) +(require 'helm-locate) +(require 'helm-tags) +(require 'helm-buffers) +(require 'tramp) +(eval-when-compile + (require 'thingatpt) + (require 'ffap) + (require 'dired-aux) + (require 'dired-x)) +(require 'filenotify) +(require 'image-mode) +(require 'image-dired) +(require 'helm-x-icons) + +(declare-function find-library-name "find-func.el" (library)) +(declare-function w32-shell-execute "ext:w32fns.c" (operation document &optional parameters show-flag)) +(declare-function gnus-dired-attach "ext:gnus-dired.el" (files-to-attach)) +(declare-function eshell-read-aliases-list "em-alias") +(declare-function eshell-send-input "esh-mode" (&optional use-region queue-p no-newline)) +(declare-function eshell-kill-input "esh-mode") +(declare-function eshell-bol "esh-mode") +(declare-function eshell-reset "esh-mode.el") +(declare-function eshell/cd "em-dirs.el") +(declare-function eshell-next-prompt "em-prompt.el") +(declare-function eshell-resume-eval "esh-cmd") +(declare-function helm-ls-git "ext:helm-ls-git") +(declare-function helm-hg-find-files-in-project "ext:helm-ls-hg") +(declare-function helm-ls-svn-ls "ext:helm-ls-svn") +(declare-function helm-gid "helm-id-utils.el") +(declare-function helm-find-1 "helm-find") +(declare-function helm-fd-1 "helm-fd") +(declare-function helm-get-default-program-for-file "helm-external") +(declare-function helm-open-file-externally "helm-external") +(declare-function helm-comp-read "helm-mode") +(declare-function helm-read-file-name "helm-mode") +(declare-function term-line-mode "term") +(declare-function term-char-mode "term") +(declare-function term-send-input "term") +(declare-function term-next-prompt "term") +(declare-function term-process-mark "term") +(declare-function bookmark-prop-get "bookmark") +(declare-function helm-bookmark-build-source "helm-bookmark") +(declare-function comint-next-prompt "comint") +(declare-function comint-delete-input "comint") +(declare-function comint-send-input "comint") +(declare-function comint-goto-process-mark "comint") +(declare-function tramp-dissect-file-name "tramp") +(declare-function tramp-get-completion-function "tramp") +(declare-function seconds-to-time "time-date") +(declare-function ffap-fixup-url "ffap") +(declare-function ffap-url-at-point "ffap") +(declare-function ffap-file-at-point "ffap") +(declare-function dired-create-files "dired-aux") +(declare-function dired-goto-file "dired") +(declare-function dired-move-to-filename "dired") +(declare-function dired-move-to-end-of-filename "dired") +(declare-function dired-get-filename "dired") +(declare-function dired-get-marked-files "dired") +(declare-function tramp-list-connections "tramp-cache") +(declare-function tramp-get-connection-process "tramp") +(declare-function tramp-buffer-name "tramp") +(declare-function tramp-make-tramp-file-name "tramp") +(declare-function tramp-cleanup-connection "tramp-cmds") +(declare-function dired-async-processes "ext:dired-async.el") +(declare-function dired-async-mode-line-message "ext:dired-async.el") +(declare-function dired-async--modeline-mode "ext:dired-async.el") +(declare-function helm-adaptive-sort "ext:helm-adaptive.el") +(declare-function wfnames-setup-buffer "ext:wfnames.el") +(declare-function svg-lib-progress-bar "ext:svg-lib") +(declare-function svg-lib-tag "ext:svg-lib") +(declare-function helm-epa-success-message "helm-epa") +(declare-function helm-epa-collect-id-from-candidates "helm-epa") +(declare-function helm-epa-collect-keys-from-candidates "helm-epa") +(declare-function async-byte-compile-file "async-bytecomp.el") +(declare-function async-byte-recompile-directory "async-bytecomp.el") +(declare-function dnd-begin-drag-files "dnd.el") +(declare-function vc-deduce-backend "vc") + +(defvar term-char-mode-point-at-process-mark) +(defvar term-char-mode-buffer-read-only) +(defvar recentf-list) +(defvar helm-mm-matching-method) +(defvar dired-async-mode) +(defvar org-directory) +(defvar eshell-current-command) +(defvar eshell-debug-command) +(defvar eshell-current-command) +(defvar tramp-archive-enabled) +(defvar tramp-tolerate-tilde) +(defvar password-cache) +(defvar helm-fd-executable) +(defvar wfnames-buffer) +(defvar Info-current-file) +(defvar generated-autoload-file) +(defvar recentf-max-saved-items) + +;;; Internal vars +;; +(defvar helm-ff-last-expanded-candidate-regexp "^[[:multibyte:] \t]*%s" + "Regexp that retrieve previous candidate when going up one level. +The default value matching a multibyte char at bol allows +prefixing candidate with an icon. The format part will be +replaced by the display part of the candidate regexp quoted. +This should be used for all preselection code for helm-find-files +to handle icons.") + +(defvar helm-find-files-doc-header " (\\\\[helm-find-files-up-one-level]: Go up one level)" + "*The doc that is inserted in the Name header of a find-files or dired source.") +(defvar helm-ff-auto-update-flag nil + "Internal, flag to turn on/off auto-update in `helm-find-files'. +Don't set it directly, use instead `helm-ff-auto-update-initial-value'.") +(defvar helm-ff-last-expanded nil + "Store last expanded directory or file.") +(defvar helm-ff-default-directory nil) +(defvar helm-ff-history nil) +(defvar helm-ff-url-regexp + "\\`\\(news\\(post\\)?:\\|nntp:\\|mailto:\\|file:\\|\\(ftp\\|https?\\|telnet\\|gopher\\|www\\|wais\\):/?/?\\).*" + "Same as `ffap-url-regexp' but match earlier possible url.") +;; helm-tramp-file-name-regexp is based on old version of +;; tramp-file-name-regexp i.e. "\\`/\\([^[/:]+\\|[^/]+]\\):" but it +;; seems it is wrong and a simpler regexp is enough, let's try it and +;; watch out! +(defvar helm-tramp-file-name-regexp "\\`/\\([^/:|]+\\):") +(defvar helm-ff-tramp-method-regexp "[/|]:\\([^:]*\\)") +(defvar helm-ff--auto-update-state nil) +(defvar helm-ff--deleting-char-backward nil) +(defvar helm-multi-files--toggle-locate nil) +(defvar helm-ff--move-to-first-real-candidate t) +(defvar helm-find-files--toggle-bookmark nil) +(defvar helm-ff--tramp-methods nil) +(defvar helm-ff--directory-files-length (make-hash-table :test 'equal) + "Used to count number of candidates in directory. +candidate-number-limit is set to this value if this value is bigger +than `helm-candidate-number-limit'.") +(defvar helm-ff--list-directory-cache (make-hash-table :test 'equal) + "Cache for `helm-find-files' candidates.") +(defvar helm-ff--file-notify-watchers (make-hash-table :test 'equal) + "File-notify watchers for `helm-find-files' are stored here.") +(defvar helm-ff-history-buffer-name "*helm-find-files history*") +(defvar helm-rsync-command-history nil) +(defvar helm-rsync--last-progress-bar-alist nil + "Used to store last valid rsync progress bar.") +(defvar helm-rsync-process-buffer "*helm-rsync*") +(defvar helm-rsync-progress-str-alist nil) +(defvar helm-ff--trash-directory-regexp "\\.?Trash[/0-9]+files/?\\'") +(defvar helm-ff--show-directories-only nil) +(defvar helm-ff--show-files-only nil) +(defvar helm-ff--show-thumbnails nil) +(defvar helm-ff--thumbnailed-directories nil) +(defvar helm-source-find-files nil + "The main source to browse files. +Should not be used among other sources.") +(defvar helm-ff-icon-mode nil) + +;;; Helm-find-files - The helm file browser. +;; +;; Keymaps + +(defvar helm-find-files-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (define-key map (kbd "RET") 'helm-ff-RET) + (define-key map (kbd "C-]") 'helm-ff-run-toggle-basename) + (define-key map (kbd "C-x C-f") 'helm-ff-run-locate) + (define-key map (kbd "C-x C-d") 'helm-ff-run-browse-project) + (define-key map (kbd "C-x r m") 'helm-ff-bookmark-set) + (define-key map (kbd "C-x r b") 'helm-find-files-switch-to-bookmark) + (define-key map (kbd "C-x C-q") 'helm-ff-run-edit-marked-files) + (define-key map (kbd "C-s") 'helm-ff-run-grep) + (define-key map (kbd "M-g s") 'helm-ff-run-grep) + (define-key map (kbd "M-g p") 'helm-ff-run-pdfgrep) + (define-key map (kbd "M-g z") 'helm-ff-run-zgrep) + (define-key map (kbd "M-g a") 'helm-ff-run-grep-ag) + (define-key map (kbd "M-g g") 'helm-ff-run-git-grep) + (define-key map (kbd "M-g i") 'helm-ff-run-gid) + (define-key map (kbd "M-.") 'helm-ff-run-etags) + (define-key map (kbd "M-R") 'helm-ff-run-rename-file) + (define-key map (kbd "M-C") 'helm-ff-run-copy-file) + (define-key map (kbd "M-k") 'helm-ff-run-kill-default-directory) + (when (executable-find "rsync") + (define-key map (kbd "M-V") 'helm-ff-run-rsync-file)) + (define-key map (kbd "C-M-SPC") 'helm-ff-mark-similar-files) + (define-key map (kbd "C-M-@") 'helm-ff-mark-similar-files) + (define-key map (kbd "C-c C-SPC") 'helm-ff-mark-similar-files) + (define-key map (kbd "C-M-c") 'helm-ff-run-mcp) + (define-key map (kbd "M-B") 'helm-ff-run-byte-compile-file) + (define-key map (kbd "M-L") 'helm-ff-run-load-file) + (define-key map (kbd "M-S") 'helm-ff-run-symlink-file) + (define-key map (kbd "M-Y") 'helm-ff-run-relsymlink-file) + (define-key map (kbd "M-H") 'helm-ff-run-hardlink-file) + (define-key map (kbd "M-D") 'helm-ff-run-delete-file) + (define-key map (kbd "M-K") 'helm-ff-run-kill-buffer-persistent) + (define-key map (kbd "M-T") 'helm-ff-run-touch-files) + (define-key map (kbd "M-M") 'helm-ff-run-chmod) + ;; M-O in ttys is a prefix key. + (define-key map (if (display-graphic-p) + (kbd "M-O") (kbd "M-O O")) + 'helm-ff-run-chown) + (define-key map (kbd "M-G") 'helm-ff-run-chgrp) + (define-key map (kbd "C-c z") 'helm-ff-persistent-compress) + (define-key map (kbd "M-Z") 'helm-ff-run-compress-marked-files) + (define-key map (kbd "M-c") 'helm-ff-run-compress-to) + (define-key map (kbd "C-c d") 'helm-ff-persistent-delete) + (define-key map (kbd "M-e") 'helm-ff-run-switch-to-shell) + (define-key map (kbd "C-c i") 'helm-ff-run-complete-fn-at-point) + (define-key map (kbd "C-c o") 'helm-ff-run-switch-other-window) + (define-key map (kbd "C-c C-o") 'helm-ff-run-switch-other-frame) + (define-key map (kbd "C-c C-x") 'helm-ff-run-open-file-externally) + (define-key map (kbd "C-c C-v") 'helm-ff-run-preview-file-externally) + (define-key map (kbd "C-c X") 'helm-ff-run-open-file-with-default-tool) + (define-key map (kbd "C-c t") 'helm-ff-toggle-thumbnails) + (define-key map (kbd "M-!") 'helm-ff-run-eshell-command-on-file) + (define-key map (kbd "M-@") 'helm-ff-run-query-replace-fnames-on-marked) + (define-key map (kbd "M-%") 'helm-ff-run-query-replace) + (define-key map (kbd "C-M-%") 'helm-ff-run-query-replace-regexp) + (define-key map (kbd "C-c =") 'helm-ff-run-ediff-file) + (define-key map (kbd "M-=") 'helm-ff-run-ediff-merge-file) + (define-key map (kbd "M-p") 'helm-find-files-history) + (define-key map (kbd "C-c h") 'helm-ff-file-name-history) + (define-key map (kbd "M-i") 'helm-ff-properties-persistent) + (define-key map (kbd "C-}") 'helm-narrow-window) + (define-key map (kbd "C-{") 'helm-enlarge-window) + (define-key map (kbd "C-") 'helm-ff-run-toggle-auto-update) + (define-key map (kbd "C-c ") 'helm-ff-run-toggle-auto-update) + (define-key map (kbd "C-c C-a") 'helm-ff-run-mail-attach-files) + (define-key map (kbd "C-c p") 'helm-ff-run-print-file) + (define-key map (kbd "C-c /") 'helm-ff-run-find-sh-command) + (define-key map (kbd "C-/") 'helm-ff-run-fd) + ;; Next 2 have no effect if candidate is not an image file. + (define-key map (kbd "M-l") 'helm-ff-rotate-left-persistent) + (define-key map (kbd "M-r") 'helm-ff-rotate-right-persistent) + (define-key map (kbd "M-+") 'helm-ff-increase-image-size-persistent) + (define-key map (kbd "M--") 'helm-ff-decrease-image-size-persistent) + (define-key map (kbd "C-l") 'helm-find-files-up-one-level) + (define-key map (kbd "C-:") 'helm-ff-complete-tramp-methods) + (define-key map (kbd "C-_") 'helm-ff-undo) + (define-key map (kbd "C-;") 'helm-find-files-down-last-level) + (define-key map (kbd "C-c r") 'helm-ff-run-find-file-as-root) + (define-key map (kbd "C-x C-v") 'helm-ff-run-find-alternate-file) + (define-key map (kbd "C-c @") 'helm-ff-run-insert-org-link) + (define-key map (kbd "S-") 'helm-ff-sort-alpha) + (define-key map (kbd "S-") 'helm-ff-sort-by-newest) + (define-key map (kbd "S-") 'helm-ff-sort-by-size) + (define-key map (kbd "S-") 'helm-ff-toggle-dirs-only) + (define-key map (kbd "S-") 'helm-ff-toggle-files-only) + (define-key map (kbd "S-") 'helm-ff-sort-by-ext) + (helm-define-key-with-subkeys map (kbd "DEL") ?\d 'helm-ff-delete-char-backward + '((C-backspace . helm-ff-run-toggle-auto-update) + ([C-c DEL] . helm-ff-run-toggle-auto-update)) + nil 'helm-ff-delete-char-backward--exit-fn) + (when (fboundp 'tab-bar-mode) + (define-key map (kbd "C-c C-t") 'helm-ff-run-find-file-other-tab)) + map) + "Keymap for `helm-find-files'.") + +(defvar helm-read-file-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (define-key map (kbd "") 'helm-cr-empty-string) + (define-key map (kbd "M-RET") 'helm-cr-empty-string) + (define-key map (kbd "C-]") 'helm-ff-run-toggle-basename) + (define-key map (kbd "C-.") 'helm-find-files-up-one-level) + (define-key map (kbd "C-l") 'helm-find-files-up-one-level) + (define-key map (kbd "C-:") 'helm-ff-complete-tramp-methods) + (define-key map (kbd "C-_") 'helm-ff-undo) + (define-key map (kbd "C-;") 'helm-find-files-down-last-level) + (define-key map (kbd "C-c h") 'helm-ff-file-name-history) + (define-key map (kbd "C-x r b") 'helm-ff-bookmark-insert-location) + (define-key map (kbd "C-") 'helm-ff-run-toggle-auto-update) + (define-key map (kbd "C-c ") 'helm-ff-run-toggle-auto-update) + (define-key map (kbd "C-c t") 'helm-ff-toggle-thumbnails) + (define-key map (kbd "S-") 'helm-ff-sort-alpha) + (define-key map (kbd "S-") 'helm-ff-sort-by-newest) + (define-key map (kbd "S-") 'helm-ff-sort-by-size) + (define-key map (kbd "S-") 'helm-ff-sort-by-ext) + (define-key map (kbd "RET") 'helm-ff-RET) + (helm-define-key-with-subkeys map (kbd "DEL") ?\d 'helm-ff-delete-char-backward + '((C-backspace . helm-ff-run-toggle-auto-update) + ([C-c DEL] . helm-ff-run-toggle-auto-update)) + nil 'helm-ff-delete-char-backward--exit-fn) + map) + "Keymap for `helm-read-file-name'.") + + +;;; User variables +;; +(defgroup helm-files nil + "Files applications and libraries for Helm." + :group 'helm) + +(defcustom helm-tramp-verbose 0 + "Just like `tramp-verbose' but specific to Helm. +When set to 0 don't show tramp messages in Helm. +If you want to have the default tramp messages set it to 3." + :type 'integer) + +(defcustom helm-ff-auto-update-initial-value nil + "Auto update when only one candidate directory is matched. +Default value when starting `helm-find-files' is nil to not +confuse new users. +For a better experience with `helm-find-files' set this to +non-nil and use C- to toggle it." + :type 'boolean) + +(defcustom helm-ff-history-max-length 100 + "Number of elements shown in `helm-find-files' history." + :type 'integer) + +(defcustom helm-ff-fuzzy-matching t + "Enable fuzzy matching for `helm-find-files' when non--nil. +See `helm-ff--transform-pattern-for-completion' for more info." + :type 'boolean) + +(defcustom helm-ff-exif-data-program "exiftran" + "Program used to extract exif data of an image file." + :type 'string) + +(defcustom helm-ff-exif-data-program-args "-d" + "Arguments used for `helm-ff-exif-data-program'." + :type 'string) + +(defcustom helm-ff-newfile-prompt-p t + "Whether Prompt or not when creating new file. +This set `ffap-newfile-prompt'." + :type 'boolean) + +(defcustom helm-ff-avfs-directory "~/.avfs" + "The default avfs directory, usually \\='~/.avfs'. +When this is set you will be able to expand archive filenames +with `C-j' inside an avfs directory mounted with mountavfs. +See ." + :type 'string) + +(defcustom helm-ff-file-compressed-list '("gz" "bz2" "zip" "7z" "xz") + "Minimal list of compressed files extension." + :type '(repeat (choice string))) + +(defcustom helm-ff-printer-list nil + "A list of available printers on your system. +When non-nil let you choose a printer to print file. +Otherwise when nil the variable `printer-name' will be used. +On Unix based systems (lpstat command needed) you don't need to +set this, `helm-ff-find-printers' will find a list of available +printers for you." + :type '(repeat (choice string))) + +(defcustom helm-ff-transformer-show-only-basename t + "Show only basename of candidates in `helm-find-files'. +This can be toggled at anytime from `helm-find-files' with \ +\\\\[helm-ff-run-toggle-basename]. Note +that even when non nil, the dotted directories on top i.e. \".\" +and \"..\" are still displayed as full path when +`helm-ff-show-dot-file-path' is non nil." + :type 'boolean) + +(defcustom helm-ff-show-dot-file-path nil + "Show full path of dotted directories when non nil." + :type 'boolean + :set (lambda (var val) + (set-default var val) + (clrhash helm-ff--list-directory-cache))) + +(defcustom helm-ff-signal-error-on-dot-files t + "Signal error when file is `.' or `..' on file deletion when non-nil. +Default is non-nil. +WARNING: Setting this to nil is unsafe and can cause deletion of +a whole tree." + :type 'boolean) + +(defcustom helm-ff-search-library-in-sexp nil + "Search for library in `require' and `declare-function' sexp." + :type 'boolean) + +(defcustom helm-tooltip-hide-delay 25 + "Hide tooltips automatically after this many seconds." + :type 'integer) + +(defcustom helm-ff-skip-boring-files nil + "Non-nil to skip boring files. +I.e. the files matching regexps in `helm-boring-file-regexp-list'. +This takes effect in `helm-find-files' and file completion used by +`helm-mode' i.e. `helm-read-file-name'. +Note that when non-nil this will slow down slightly `helm-find-files'." + :type 'boolean) + +(defcustom helm-ff-skip-git-ignored-files nil + "Non-nil to skip git ignored files. +This take effect only in `helm-find-files'. +Check is not done on remote files. +Note that when non-nil this will slow down slightly +`helm-find-files'." + :type 'boolean) + +(defcustom helm-ff-candidate-number-limit 500 + "The `helm-candidate-number-limit' for `helm-find-files' and friends. +Note that when going one level up with +`\\\\[helm-find-files-up-one-level]' the +length of directory will be used instead if it is higher than +this value. This is to avoid failing to preselect the previous +directory/file if this one is situated lower than +`helm-ff-candidate-number-limit' num candidate." + :type 'integer) + +(defvar helm-ff-preselect-ignore-large-dirs nil + "This variable has no effect, use `helm-ff-dynamic-candidate-number-limit'.") +(make-obsolete-variable 'helm-ff-preselect-ignore-large-dirs + 'helm-ff-dynamic-candidate-number-limit + "4.0.6") + +(defvaralias 'helm-ff-up-one-level-preselect 'helm-ff-dynamic-candidate-number-limit) +(defcustom helm-ff-dynamic-candidate-number-limit t + " When non-nil `candidate-number-limit' source value is modified dynamically. +This when going one level up if the position of previous candidate in +its directory is > to `helm-ff-candidate-number-limit' This ensure +preselection on previous directory when going one level up possible. It +can be helpful to disable this and reduce +`helm-ff-candidate-number-limit' if you often navigate across very large +directories." + :type 'boolean) +(make-obsolete-variable 'helm-ff-up-one-level-preselect + 'helm-ff-dynamic-candidate-number-limit + "4.0.6") + +(defcustom helm-find-files-before-init-hook nil + "Hook that run before initialization of `helm-find-files'." + :type 'hook) + +(defcustom helm-find-files-after-init-hook nil + "Hook that run after initialization of `helm-find-files'." + :type 'hook) + +(defcustom helm-find-files-bookmark-prefix nil + "bookmark name prefix of `helm-find-files' sessions." + :type 'string) + +(defcustom helm-ff-guess-ffap-filenames nil + "Use ffap to guess local filenames at point in `helm-find-files'. +This doesn't disable url or mail at point, see +`helm-ff-guess-ffap-urls' for this." + :type 'boolean) + +(defcustom helm-ff-guess-ffap-urls t + "Use ffap to guess local urls at point in `helm-find-files'. +This doesn't disable guessing filenames at point, see +`helm-ff-guess-ffap-filenames' for this. +See also `ffap-url-unwrap-remote' that may override this +variable." + :type 'boolean) + +(defcustom helm-ff-no-preselect nil + "When non-nil `helm-find-files' starts at root of current directory." + :type 'boolean) + +(defcustom helm-ff-allow-non-existing-file-at-point nil + "Use non existing file-at-point as initial input in `helm-find-files'." + :type 'boolean) + +(defcustom helm-find-files-ignore-thing-at-point nil + "Use only `default-directory' as default input in `helm-find-files'. +I.e. text under cursor in `current-buffer' is ignored. +Note that when non-nil you will be unable to complete filename at +point in `current-buffer'." + :type 'boolean) + +(defcustom helm-substitute-in-filename-stay-on-remote nil + "Don't switch back to local filesystem when expanding pattern with / or ~/." + :type 'boolean) + +(defcustom helm-ff-goto-first-real-dired-exceptions '(dired-goto-file) + "Dired commands that are allowed moving to first real candidate." + :type '(repeat (choice symbol))) + +(defcustom helm-mounted-network-directories nil + "A list of directories used for mounting remotes filesystem. + +When nil `helm-file-on-mounted-network-p' always return nil +otherwise check if a file is in one of these directories. + +Remote filesystem are generally mounted with sshfs." + :type '(repeat string)) + +(defcustom helm-browse-project-default-find-files-fn + (cond ((or (executable-find "fd") + (executable-find "fdfind")) + #'helm-browse-project-fd-find-files) + ((executable-find "rg") + #'helm-browse-project-rg-find-files) + ((executable-find "ag") + #'helm-browse-project-ag-find-files) + (t #'helm-browse-project-walk-directory)) + "The default function to retrieve files in a non-vc directory. + +A function that takes a directory name as only arg." + :type 'function) + +(defcustom helm-ff-kill-or-find-buffer-fname-fn + #'helm-ff-kill-or-find-buffer-fname + "Default function used to expand non-directory filenames in `helm-find-files'. + +This variable will take effect only in `helm-find-files'. It +affects the behavior of persistent-action on filenames and +non-existing filenames. + +The default is to expand filename on first hit on +\\\\[helm-execute-persistent-action], pop buffer in +other window on second hit and finally kill this buffer on third +hit. This is very handy to create several new buffers, or when +navigating, show quickly the buffer of file to see its contents +briefly before killing it and continue navigating. + +However some users may not want this, so to disable this behaviour +just set this to `ignore' function. + +Of course you can also write your own function to do something +else." + :type 'function) + +(defcustom helm-modes-using-escaped-strings + '(eshell-mode shell-mode term-mode) + "Modes that requires string's insertion to be escaped." + :type '(repeat symbol)) + +(defcustom helm-ff-allow-recursive-deletes nil + "When \\='always don't prompt for recursive deletion of directories. +When nil, will ask for recursive deletion. +Note that when deleting multiple directories you can answer ! +when prompted to avoid being asked for next directories, so it +is probably better to not modify this variable." + :type '(choice + (const :tag "Delete non-empty directories" t) + (const :tag "Confirm for each directory" nil))) + +(defcustom helm-ff-delete-files-function #'helm-delete-marked-files + "The function to use by default to delete files. + +Default is to delete files synchronously, other choice is to +delete files asynchronously. + +BE AWARE that when deleting async you will not be warned about +recursive deletion of directories, IOW non-empty directories will +be deleted with no warnings in background!!! + +It is the function that will be used when using +`\\\\[helm-ff-run-delete-file]' from +`helm-find-files'." + :type '(choice (function :tag "Delete files synchronously." + helm-delete-marked-files) + (function :tag "Delete files asynchronously." + helm-delete-marked-files-async))) + +(defcustom helm-trash-remote-files nil + "Allow trashing remote files when non-nil. + +Trashing remote files with tramp doesn't work out of the box +unless the \\='trash-cli' package is installed. This is why trashing +remote files from Helm is disabled by default. + +Tramp is using external \\='trash' command in its `delete-file' and +`delete-directory' handlers when using +`delete-by-moving-to-trash', which is documented nowhere in +Emacs. + +If you want to enable this you will have to install the \\='trash' +command on remote (and/or locally if you want to trash as root). +On Ubuntu-based distributions it is \\='trash-cli'." + :type 'boolean) + +(defvaralias 'helm-list-directory-function 'helm-list-remote-directory-fn) +(make-obsolete-variable 'helm-list-directory-function 'helm-list-remote-directory-fn "4.0") + +(defcustom helm-list-remote-directory-fn + (cl-case system-type + (gnu/linux #'helm-list-dir-external) + (berkeley-unix #'helm-list-dir-lisp) + (windows-nt #'helm-list-dir-lisp) + (t #'helm-list-dir-lisp)) + "The function used in `helm-find-files' to list remote directories. + +Currently Helm provides two functions to do this: +`helm-list-dir-lisp' and `helm-list-dir-external'. + +Using `helm-list-dir-external' will provide a similar display to +what is provided with local files i.e. colorized symlinks, +executables files etc., whereas using `helm-list-dir-lisp' will +allow colorizing only directories but it is more portable. + +NOTE: `helm-list-dir-external' needs ls and awk as dependencies. +Also the ls version installed on the remote side should support +the same arguments as the GNU/ls version, which are -A -1 -F -b +and -Q. So even if you are using a GNU/ls version locally and you +want to connect e.g. on a Freebsd server, you may have failures +due to the incompatible ls version installed on remote server. In +such case use `helm-list-dir-lisp' which works everywhere but is +slower and less featured (only directories colorized)." + :type 'function) + +(defcustom helm-ff-initial-sort-method nil + "Sort method to use when initially listing a directory. + +It is better to keep this nil globally and turn it on only when needed +otherwise it may be slightly slower specially with `ext' method which +BTW is not provided on remote files (helm will fallback on nil in such +case). +Note that this have no effect as soon as you start narrowing directory +i.e. filtering filenames inside directory." + :type '(choice + (const :tag "alphabetically" nil) + (const :tag "newest" newest) + (const :tag "size" size) + (const :tag "extensions" ext))) + +(defcustom helm-ff-rotate-image-program "exiftran" + "External program used to rotate images. +When nil and `helm-ff-display-image-native' is enabled, fallback to +`image-rotate' without modification of exif data i.e. rotation is not +persistent otherwise an error is returned when not using +`helm-ff-display-image-native' i.e. using image-dired." + :type '(choice + (const :tag "Mogrify" "mogrify") + (const :tag "Exiftran" "exiftran") + (const :tag "Jpegtran" "jpegtran"))) + +(defcustom helm-ff-rotate-image-switch '("-i") + "Options used with `helm-ff-rotate-image-program'. +If you are using Mogrify or Jpegtran mandatory option is +\"-rotate\", with Exiftran mandatory option is \"-i\"." + :type '(repeat string)) + +(defcustom helm-ff-preferred-shell-mode 'eshell-mode + "Shell to use to switch to a shell buffer from `helm-find-files'. +Possible values are `shell-mode', `eshell-mode' and `term-mode'. +This affects `\\\\[helm-ff-run-switch-to-shell]' keybinding." + :type '(choice + (const :tag "Use Eshell" eshell-mode) + (const :tag "Use Shell" shell-mode) + (const :tag "Use Term" term-mode))) + +(defcustom helm-rsync-no-mode-line-update nil + "When non nil don't update mode-line when rsync is running. +This is useful if you display the progress bar somewhere else, +e.g. with minibuffer-line in minibuffer, in this case updating +mode-line may create flickering in other frame's mode-line." + :type 'boolean) + +(defcustom helm-rsync-switches '("-a" "-z" "-h" "-s" "--info=all2") + "Rsync options to use with HFF Rsync action. +Note: Using \"--info=all2\" allows having the name of the file +currently transfered in an help-echo in mode-line, if you use +\"--info=progress2\" you will not have this information." + :type '(repeat string)) + +(defcustom helm-rsync-percent-sign "％" + "Percentage unicode sign to use in Rsync reporter." + :type 'string) + +(defcustom helm-ff-rsync-progress-bar-style (if (display-graphic-p) 'bar 'text) + "Style of progress-bar for rsync action. +Value can be either bar or text. +Progress bar is inaccurate on non graphic displays, use text instead." + :type '(choice + (const :tag "Progress bar as a bar" bar) + (const :tag "Progress bar with text" text))) + +(defcustom helm-ff-rsync-progress-bar-info '(percent) + "Infos shown at end of Rsync progress bar. + +Valid value is a list containing one or more elements from +percent, size, speed and remain. When set to nil show nothing at end of +progress bar. +This Has no effect when `helm-ff-rsync-progress-bar-style' is text." + :type '(set :tag "Check zero or more items to show at end of Rsync progress bar" + (const :tag "Show the amount of data copied" size) + (const :tag "Show the percentage of data copied" percent) + (const :tag "Show the current speed of transfer" speed) + (const :tag "Show the time remaining" remain))) + +(defcustom helm-rsync-progress-bar-function #'helm-rsync-default-progress-bar + "Function used to draw a rsync progress bar in mode-line. +Function is called with three args: PROCESS, PERCENT, INFO. +PROCESS is the rsync process in use, it's name is displayed before the progress +bar, it is useful to display it to distinguish the different processes running +e.g. rsync1 rsync2 etc... +PERCENT is the current percentage of data sent to the progress bar. +INFO is what is displayed after the progress bar according to +`helm-ff-rsync-progress-bar-info'. +Currently Helm provides two functions to draw the progress bar: +- The default progress bar which use the whole height of mode-line and print +colored spaces to mimic a progress bar. +- The SVG based progress bar which use the external library svg-lib (you will +have to install it to use this function) and needs emacs to be compiled with svg +support." + :type '(choice + (function :tag "Default progress bar" + helm-rsync-default-progress-bar) + (function :tag "SVG progress bar" + helm-rsync-svg-progress-bar))) + +(defcustom helm-trash-default-directory nil + "The default trash directory. +You probably don't need to set this when using a Linux system using +standard settings. +Should be the directory file name i.e. don't add final slash. +When nil helm will compute a default value according to freedesktop +specs. +It is generally \"~/.local/share/Trash\"." + :type 'string) + +(defcustom helm-ff-lynx-style-map t + "Use arrow keys to navigate with `helm-find-files'. +Note that if you define this variable with `setq' your change +will have no effect, use customize instead." + :type 'boolean + :set (lambda (var val) + (set var val) + (if val + (progn + (define-key helm-find-files-map (kbd "") 'helm-execute-persistent-action) + (define-key helm-find-files-map (kbd "") 'helm-find-files-up-one-level) + (define-key helm-read-file-map (kbd "") 'helm-execute-persistent-action) + (define-key helm-read-file-map (kbd "") 'helm-find-files-up-one-level)) + (define-key helm-find-files-map (kbd "") nil) + (define-key helm-find-files-map (kbd "") nil) + (define-key helm-read-file-map (kbd "") nil) + (define-key helm-read-file-map (kbd "") nil)))) + +(defcustom helm-ff-DEL-up-one-level-maybe nil + "Use DEL to maybe go up one level when non nil. + +Going up one level works only when pattern is a directory endings +with \"/\", otherwise this command deletes char backward. + +When nil always delete char backward." + :type 'boolean) + +(defcustom helm-ff-display-image-native t + "Use native `image-mode' when non nil. + +You should use this only with Emacs>= 27 and `image-auto-resize' +enabled to have images resized properly. When this is enabled, +you have new commands to zoom in/out images. See +`image-transform-resize' and `image-auto-resize'. Otherwise, +when nil `image-dired' is used, using imagemagick as backend. +NOTE: On Emacs-29 `image-dired' is no more using external program +image-magick to display image, so this is used inconditionally even +when value is nil." + :type 'boolean) + +(defcustom helm-ff-reset-filters-on-update t + "Reset filter variables when changing directory. +When filtering directories/files only, switch back to a \"show all\" view +when moving out of directory when non nil." + :type 'boolean) + +(defcustom helm-ff-eshell-unwanted-aliases nil + "A list of eshell aliases to not display." + :type '(repeat string)) + +(defcustom helm-eshell-on-file-reverse-history t + "History source in *eshell-command-on-file appears on top when non nil." + :type 'boolean) + +(defcustom helm-ff-edit-marked-files-fn #'helm-ff-wfnames + "A function to edit filenames in a special buffer. + +By default `wfnames' package is used to avoid wdired which +doesn't always work with all emacs versions and also is quite +clumsy about default-directory among other things. If you still +want to use it, helm is still providing +`helm-marked-files-in-dired'." + :type '(choice (function :tag "Use Wfnames package to edit filenames." + helm-ff-wfnames) + (function :tag "Use Wdired package to edit filenames." + helm-marked-files-in-dired))) + +(defcustom helm-find-files-actions + (helm-make-actions + "Find File" 'helm-find-file-or-marked + "Find file in Dired" 'helm-point-file-in-dired + "View file" 'view-file + "Query replace fnames on marked `M-@'" 'helm-ff-query-replace-fnames-on-marked + (lambda () + (helm-acase helm-ff-edit-marked-files-fn + (helm-marked-files-in-dired "Edit filenames in Wdired `C-x C-q'") + (helm-ff-wfnames "Edit filenames in Wfnames `C-x C-q'"))) + 'helm-ff-edit-marked-files + "Query replace contents on marked `M-%'" 'helm-ff-query-replace + "Query replace regexp contents on marked `C-M-%'" 'helm-ff-query-replace-regexp + "Attach file(s) to mail buffer `C-c C-a'" 'helm-ff-mail-attach-files + "Serial rename files" 'helm-ff-serial-rename + "Serial rename by symlinking files" 'helm-ff-serial-rename-by-symlink + "Serial rename by copying files" 'helm-ff-serial-rename-by-copying + "Open file with default tool" 'helm-open-file-with-default-tool + "Find file in hex dump" 'hexl-find-file + "Browse project `C-x C-d'" 'helm-ff-browse-project + "Complete at point `C-c i'" 'helm-insert-file-name-completion-at-point + "Insert as org link `C-c @'" 'helm-files-insert-as-org-link + "Find shell command `C-c /'" 'helm-ff-find-sh-command + "Fd shell command (C-/)" 'helm-ff-fd + "Find files in file" 'helm-find-files-in-file + "Add marked files to file-cache" 'helm-ff-cache-add-file + "Open file externally `C-c C-x, C-u to choose'" 'helm-open-file-externally + "Grep File(s) `C-s, C-u Recurse'" 'helm-find-files-grep + "Grep current directory with AG `M-g a, C-u select type'" 'helm-find-files-ag + "Git grep `M-g g, C-u from root'" 'helm-ff-git-grep + "Zgrep File(s) `M-g z, C-u Recurse'" 'helm-ff-zgrep + "Pdf Grep File(s)" 'helm-ff-pdfgrep + "Gid `M-g i'" 'helm-ff-gid + "Switch to Eshell `M-e'" 'helm-ff-switch-to-shell + "Etags `M-., C-u reload tag file'" 'helm-ff-etags-select + "Eshell command on file(s) `M-!, C-u take all marked as arguments.'" + 'helm-find-files-eshell-command-on-file + "Find file as root `C-c r'" 'helm-find-file-as-root + "Find alternate file `C-x C-v'" 'find-alternate-file + "Ediff File `C-c ='" 'helm-find-files-ediff-files + "Ediff Merge File `M-='" 'helm-find-files-ediff-merge-files + (lambda () (format "Delete File(s)%s `M-D' (C-u reverse trash)" + (if (eq helm-ff-delete-files-function + 'helm-delete-marked-files-async) + " async" ""))) + 'helm-ff-delete-files + "Touch File(s) `M-T'" 'helm-ff-touch-files + "Encrypt file(s)" 'helm-ff-encrypt-files + "Copy file(s) `M-C, C-u to follow'" 'helm-find-files-copy + (lambda () + (and (executable-find "rsync") + "Rsync file(s) `M-V' (C-u edit command)")) + 'helm-find-files-rsync + "Rename file(s) `M-R, C-u to follow'" 'helm-find-files-rename + "Backup files" 'helm-find-files-backup + "Copy file to dir(s) `C-M-c'" 'helm-ff-mcp + "Symlink files(s) `M-S, C-u to follow'" 'helm-find-files-symlink + "Relsymlink file(s) `M-Y, C-u to follow'" 'helm-find-files-relsymlink + "Hardlink file(s) `M-H, C-u to follow'" 'helm-find-files-hardlink + "Compress file(s) to archive `M-c'" 'helm-find-files-compress-to + "Compress or uncompress file(s) `M-Z'" 'helm-ff-compress-marked-files + "Change mode on file(s) `M-M'" 'helm-ff-chmod + "Change owner on file(s) `M-O' or `M-O O' in ttys" 'helm-ff-chown + "Change group on file(s) `M-G'" 'helm-ff-chgrp + "Find file other window `C-c o'" 'helm-find-files-other-window + "Find file other frame `C-c C-o'" 'find-file-other-frame + (lambda () (and (fboundp 'tab-bar-mode) + "Find file other tab `C-c C-t'")) + 'helm-ff-find-file-other-tab + "Print File `C-c p, C-u to refresh'" 'helm-ff-print + "Locate `C-x C-f, C-u to specify locate db'" 'helm-ff-locate) + "Actions for `helm-find-files'." + :type '(alist :key-type string :value-type function)) + +(defcustom helm-dwim-target nil + "Default target directory for file actions. + +Currently only Ediff action in helm-find-files is affected by this. +Define the directory where you want to start navigating for the +target directory when copying, renaming, etc.. You can use the +`default-directory' of `next-window', the visited directory, the +current `default-directory' or have completion on all the +directories belonging to each visible windows." + :type '(radio :tag "Define default target directory for file actions." + (const :tag "Directory belonging to next window" + next-window) + (const :tag "Completion on directories belonging to each window" + completion) + (const :tag "Use initial directory or `default-directory'" + default-directory) + (const :tag "Use visited directory" + nil))) + +(defcustom helm-ff-use-notify t + "Watch directories visited with `helm-find-files' when non nil. +If your system have no file notification package available turn this +to nil to avoid error messages when using `helm-find-files'." + :type 'boolean + :set (lambda (var val) + (set-default var val) + (unless (symbol-value var) + (cl-loop for dir being the hash-keys of helm-ff--file-notify-watchers + do (remhash dir helm-ff--list-directory-cache))))) + +(defcustom helm-ff-inotify-unsupported-methods '("adb") + "Tramp methods unsupported by file-notify." + :type '(repeat string)) + +(defcustom helm-ff-image-cache-max-len 5 + "The last seen image number to keep in cache." + :type 'integer) + +(defcustom helm-ff-image-cache-max-len 5 + "The last seen image number to keep in cache." + :type 'integer) + +(defcustom helm-ff-slideshow-default-delay 3 + "Delay in seconds between each image in slideshow." + :type 'integer) + +(defcustom helm-file-name-history-max-length 72 + "Max length of candidates in helm file name history before truncating." + :type 'integer) + +(defcustom helm-ff-follow-blacklist-file-exts '("gpg" "doc" "docx" "mp3" "ogg") + "File extensions we don't want to follow when helm-follow-mode is enabled. +Note that image files are always followed even if their extensions is +present in this list." + :type '(repeat string)) + +(defcustom helm-ff-nohighlight-matches nil + "Highlight matches in `helm-find-files' when nil." + :type 'boolean + :initialize 'custom-initialize-changed + :set (lambda (var val) + (set var val) + ;; Force rebuilding the source to remove the highlight match FCT. + (setq helm-source-find-files nil))) + +(defcustom helm-ff-ignore-following-on-directory nil + "In follow mode ignore silently directories when non nil." + :type 'boolean) + +(defcustom helm-ff-dim-prompt-on-update t + "When non nil dim prompt while updating." + :type 'boolean) + +(defcustom helm-ff-drag-mouse-1-default-action 'copy + "Default action when dragging files. +Possible values are `copy', `move' or `link'. +Currently supported value is `copy' when dropping to a dired buffer, `move' is +working only when dropping on an external application (only thunar tested)." + :type '(choice + (const :tag "Copy" copy) + (const :tag "Move" move) + (const :tag "Link" link))) + +(defcustom helm-find-files-ignore-diacritics nil + "Ignore diacritics on basename of files when non nil. +Note that this happens only when switching to multimatch, i.e. adding spaces in +pattern, this may slowdown a little matching of candidates when non nil. +Setting this with `setq' may have no effect on this variable, use +`customize-set-variable'. This variable affects as well `read-file-name'." + :type 'boolean + :set (lambda (var val) + (set var val) + ;; Force rebuilding the source to pass diacritics fn to diacritics + ;; slot. + (setq helm-source-find-files nil))) + +(defcustom helm-turn-on-recentf t + "Automatically turn on `recentf-mode' when non-nil." + :group 'helm-files + :type 'boolean) + +;;; Faces +;; +;; +(defgroup helm-files-faces nil + "Customize the appearance of helm-files." + :prefix "helm-" + :group 'helm-files + :group 'helm-faces) + +(defface helm-ff-prefix + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :background "yellow" :foreground "black")) + "Face used to prefix new file or url paths in `helm-find-files'." + :group 'helm-files-faces) + +(defface helm-ff-executable + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :foreground "green")) + "Face used for executable files in `helm-find-files'." + :group 'helm-files-faces) + +(defface helm-ff-suid + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :background "red" :foreground "white")) + "Face used for suid files in `helm-find-files'." + :group 'helm-files-faces) + +(defface helm-ff-directory + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :foreground "DarkRed" :background "LightGray")) + "Face used for directories in `helm-find-files'." + :group 'helm-files-faces) + +(defface helm-ff-dotted-directory + `((((class color) (min-colors 88) (background dark)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :foreground "black" :background "DimGray") + (((class color) (min-colors 88) (background light)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :foreground "black" :background "LightGray") + (t :inherit default)) + "Face used for dotted directories in `helm-find-files'." + :group 'helm-files-faces) + +(defface helm-ff-dotted-symlink-directory + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :foreground "DarkOrange" :background "DimGray")) + "Face used for dotted symlinked directories in `helm-find-files'." + :group 'helm-files-faces) + +(defface helm-ff-symlink + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :inherit font-lock-comment-face)) + "Face used for symlinks in `helm-find-files'." + :group 'helm-files-faces) + +(defface helm-ff-invalid-symlink + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :foreground "black" :background "red")) + "Face used for invalid symlinks in `helm-find-files'." + :group 'helm-files-faces) + +(defface helm-ff-denied + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :foreground "red" :background "black")) + "Face used for non accessible files in `helm-find-files'." + :group 'helm-files-faces) + +(defface helm-ff-file + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :inherit font-lock-builtin-face)) + "Face used for file names in `helm-find-files'." + :group 'helm-files-faces) + +(defface helm-ff-nofile + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :inherit helm-ff-file)) + "Face used for non-files file names in `helm-find-files'. +Used when showing tramp host completions." + :group 'helm-files-faces) + +(defface helm-ff-truename + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :inherit font-lock-string-face)) + "Face used for symlink truenames in `helm-find-files'." + :group 'helm-files-faces) + +(defface helm-ff-dirs + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :inherit font-lock-function-name-face)) + "Face used for file names in recursive dirs completion in `helm-find-files'." + :group 'helm-files-faces) + +(defface helm-ff-socket + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :foreground "DeepPink")) + "Face used for socket files in `helm-find-files'." + :group 'helm-files-faces) + +(defface helm-ff-pipe + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :foreground "yellow" :background "black")) + "Face used for named pipes and character device files in `helm-find-files'." + :group 'helm-files-faces) + +(defface helm-ff-file-extension + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :foreground "magenta")) + "Face used for file extensions in `helm-find-files'." + :group 'helm-files-faces) + +(defface helm-ff-backup-file + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :foreground "DimGray")) + "Face used for backup files in `helm-find-files'." + :group 'helm-files-faces) + +(defface helm-history-deleted + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :inherit helm-ff-invalid-symlink)) + "Face used for deleted files in `file-name-history'." + :group 'helm-files-faces) + +(defface helm-history-remote + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :foreground "IndianRed1")) + "Face used for remote files in `file-name-history'." + :group 'helm-files-faces) + +(defface helm-delete-async-message + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :foreground "yellow")) + "Face used for mode-line message." + :group 'helm-files-faces) + +(defface helm-ff-rsync-progress + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :inherit font-lock-warning-face)) + "Face used for rsync mode-line indicator." + :group 'helm-files-faces) + +(defface helm-ff-rsync-progress-1 + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :background "CadetBlue" :foreground "black")) + "Face used for rsync progress bar percentage and proc name." + :group 'helm-files-faces) + +(defface helm-ff-rsync-progress-2 + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :background "orange")) + "Face used for rsync progress bar progress." + :group 'helm-files-faces) + +(defface helm-ff-rsync-progress-3 + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :background "white")) + "Face used for rsync progress bar background." + :group 'helm-files-faces) + +(defface helm-ff-rsync-progress-svg + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :background "black" :foreground "white")) + "Face used for rsync svg progress bar." + :group 'helm-files-faces) + +;;; Helm-find-files +;; +;; +(defclass helm-source-ffiles (helm-source-sync) + ((header-name + :initform (lambda (name) + (concat name (substitute-command-keys + helm-find-files-doc-header)))) + (init + :initform (lambda () + (setq helm-ff-auto-update-flag + helm-ff-auto-update-initial-value) + (setq helm-ff--auto-update-state + helm-ff-auto-update-flag) + (helm-set-local-variable 'bookmark-make-record-function + #'helm-ff-make-bookmark-record) + (require 'helm-external))) + (candidates :initform 'helm-find-files-get-candidates) + (update :initform (lambda () + (remhash helm-ff-default-directory + helm-ff--list-directory-cache))) + (match-on-real :initform t) + ;; We don't want to have here matchfns loaded uselessly. + ;; By using diacritics :match should expand to: + ;; '(helm-mm-exact-match helm-mm-3f-match-on-diacritics helm-mm-3-migemo-match) + ;; If helm-find-files-ignore-diacritics is nil we should fallback to: + ;; '(helm-mm-exact-match helm-mm-3f-match helm-mm-3-migemo-match) + ;; See `helm-source-mm-get-search-or-match-fns'. + (match :initform (unless helm-find-files-ignore-diacritics + 'helm-mm-3f-match)) + (diacritics :initform (and helm-find-files-ignore-diacritics + 'helm-mm-3f-match-on-diacritics)) + (filtered-candidate-transformer + :initform '(helm-ff-fct + helm-ff-maybe-show-thumbnails + ;; These next two have to be called after + ;; `helm-ff-fct' as they use only cons cell candidates. + helm-ff-directories-only + helm-ff-files-only + helm-ff-sort-candidates)) + (popup-info :initform (lambda (candidate) + (unless (helm-ff-dot-file-p candidate) + (helm-file-attributes + candidate + :dired t :human-size t :octal nil)))) + (persistent-action-if :initform 'helm-find-files-persistent-action-if) + (persistent-help :initform "Hit1 Expand Candidate, Hit2 or (C-u) Find file") + (help-message :initform 'helm-ff-help-message) + (mode-line :initform (list "File(s)" helm-mode-line-string)) + (volatile :initform t) + (cleanup :initform 'helm-find-files-cleanup) + (migemo :initform t) + (nohighlight :initform (progn helm-ff-nohighlight-matches)) + (keymap :initform 'helm-find-files-map) + (candidate-number-limit :initform 'helm-ff-candidate-number-limit) + (suspend-follow-in-update + :initarg :suspend-follow-in-update + :initform t + :documentation "Prevent following candidate when updating.") + (completing-file-name + :initarg :completing-file-name :initform t + :documentation "Flag to notify `helm-resume' we are completing filenames.") + (action-transformer + :initform 'helm-find-files-action-transformer) + (action :initform 'helm-find-files-actions) + (before-init-hook :initform 'helm-find-files-before-init-hook) + (after-init-hook :initform 'helm-find-files-after-init-hook) + (all-marked :initform t) + (group :initform 'helm-files))) + +;; Bookmark handlers. +;; +(defun helm-ff-make-bookmark-record () + "The `bookmark-make-record-function' for `helm-find-files'." + (with-helm-buffer + `((filename . ,helm-ff-default-directory) + (presel . ,(helm-get-selection)) + (handler . helm-ff-bookmark-jump)))) + +(defun helm-ff-bookmark-jump (bookmark) + "bookmark handler for `helm-find-files'." + (let ((fname (bookmark-prop-get bookmark 'filename)) + (presel (bookmark-prop-get bookmark 'presel))) + ;; Force tramp connection with `file-directory-p' before lauching + ;; hff otherwise the directory name is inserted on top before + ;; tramp starts and display candidates. FNAME is here always a + ;; directory. + (when (file-directory-p fname) + (helm-find-files-1 fname + (format helm-ff-last-expanded-candidate-regexp + (if helm-ff-transformer-show-only-basename + (regexp-quote (helm-basename presel)) + (regexp-quote presel))))))) + +(defun helm-ff-bookmark-set () + "Record `helm-find-files' session in bookmarks." + (interactive) + (with-helm-alive-p + (with-helm-buffer + (bookmark-set + (concat helm-find-files-bookmark-prefix + (abbreviate-file-name helm-ff-default-directory)))) + (message "Helm find files session bookmarked! "))) +(put 'helm-ff-bookmark-set 'helm-only t) + +(defun helm-dwim-target-directories () + "Provide a list of default targets for `helm-find-files' actions." + (cl-loop for w in helm-initial-windows + for dir = (with-selected-window w default-directory) + unless (member dir dirs) + collect dir into dirs + ;; Prevent having helm-ff-default-directory in defaults while we are + ;; already in it, if it is the only member of list return this list + ;; to prevent helm using the thing-at-point in *helm marked* buffer + ;; which is irrelevant. + finally return (if (cdr dirs) + (delete helm-ff-default-directory dirs) + dirs))) + +(defun helm-dwim-target-directory () + "Try to return a suitable directory according to `helm-dwim-target'." + (with-selected-window (or + ;; Try next-window if current-buffer has been + ;; killed during this session probably by C-d. + (get-buffer-window helm-current-buffer) + (next-window (helm-window) 1)) + (let ((wins (remove (get-buffer-window helm-marked-buffer-name) + (window-list)))) + (expand-file-name + (cond (;; Provide completion on all the directories belonging to + ;; visible windows if some. + (and (cdr wins) + (eq helm-dwim-target 'completion)) + (helm-comp-read "Browse target starting from: " + (helm-fast-remove-dups + (append (list (or (car-safe helm-ff-history) + default-directory) + default-directory) + (cl-loop for w in wins collect + (with-selected-window w + default-directory))) + :test 'equal))) + ;; Use default-directory of next-window if more than 1 window + ;; otherwise fall-back to default-directory. + ((eq helm-dwim-target 'next-window) + (if (cdr wins) + (with-selected-window (next-window) + default-directory) + default-directory)) + ;; Always use default-directory when only one window. + ((and (null (cdr wins)) + (eq helm-dwim-target 'default-directory)) + default-directory) + ;; Use the visited directory. + ((or (null (cdr wins)) + (null helm-dwim-target)) + ;; Using the car of *ff-history allow + ;; staying in the directory visited instead of + ;; current. + (or (car-safe helm-ff-history) default-directory))))))) + +(defsubst helm-ff--file-directory-p (file) + (if (file-remote-p file) + (get-text-property 1 'helm-ff-dir file) + (file-directory-p file))) + +(defun helm-ff--count-and-collect-dups (files) + (cl-loop with dups = (make-hash-table :test 'equal) + for f in files + for file = (if (helm-ff--file-directory-p f) + (concat (helm-basename f) "/") + (helm-basename f)) + for count = (gethash file dups) + if count do (puthash file (1+ count) dups) + else do (puthash file 1 dups) + finally return (cl-loop for k being the hash-keys in dups + using (hash-value v) + if (> v 1) + collect (format "%s(%s)" k v) + else + collect k))) + +(defun helm-find-files-do-action (action &optional target) + "Generic function for creating actions from `helm-source-find-files'. +ACTION can be `rsync' or any action supported by `helm-dired-action'." + (require 'dired-async) + (when (eq action 'rsync) + (cl-assert (executable-find "rsync") nil "No command named rsync")) + (let* (dired-create-destination-dirs ; We handle dirs creation ourself. + (rsync-switches + (when (and (eq action 'rsync) + helm-current-prefix-arg) + (cdr (split-string + (read-string "Run rsync like this: " + (mapconcat + 'identity + (cons "rsync" helm-rsync-switches) " ") + 'helm-rsync-command-history))))) + (ifiles (mapcar 'expand-file-name ; Allow modify '/foo/.' -> '/foo' + ;; Use :all-sources to allow actions on wildcards + ;; marked in dummy source. FIXME: We should use + ;; :all-sources when :all-marked is non nil only, it is + ;; true by default but user may modify HFF source by defmethod. + (helm-marked-candidates :with-wildcard t :all-sources t))) + (cand (unless (cdr ifiles) (helm-get-selection))) ; preselection. + (prefarg helm-current-prefix-arg) + (prompt (format "%s %s file(s) %s: " + (if (and (and (fboundp 'dired-async-mode) + dired-async-mode) + (not (eq action 'rsync)) + (null prefarg)) + (concat "Async " (symbol-name action)) + (capitalize (symbol-name action))) + (length ifiles) + (if (memq action '(symlink relsymlink hardlink)) + "from" "to"))) + (cdir (helm-aand + (eq action 'compress) + (helm-common-dir ifiles) + (if (stringp it) + (file-name-as-directory it) + (error "Try to compress files not belonging to same drive")))) + helm-ff--move-to-first-real-candidate + helm-display-source-at-screen-top ; prevent setting window-start. + helm-ff-auto-update-initial-value + ;; It is not possible to rename a file to a boring name when + ;; helm-ff-skip-boring-files is enabled + helm-ff-skip-boring-files + ;; If HFF is using a frame use a frame as well. + (helm-actions-inherit-frame-settings t) + helm-use-frame-when-more-than-two-windows + (dest (or target + (with-helm-display-marked-candidates + helm-marked-buffer-name + (if cdir + (mapcar (lambda (f) + (file-relative-name f cdir)) + ifiles) + (helm-ff--count-and-collect-dups ifiles)) + (with-helm-current-buffer + (helm-read-file-name + prompt + :preselect + (when cand + (format helm-ff-last-expanded-candidate-regexp + (regexp-quote + (if helm-ff-transformer-show-only-basename + (helm-basename cand) cand)))) + :default (if cdir + (mapcar (lambda (x) + (let ((ext (replace-regexp-in-string + "[\\']" "" (car x)))) + (expand-file-name + (format "%s%s" + (if cand + (helm-basename cand) + "new_archive") + ext) + cdir))) + dired-compress-files-alist) + ;; List of all `default-directory' belonging + ;; to each visible windows before starting helm. + (helm-dwim-target-directories)) + :must-match (and cdir (lambda (f) (not (file-directory-p f)))) + :initial-input (or cdir helm-ff-default-directory) + :history (helm-find-files-history nil :comp-read nil)))))) + (dest-dir-p (file-directory-p dest)) + (dest-dir (if dest-dir-p dest (helm-basedir dest)))) + ;; Ignore `dired-create-destination-dirs' and handle directory creation from + ;; here like we were doing before. Dired is failing to create directories + ;; when e.g. symlinking some files to a not yet existing directory. + (unless (or dest-dir-p (file-directory-p dest-dir)) + (when (y-or-n-p (format "Create directory `%s'? " dest-dir)) + ;; When saying No here with rsync, `helm-rsync-copy-files' will raise an + ;; error about dest not existing. + (make-directory dest-dir t))) + (helm-acase action + (rsync (helm-rsync-copy-files ifiles dest rsync-switches)) + (compress (helm-do-compress-to ifiles dest)) + (t (helm-dired-action + dest :files ifiles :action action :follow prefarg))))) + +;; Rsync +;; +(defun helm-rsync-remote2rsync (file) + (if (file-remote-p file) + (let ((localname (directory-file-name + (expand-file-name (file-remote-p file 'localname)))) + (user (file-remote-p file 'user)) + ;; Tramp name may contain port e.g. /ssh:host#2222:/foo. + (host (replace-regexp-in-string + "#[0-9]+" "" (file-remote-p file 'host)))) + (if user + (format "%s@%s:%s" user host (shell-quote-argument localname)) + (format "%s:%s" host (shell-quote-argument localname)))) + (shell-quote-argument + (directory-file-name + (expand-file-name file))))) + +(defun helm-rsync-format-mode-line-str (proc) + (helm-aif (and (process-live-p proc) + (assoc-default proc helm-rsync-progress-str-alist)) + (progn + ;; When rsync progress bar stop for some reason (e.g. rsync + ;; takes time to finalize writing file to disk), no output is + ;; coming from filter process, as a result the progress bar + ;; disapear for a while giving no information to user while + ;; the rsync process continues, so keep printing the last valid + ;; progress bar (stored in `helm-rsync--last-progress-bar-alist') + ;; instead of sending empty string. + (unless (equal it "") + (push (cons proc it) helm-rsync--last-progress-bar-alist)) + (if (eq helm-ff-rsync-progress-bar-style 'text) + (format " [%s]" (propertize + (or (assoc-default proc helm-rsync--last-progress-bar-alist) + ;; Avoid (wrong-type-argument stringp + ;; nil) when process is not ready. + "") + 'face 'helm-ff-rsync-progress)) + (format " %s" (or (assoc-default proc helm-rsync--last-progress-bar-alist) + ;; Avoid (wrong-type-argument stringp + ;; nil) when process is not ready. + "")))))) + +(defun helm-ff--rsync-progress-bar (progbar proc) + ;; progbar == " 2,83G 92% 98,65MB/s 0:00:02 " + (let ((infos (split-string + (replace-regexp-in-string + "%" helm-rsync-percent-sign + progbar) + " " t)) + percent info) + (if (eq helm-ff-rsync-progress-bar-style 'text) + (mapconcat 'identity infos " ") + (setq info + (mapconcat (lambda (x) + (helm-acase x + (size (nth 0 infos)) + (percent (nth 1 infos)) + (speed (nth 2 infos)) + (remain (nth 3 infos)))) + (helm-mklist helm-ff-rsync-progress-bar-info) + ", ")) + (when (string-match "\\([0-9]+\\)%" progbar) + (setq percent (string-to-number + (match-string 1 progbar)))) + (if percent + (funcall helm-rsync-progress-bar-function proc percent info) + "")))) + +(defun helm-rsync-default-progress-bar (proc percent info) + (format "%s%s%s%s" + (propertize (capitalize (replace-regexp-in-string + "<\\([0-9]+\\)>" "(\\1)" + (process-name proc))) + 'display '(height 0.9) + 'face 'helm-ff-rsync-progress-1) + (propertize " " 'display `(space :width ,(list percent)) + 'face 'helm-ff-rsync-progress-2) + (propertize " " 'display `(space :width ,(list (- 100 percent))) + 'face 'helm-ff-rsync-progress-3) + (propertize info + 'display '(height 0.9) + 'face 'helm-ff-rsync-progress-1))) + +(defun helm-rsync-svg-progress-bar (proc percent info) + (cl-assert (image-type-available-p 'svg) nil + "svg-lib requires Emacs to be compiled with svg support") + (require 'svg-lib) + (format "%s%s%s" + (propertize " " 'display (svg-lib-tag + (process-name proc) + 'helm-ff-rsync-progress-svg)) + (propertize " " 'display (svg-lib-progress-bar + (/ (+ percent 7) 105.0) + 'helm-ff-rsync-progress-svg + :width 10 :margin 1 :stroke 2 :padding 2)) + (if (string= info "") + "" + (propertize " " 'display (svg-lib-tag + info 'helm-ff-rsync-progress-svg))))) + +(defun helm-rsync-mode-line (proc) + "Add Rsync progress to the mode line." + (or global-mode-string (setq global-mode-string '(""))) + (unless (member `(:eval (helm-rsync-format-mode-line-str ,proc)) + global-mode-string) + (setq global-mode-string + (append global-mode-string + `((:eval (helm-rsync-format-mode-line-str ,proc))))))) + +(defun helm-rsync-restore-mode-line (proc) + "Restore the mode line when Rsync finishes." + (setq global-mode-string + (remove `(:eval (helm-rsync-format-mode-line-str ,proc)) + global-mode-string)) + (setq helm-rsync--last-progress-bar-alist nil) + (force-mode-line-update)) + +(defun helm-rsync-copy-files (files dest &optional switches) + "Send FILES to DEST using Rsync with SWITCHES as arguments. + +DEST must be a directory. SWITCHES when unspecified default to +`helm-rsync-switches'." + (cl-assert (file-directory-p dest) t) + (setq files (cl-loop for f in files + collect (helm-rsync-remote2rsync f)) + dest (helm-rsync-remote2rsync dest)) + (let* ((buf (generate-new-buffer-name helm-rsync-process-buffer)) + (host (file-remote-p dest 'host)) + (port (when (and host (string-match "#\\([0-9]+\\)" host)) + (match-string 1 host))) + (proc (start-process-shell-command + "rsync" buf + (format "rsync %s" + (mapconcat + 'identity + (append (or switches helm-rsync-switches) + (and port + ;; Add automatically port + ;; specified in tramp name + ;; unless user already specified + ;; it himself with the -e option + ;; by editing command. + switches + (cl-loop for arg in switches never + (string-match-p + "\\`-e" arg)) + (list (format "-e 'ssh -p %s'" + port))) + files (list dest)) + " "))))) + (helm-rsync-mode-line proc) + (set-process-sentinel + proc (lambda (process event) + (cond ((string= event "finished\n") + (message "%s copied %s files" + (capitalize (process-name process)) + (length files))) + (t (error "Process %s %s with code %s" + (process-name process) + (process-status process) + (process-exit-status process)))) + (setq helm-rsync-progress-str-alist + (delete (assoc process helm-rsync-progress-str-alist) + helm-rsync-progress-str-alist)) + (helm-rsync-restore-mode-line process))) + (set-process-filter proc #'helm-rsync-process-filter))) + +(defun helm-rsync-process-filter (proc output) + "Filter process function used by `helm-rsync-copy-files'." + (let ((inhibit-read-only t) + fname progbar) + (with-current-buffer (process-buffer proc) + (when (string-match comint-password-prompt-regexp output) + ;; FIXME: Fully not tested and + ;; use an agent or auth-source + ;; or whatever to get password if + ;; available. + (process-send-string + proc (concat (read-passwd (match-string 0 output)) "\n"))) + ;; Extract the progress bar. + (with-temp-buffer + (insert output) + (when (re-search-backward "[[:cntrl:]]" nil t) + (setq progbar (buffer-substring-no-properties + (match-end 0) (point-max))))) + ;; Insert the text, advancing the process marker. + (save-excursion + (goto-char (process-mark proc)) + (insert output) + (set-marker (process-mark proc) (point))) + (goto-char (process-mark proc)) + ;; Extract the file name currently + ;; copied (Imply --info=all2 or all1). + (save-excursion + (when (re-search-backward "^[^[:cntrl:]]" nil t) + (setq fname (helm-basename + (buffer-substring-no-properties + (point) (pos-eol)))))) + ;; Now format the string for the mode-line. + (let ((ml-str (helm-ff--rsync-progress-bar progbar proc))) + (setq ml-str (propertize ml-str 'help-echo + (format "%s->%s" (process-name proc) fname))) + ;; Now associate the formatted + ;; progress-bar string with process. + (helm-aif (assoc proc helm-rsync-progress-str-alist) + (setcdr it ml-str) + (setq helm-rsync-progress-str-alist + (push (cons proc ml-str) helm-rsync-progress-str-alist))))) + ;; Finally update mode-line. + (unless helm-rsync-no-mode-line-update + (force-mode-line-update)))) + +(defun helm-ff-kill-rsync-process (process) + "Kill rsync process PROCESS. + +When called interactively prompt user with completion when more than +one process." + (interactive (list (get-process + (helm-comp-read + "Kill rsync process: " + (mapcar (lambda (x) + (process-name (car x))) + helm-rsync-progress-str-alist) + :exec-when-only-one t)))) + (with-current-buffer (process-buffer process) + (delete-process process) + (kill-buffer)) + (setq helm-rsync-progress-str-alist + (delete (assoc process helm-rsync-progress-str-alist) + helm-rsync-progress-str-alist))) + +(defun helm-find-files-rsync (_candidate) + "Rsync files from `helm-find-files'." + (helm-find-files-do-action 'rsync)) + +(defun helm-find-files-copy (_candidate) + "Copy files from `helm-find-files'." + (helm-find-files-do-action 'copy)) + +(defun helm-find-files-backup (_candidate) + "Backup files from `helm-find-files'. +This reproduce the behavior of \"cp --backup=numbered from to\"." + (cl-assert (and (fboundp 'dired-async-mode) dired-async-mode) nil + "Backup only available when `dired-async-mode' is enabled") + (helm-find-files-do-action 'backup)) + +(defun helm-find-files-rename (_candidate) + "Rename files from `helm-find-files'." + (helm-find-files-do-action 'rename)) + +(defun helm-find-files-symlink (_candidate) + "Symlink files from `helm-find-files'." + (helm-find-files-do-action 'symlink)) + +(defun helm-find-files-relsymlink (_candidate) + "Relsymlink files from `helm-find-files'." + (helm-find-files-do-action 'relsymlink)) + +(defun helm-find-files-hardlink (_candidate) + "Hardlink files from `helm-find-files'." + (helm-find-files-do-action 'hardlink)) + +(defun helm-find-files-compress-to (_candidate) + "Compress to archive from `helm-find-files'." + (helm-find-files-do-action 'compress)) + +(defun helm-ff-compress-marked-files (_candidate) + "Compress or uncompress marked files with `dired-compress-file'." + (require 'dired-async) + (let* ((files (helm-marked-candidates :with-wildcard t))) + (if (not (with-helm-display-marked-candidates + helm-marked-buffer-name + (mapcar #'abbreviate-file-name files) + (y-or-n-p (format "Compress or uncompress *%s File(s)" (length files))))) + (message "(No (un)compression performed)") + (process-put + (async-start + `(lambda () + (require 'dired-aux) + (let ((len 0)) + (dolist (i ',files) + (let ((default-directory (file-name-directory i))) + (when (dired-compress-file i) + (cl-incf len)))) + len)) + (lambda (result) + (unless (dired-async-processes 'helm-async-compress) + (helm-ff--compress-async-modeline-mode -1)) + (message "%s File(s) (un)compressed" result) + (run-with-timer + 0.1 nil + (lambda (len flist) + (dired-async-mode-line-message + "%s %d/%d file(s) done" + 'helm-delete-async-message + "(Un)compressing" + len (length flist))) + result files))) + 'helm-async-compress t) + (helm-ff--compress-async-modeline-mode 1)))) + +(helm-make-command-from-action helm-ff-run-compress-marked-files + "Compress or uncompress marked files." + 'helm-ff-compress-marked-files) + +(defun helm-ff-chmod (_candidate) + "Set file mode on marked files. +If no mode is specified in prompt, default mode will be the mode of +the car of marked files i.e. the first marked file." + (let* ((mkd (helm-marked-candidates :with-wildcard t)) + (model (car mkd)) + (default (helm-file-attributes model :octal t)) + (mode (read-file-modes nil model)) + (smode (file-modes-number-to-symbolic mode)) + (candidates (if (string= default (format "%o" mode)) + (cdr mkd) mkd))) + (with-helm-display-marked-candidates + helm-marked-buffer-name + (helm-ff--count-and-collect-dups candidates) + (when (y-or-n-p (format "Change file mode to `%s'? " smode)) + (dolist (f candidates) + (unless (file-symlink-p f) + ;; For now don't use the FLAG arg 'nofollow of `set-file-modes' for + ;; Emacs-26 compatibility. + (set-file-modes f mode))) + (message "Changed file mode to `%s' on %s file(s)" + smode (length candidates)))))) + +(defun helm-ff--dired-marked-files (&rest _args) + ;; Internally dired-do-chxxx needs basenames. + (cl-loop for f in (helm-marked-candidates :with-wildcard t) + collect (helm-basename f))) + +(defun helm-ff--dired-get-filename (&rest _args) + ;; Internally dired-do-chxxx needs basenames. + (helm-aif (helm-get-selection) (helm-basename it))) + +(defun helm-ff-dired-do-chxxx (&rest args) + "Variation of `dired-do-chxxx' for helm." + (require 'dired-aux) + (cl-letf (((symbol-function 'dired-get-marked-files) + #'helm-ff--dired-marked-files) + ((symbol-function 'dired-do-redisplay) + #'ignore) + ((symbol-function 'dired-get-filename) + #'helm-ff--dired-get-filename)) + ;; dired-aux is requiring dired so dired-click-to-select-mode should be + ;; also available. + (let (dired-click-to-select-mode) + (apply #'dired-do-chxxx args)))) + +(defun helm-ff-chown (_candidate) + "Variation of `dired-do-chown' for helm." + (with-helm-default-directory helm-ff-default-directory + (when (and (memq system-type '(ms-dos windows-nt)) + (not (file-remote-p default-directory))) + (error "chown not supported on this system")) + (helm-ff-dired-do-chxxx "Owner" dired-chown-program 'chown nil))) + +(defun helm-ff-chgrp (_candidate) + "Variation of `dired-do-chgrp' for helm." + (with-helm-default-directory helm-ff-default-directory + (when (and (memq system-type '(ms-dos windows-nt)) + (not (file-remote-p default-directory))) + (error "chown not supported on this system")) + (helm-ff-dired-do-chxxx "Group" "chgrp" 'chgrp nil))) + +(helm-make-command-from-action helm-ff-run-chown "Change owner on file(s)." 'helm-ff-chown) +(helm-make-command-from-action helm-ff-run-chgrp "Change group on file(s)." 'helm-ff-chgrp) +(put 'helm-ff-run-chown 'helm-only t) +(put 'helm-ff-run-chgrp 'helm-only t) + +(defun helm-find-files-other-window (_candidate) + "Keep current-buffer and open files in separate windows. +When a prefix arg is detected files are opened in a vertical +windows layout." + (let* ((files (helm-marked-candidates)) + (buffers (mapcar 'find-file-noselect files))) + (helm-window-show-buffers buffers t))) + +(defun helm-find-files-byte-compile (_candidate) + "Byte compile elisp files from `helm-find-files'." + (let ((files (helm-marked-candidates :with-wildcard t)) + (parg helm-current-prefix-arg)) + (cl-loop for fname in files + do (condition-case _err + (with-no-warnings + (byte-compile-file fname parg)) + (wrong-number-of-arguments + ;; Emacs-28 accepts only one arg. + (byte-compile-file fname) + (when parg (load fname))))))) + +(defun helm-find-files-load-files (_candidate) + "Load elisp files from `helm-find-files'." + (let ((files (helm-marked-candidates :with-wildcard t))) + (cl-loop for fname in files + do (load fname)))) + +(defun helm-find-files-ediff-files-1 (candidate &optional merge) + "Generic function to ediff/merge files in `helm-find-files'." + (let* ((helm-dwim-target 'next-window) + (bname (helm-basename candidate)) + (marked (helm-marked-candidates :with-wildcard t)) + (prompt (if merge "Ediff Merge `%s' With File: " + "Ediff `%s' With File: ")) + (fun (if merge 'ediff-merge-files 'ediff-files)) + (input (helm-dwim-target-directory)) + (presel (if helm-ff-transformer-show-only-basename + (helm-basename candidate) + (expand-file-name + (helm-basename candidate) + input)))) + (if (= (length marked) 2) + (funcall fun (car marked) (cadr marked)) + (funcall fun candidate (helm-read-file-name + (format prompt bname) + :initial-input input + :default (helm-dwim-target-directories) + :preselect presel))))) + +(defun helm-find-files-ediff-files (candidate) + (helm-find-files-ediff-files-1 candidate)) + +(defun helm-find-files-ediff-merge-files (candidate) + (helm-find-files-ediff-files-1 candidate 'merge)) + +(defun helm-find-files-grep (_candidate) + "Default action to grep files from `helm-find-files'." + (helm-do-grep-1 (helm-marked-candidates :with-wildcard t) + helm-current-prefix-arg)) + +(defun helm-ff-git-grep (_candidate) + "Default action to git-grep `helm-ff-default-directory'." + (helm-grep-git-1 helm-ff-default-directory helm-current-prefix-arg)) + +(defun helm-find-files-ag (_candidate) + (helm-grep-ag helm-ff-default-directory + helm-current-prefix-arg)) + +(defun helm-ff-zgrep (_candidate) + "Default action to zgrep files from `helm-find-files'." + (helm-ff-zgrep-1 (helm-marked-candidates :with-wildcard t) helm-current-prefix-arg)) + +(defun helm-ff-pdfgrep (_candidate) + "Default action to pdfgrep files from `helm-find-files'." + (let* ((recurse nil) + (cands (cl-loop for file in (helm-marked-candidates :with-wildcard t) + for dir = (file-directory-p file) + when dir do (setq recurse t) + when (or dir + (string= (file-name-extension file) "pdf") + (string= (file-name-extension file) "PDF")) + collect file))) + (when cands + (helm-do-pdfgrep-1 cands recurse)))) + +(defun helm-ff-etags-select (candidate) + "Default action to jump to etags from `helm-find-files'." + (when (get-buffer helm-action-buffer) + (kill-buffer helm-action-buffer)) + (let* ((source-name (assoc-default 'name (helm-get-current-source))) + (default-directory (if (string= source-name "Find Files") + helm-ff-default-directory + (file-name-directory candidate)))) + (helm-etags-select helm-current-prefix-arg))) + +;;; Eshell command on file +;; +(defvar eshell-command-aliases-list nil) +(defvar helm-eshell-command-on-file-input-history nil) +(defvar helm-eshell-command-on-file-history nil) +(cl-defun helm-find-files-eshell-command-on-file-1 (&optional map) + "Run `eshell-command' on CANDIDATE or marked candidates. +This is done possibly with an Eshell alias. If no alias found, +you can type in an Eshell command. + +Only aliases accepting a file as argument at the end of command +line are collected, i.e. aliases ending with \"$1\" or \"$*\". + +Basename of CANDIDATE can be a wild-card. +E.g. you can do \"eshell-command command *.el\" +Where \"*.el\" is the CANDIDATE. + +It is possible to do eshell-command command like this: \"command %s some more args\". + +If MAP is given run `eshell-command' on all marked files at once, +Otherwise, run `eshell-command' on each marked files. +In other terms, with a prefix arg do on the three marked files +\"foo\" \"bar\" \"baz\": + +\"eshell-command command foo bar baz\" + +otherwise do + +\"eshell-command command foo\" +\"eshell-command command bar\" +\"eshell-command command baz\" + +Note: +You have to setup some aliases in Eshell with the `alias' command +or by editing yourself the file `eshell-aliases-file' to make +this working." + (require 'helm-adaptive) + (require 'em-alias) (eshell-read-aliases-list) + (unless (> emacs-major-version 27) + ;; This advice has been merged in emacs-28. + (advice-add 'eshell-eval-command :override #'helm--advice-eshell-eval-command)) + (when (or eshell-command-aliases-list + (y-or-n-p "No eshell aliases found, run eshell-command without alias anyway? ")) + (let* ((cand-list (helm-marked-candidates :with-wildcard t)) + (default-directory (or helm-ff-default-directory + ;; If candidate is an url *-ff-default-directory is nil + ;; so keep value of default-directory. + default-directory)) + helm-display-source-at-screen-top + (helm-actions-inherit-frame-settings t) + helm-use-frame-when-more-than-two-windows + (command + (with-helm-display-marked-candidates + helm-marked-buffer-name + (helm-ff--count-and-collect-dups + (mapcar 'helm-basename cand-list)) + (with-helm-current-buffer + (helm-comp-read + "Command: " + (cl-loop with len = 0 + with aliases = + (cl-loop for (a c) in (eshell-read-aliases-list) + for len-key = (length a) + when + (and (string-match + "\\(\\$1\\|\\$\\*\\)" + c) + (not (member a helm-ff-eshell-unwanted-aliases))) + do (when (> len-key len) (setq len len-key)) + and collect (list a c)) + for (a c) in aliases + collect (cons + (concat (propertize + a 'face 'font-lock-keyword-face) + (make-string (1+ (- len (length a))) ? ) + c) + a)) + :fc-transformer #'helm-adaptive-sort + :buffer "*helm eshell on file*" + :name "Eshell command" + :mode-line + '("Eshell alias" + "C-h m: Help, \\[universal-argument]: Insert output at point") + :help-message 'helm-esh-help-message + :history 'helm-eshell-command-on-file-history + :raw-history t + :reverse-history helm-eshell-on-file-reverse-history + :input-history + 'helm-eshell-command-on-file-input-history + ;; Allow quoting when writing in minibuffer i.e. allow usage of + ;; \@ and \#. + :raw-candidate t)))) + (alias-value (car (assoc-default command eshell-command-aliases-list))) + cmd-line) + (if (or (equal helm-current-prefix-arg '(16)) + (equal map '(16))) + ;; Two time C-u from `helm-comp-read' mean print to current-buffer. + ;; i.e `eshell-command' will use this value. + (setq current-prefix-arg '(16)) + ;; Else reset the value of `current-prefix-arg' + ;; to avoid printing in current-buffer. + (setq current-prefix-arg nil)) + (if (and (or + ;; One prefix-arg have been passed before `helm-comp-read'. + ;; If map have been set with C-u C-u (value == '(16)) + ;; ignore it. + (and map (equal map '(4))) + ;; One C-u from `helm-comp-read'. + (equal helm-current-prefix-arg '(4)) + ;; An alias that finish with $* + (and alias-value + ;; If command is an alias be sure it accept + ;; more than one arg i.e $*. + (string-match "\\$\\*" alias-value))) + (cdr cand-list) + (and alias-value + ;; Command is an alias and accept only one arg. + (not (string-match "\\$1" alias-value)))) + + ;; Run eshell-command with ALL marked files as argument. + ;; This wont work on remote files, because tramp handlers depend + ;; on `default-directory' (limitation). + (let ((mapfiles (mapconcat 'shell-quote-argument cand-list " "))) + (if (string-match "%s" command) + (setq cmd-line (format command mapfiles)) ; See [1] + (setq cmd-line (format "%s %s" command mapfiles))) + (eshell-command cmd-line)) + + ;; Run eshell-command sequencially on EACH marked files. + ;; To work with tramp handler we have to call + ;; COMMAND on basename of each file, using + ;; its basedir as `default-directory'. + (unwind-protect + (progn + (cl-loop for f in cand-list + for n from 1 + for dir = (and (not (string-match helm--url-regexp f)) + (helm-basedir f)) + ;; We can use basename here as the command will run + ;; under default-directory. + ;; This allows running e.g. + ;; "tar czvf test.tar.gz %s/*" without creating + ;; an archive expanding from /home. + for file = (shell-quote-argument + (if (string-match helm--url-regexp f) + f (helm-basename f))) + ;; \@ => placeholder for file without extension. + ;; \# => placeholder for incremental number. + for fcmd = (helm-aand command + (replace-regexp-in-string + "\\\\#" (format "%03d" n) + it t t) + (replace-regexp-in-string + "\\\\@" + (regexp-quote + (file-name-sans-extension file)) + it t t)) + for com = (if (string-match "%s" fcmd) + ;; [1] This allows to enter other args AFTER filename + ;; i.e + (format fcmd file) + (format "%s %s" fcmd file)) + do (let ((default-directory (or dir default-directory))) + (eshell-command com)))) + ;; Async process continues running but doesn't need anymore + ;; the advice at this point (see the `eshell-eval-command' + ;; call in `eshell-command'). + (unless (> emacs-major-version 27) + (advice-remove 'eshell-eval-command #'helm--advice-eshell-eval-command))))))) + +(defun helm--advice-eshell-eval-command (command &optional input) + "Fix return value when command ends with \"&\"." + ;; Fix this emacs commit which is plain wrong as it returns + ;; either nil or an error (double because format spec doesn't + ;; always match specifier) whereas it should return either a + ;; single element (CAR DELIM) or DELIM itself if the car of + ;; DELIM is a process. + ;; This prevent running eshell-command async when needed i.e. when + ;; command ends with "&". + ;; + ;; UPDATE: This have now been merged in Emacs-28. + ;; + ;; 6b6f91b357f6fe2f1e0d72f046a1b8d8a2d6d8c3 + ;; Author: John Wiegley + ;; AuthorDate: Fri May 27 02:57:18 2005 +0000 + ;; Commit: John Wiegley + ;; CommitDate: Fri May 27 02:57:18 2005 +0000 + (if eshell-current-command + ;; we can just stick the new command at the end of the current + ;; one, and everything will happen as it should + (setcdr (last (cdr eshell-current-command)) + (list `(let ((here (and (eobp) (point)))) + ,(and input + `(insert-and-inherit ,(concat input "\n"))) + (if here + (eshell-update-markers here)) + (eshell-do-eval ',command)))) + (and eshell-debug-command + (with-current-buffer (get-buffer-create "*eshell last cmd*") + (erase-buffer) + (insert "command: \"" input "\"\n"))) + (setq eshell-current-command command) + (let* ((delim (catch 'eshell-incomplete + (eshell-resume-eval))) + (val (car-safe delim))) + ;; If the return value of `eshell-resume-eval' is wrapped in a + ;; list, it indicates that the command was run asynchronously. + ;; In that case, unwrap the value before checking the delimiter + ;; value. + (if (and val + (not (processp val)) + (not (eq val t))) + (error "Unmatched delimiter: %S" val) + ;; Eshell-command expect a list like () to know if the + ;; command should be async or not. + (or (and (processp val) delim) val))))) + +(defun helm-find-files-eshell-command-on-file (_candidate) + "Run `eshell-command' on CANDIDATE or marked candidates. +See `helm-find-files-eshell-command-on-file-1' for more info." + (helm-find-files-eshell-command-on-file-1 helm-current-prefix-arg)) + +(defun helm-ff--shell-interactive-buffer-p (buffer &optional mode) + (with-current-buffer buffer + (when (eq major-mode (or mode 'eshell-mode)) + (let ((next-prompt-fn (cl-case major-mode + (shell-mode #'comint-next-prompt) + (eshell-mode #'eshell-next-prompt) + (term-mode #'term-next-prompt)))) + (save-excursion + (goto-char (point-min)) + (funcall next-prompt-fn 1) + (null (eql (point) (point-min)))))))) + +(defun helm-ff-switch-to-shell (_candidate) + "Switch to a shell buffer and cd to `helm-ff-default-directory'. +Set your preferred shell mode in `helm-ff-preferred-shell-mode'. + +With a numeric prefix arg switch to numbered shell buffer, if no +prefix arg provided and more than one shell buffer exists, provide +completions on those buffers. If only one shell buffer exists, +switch to this one, if no shell buffer exists or if the numeric +prefix arg shell buffer doesn't exists, create it and switch to it." + ;; Reproduce the Emacs-25 behavior to be able to edit and send + ;; command in term buffer. + (let (term-char-mode-buffer-read-only ; Emacs-25 behavior. + term-char-mode-point-at-process-mark ; Emacs-25 behavior. + (cd-eshell (lambda () + (eshell/cd helm-ff-default-directory) + (eshell-reset))) + (cd-shell + (lambda () + (goto-char (point-max)) + (when (eq helm-ff-preferred-shell-mode 'shell-mode) + (comint-delete-input)) + (insert (format "cd %s" + (shell-quote-argument + (or (file-remote-p + helm-ff-default-directory 'localname) + helm-ff-default-directory)))) + (cl-case helm-ff-preferred-shell-mode + (shell-mode (comint-send-input)) + (term-mode (progn (term-char-mode) (term-send-input)))))) + (bufs (cl-loop for b in (mapcar 'buffer-name (buffer-list)) + when (helm-ff--shell-interactive-buffer-p + b helm-ff-preferred-shell-mode) + collect b))) + ;; Jump to a shell buffer or open a new session. + (helm-aif (and (not helm-current-prefix-arg) + (if (cdr bufs) + (helm-comp-read "Switch to shell buffer: " bufs + :must-match t) + (car bufs))) + ;; Display in same window by default to preserve the + ;; historical behaviour + (pop-to-buffer it '(display-buffer-same-window)) + (cl-case helm-ff-preferred-shell-mode + (eshell-mode + (eshell helm-current-prefix-arg)) + (shell-mode + (shell (helm-aif (and helm-current-prefix-arg + (prefix-numeric-value + helm-current-prefix-arg)) + (format "*shell<%s>*" it)))) + (term-mode + (progn + (ansi-term (getenv "SHELL") + (helm-aif (and helm-current-prefix-arg + (prefix-numeric-value + helm-current-prefix-arg)) + (format "*ansi-term<%s>*" it))) + (term-line-mode))))) + ;; Now cd into directory. + (helm-aif (and (memq major-mode '(shell-mode term-mode)) + (get-buffer-process (current-buffer))) + (accept-process-output it 0.1)) + (unless (helm-ff-shell-alive-p major-mode) + (funcall + (if (eq major-mode 'eshell-mode) cd-eshell cd-shell))))) + +(defun helm-ff-shell-alive-p (mode) + "Returns non nil when a process is running inside `shell-mode' buffer." + (cl-ecase mode + (shell-mode + (save-excursion + (comint-goto-process-mark) + (or (null comint-last-prompt) + (not (eql (point) + (marker-position (cdr comint-last-prompt))))))) + (eshell-mode + (get-buffer-process (current-buffer))) + (term-mode + (save-excursion + (goto-char (term-process-mark)) + (not (looking-back "\\$ " (- (point) 2))))))) + +(defun helm-ff-touch-files (_candidate) + "The touch files action for helm-find-files." + (let* ((files (helm-marked-candidates)) + (split (cl-loop for f in files + for spt = (unless helm-current-prefix-arg + (cons (helm-basedir f) + (split-string f ", ?"))) + if spt + append (cl-loop with dir = (car spt) + for ff in (cdr spt) + collect (expand-file-name ff dir)) + else collect f)) + (timestamp (helm-comp-read + "Timestamp (default Now): " + (cl-loop for f in split + for time = (file-attributes f) + for date = (and time + (format-time-string + "%Y-%m-%d %H:%M:%S" + (nth 5 time))) + when date + collect (cons (format "%s: %s" + (helm-basename f) date) + date)) + :default + (format-time-string "%Y-%m-%d %H:%M:%S" + (current-time)))) + (failures + (cl-loop with default-directory = helm-ff-default-directory + for f in split + for file = (or (file-remote-p f 'localname) f) + when (> (process-file + "touch" nil nil nil "-d" timestamp file) + 0) + collect f))) + (when failures + (message "Failed to touch *%s files:\n%s" + (length failures) + (mapconcat (lambda (f) (format "- %s\n" f)) failures ""))))) + +(defun helm-ff-encrypt-files (_candidate) + "Encrypt marked files." + (require 'epg) (require 'epa) (require 'helm-epa) + (let* ((mkds (helm-marked-candidates :with-wildcard t)) + (recipients (helm :sources (helm-build-sync-source + "Select recipient for encryption: " + :persistent-action 'ignore + :candidates 'helm-epa-get-key-list + :action (lambda (_candidate) + (helm-marked-candidates)) + :must-match t) + :buffer "*helm-ff epg keys*")) + (keys (and recipients (helm-epa-collect-keys-from-candidates recipients))) + (ids (and recipients (helm-epa-collect-id-from-candidates recipients)))) + (when recipients ; may be aborted by quit. + (cl-loop for f in mkds + do (epa-encrypt-file f recipients)) + (helm-epa-success-message (concat (format "%s File(s) encrypted" (length mkds)) + " with key(s):\n %s") + keys ids)))) + +(helm-make-command-from-action helm-ff-run-touch-files + "Used to interactively run touch file action from keyboard." + 'helm-ff-touch-files) + +(defun helm-ff-sort-by-size () + (interactive) + (let ((helm-ff-initial-sort-method 'size)) + (helm-force-update + (concat (regexp-quote (helm-get-selection + nil helm-ff-transformer-show-only-basename)) + "$")) + (message "Sorting by size"))) +(put 'helm-ff-sort-by-size 'helm-only t) + +(defun helm-ff-sort-by-newest () + (interactive) + (let ((helm-ff-initial-sort-method 'newest)) + (helm-force-update + (concat (regexp-quote (helm-get-selection + nil helm-ff-transformer-show-only-basename)) + "$")) + (message "Sorting by newest"))) +(put 'helm-ff-sort-by-newest 'helm-only t) + +(defun helm-ff-sort-by-ext () + (interactive) + (let ((helm-ff-initial-sort-method 'ext)) + (helm-force-update + (concat (regexp-quote (helm-get-selection + nil helm-ff-transformer-show-only-basename)) + "$")) + (message "Sorting by extensions"))) +(put 'helm-ff-sort-by-ext 'no-helm-mx t) + +(defun helm-ff-sort-alpha () + (interactive) + (let ((helm-ff-initial-sort-method nil)) + (helm-force-update + (concat (regexp-quote (helm-get-selection + nil helm-ff-transformer-show-only-basename)) + "$")) + (message "Sorting alphabetically"))) +(put 'helm-ff-sort-alpha 'helm-only t) + +(defun helm-ff-directories-only (candidates _source) + (if helm-ff--show-directories-only + (cl-loop for (d . r) in candidates + when (file-directory-p r) + ;; We can use this as long as this filtering function + ;; is called after `helm-ff-fct' otherwise candidates + ;; may not be cons cell at first call [1]. + collect (cons d r)) + candidates)) + +(defun helm-ff-files-only (candidates _source) + (if helm-ff--show-files-only + (cl-loop for (d . r) in candidates + unless (file-directory-p r) + ;; Same comment as in [1] above. + collect (cons d r)) + candidates)) + +(defun helm-ff-toggle-dirs-only () + "Show only directories in helm-find-files." + (interactive) + (with-helm-alive-p + (setq helm-ff--show-directories-only (not helm-ff--show-directories-only)) + (setq helm-ff--show-files-only nil) + (helm-update (helm-get-selection nil t)))) +(put 'helm-ff-toggle-dirs-only 'helm-only t) + +(defun helm-ff-toggle-files-only () + "Show only files in helm-find-files." + (interactive) + (with-helm-alive-p + (setq helm-ff--show-files-only (not helm-ff--show-files-only)) + (setq helm-ff--show-directories-only nil) + (helm-update (helm-get-selection nil t)))) +(put 'helm-ff-toggle-files-only 'helm-only t) + +(defun helm-ff-after-persistent-show-all () + (when helm-ff-reset-filters-on-update + (setq helm-ff--show-directories-only nil + helm-ff--show-files-only nil))) + +(defun helm-ff-serial-rename-action (method) + "Rename all marked files in `helm-ff-default-directory' with METHOD. +See `helm-ff-serial-rename-1'." + (let* ((helm--reading-passwd-or-string t) + (cands (helm-marked-candidates :with-wildcard t)) + (def-name (car cands)) + (name (helm-read-string "NewName: " + (replace-regexp-in-string + "[0-9]+$" "" + (helm-basename + def-name + (file-name-extension def-name))))) + (start (read-number "StartAtNumber: ")) + (extension (helm-read-string "Extension: " + (file-name-extension (car cands)))) + (dir (expand-file-name + (helm-read-file-name + "Serial Rename to directory: " + :initial-input + (expand-file-name helm-ff-default-directory) + :test 'file-directory-p + :must-match t))) + done) + (with-helm-display-marked-candidates + helm-marked-buffer-name (helm-ff--count-and-collect-dups cands) + (if (y-or-n-p + (format "Rename %s file(s) to <%s> like this ?\n%s " + (length cands) dir (format "%s <-> %s%s.%s" + (helm-basename (car cands)) + name start extension))) + (progn + (helm-ff-serial-rename-1 + dir cands name start extension :method method) + (setq done t) + (message nil)))) + (if done + (with-helm-current-buffer (helm-find-files-1 dir)) + (message "Operation aborted")))) + +(defun helm-ff-member-directory-p (file directory) + (let ((dir-file (expand-file-name + (file-name-as-directory (file-name-directory file)))) + (cur-dir (expand-file-name (file-name-as-directory directory)))) + (string= dir-file cur-dir))) + +(cl-defun helm-ff-serial-rename-1 + (directory collection new-name start-at-num extension &key (method 'rename)) + "Rename files in COLLECTION to DIRECTORY with the prefix name NEW-NAME. +Rename start at number START-AT-NUM - ex: prefixname-01.jpg. +EXTENSION is the file extension to use. In empty prompt, reuse +the original extension of file. +METHOD can be one of rename, copy or symlink. +Files will be renamed if they are files of current directory, +otherwise they will be treated with METHOD. +Default METHOD is rename." + ;; Maybe remove directories selected by error in collection. + (setq collection (cl-remove-if 'file-directory-p collection)) + (let* ((tmp-dir (file-name-as-directory + (concat (file-name-as-directory directory) + (symbol-name (cl-gensym "tmp"))))) + (fn (cl-case method + (copy 'copy-file) + (symlink 'make-symbolic-link) + (rename 'rename-file) + (t (error "Error: Unknown method %s" method))))) + (make-directory tmp-dir) + (unwind-protect + (progn + ;; Rename all files to tmp-dir with new-name. + ;; If files are not from start directory, use method + ;; to move files to tmp-dir. + (cl-loop for i in collection + for count from start-at-num + for fnum = (if (< count 10) "0%s" "%s") + for nname = (concat tmp-dir new-name (format fnum count) + (if (not (string= extension "")) + (format ".%s" (replace-regexp-in-string + "[.]" "" extension)) + (file-name-extension i 'dot))) + do (if (helm-ff-member-directory-p i directory) + (rename-file i nname) + (funcall fn i nname))) + ;; Now move all from tmp-dir to destination. + (cl-loop with dirlist = (directory-files + tmp-dir t directory-files-no-dot-files-regexp) + for f in dirlist do + (if (file-symlink-p f) + (make-symbolic-link (file-truename f) + (concat (file-name-as-directory directory) + (helm-basename f))) + (rename-file f directory)))) + (delete-directory tmp-dir t)))) + +(defun helm-ff-serial-rename (_candidate) + "Serial rename all marked files to `helm-ff-default-directory'. +Rename only file of current directory, and symlink files coming from +other directories. +See `helm-ff-serial-rename-1'." + (helm-ff-serial-rename-action 'rename)) + +(defun helm-ff-serial-rename-by-symlink (_candidate) + "Serial rename all marked files to `helm-ff-default-directory'. +Rename only file of current directory, and symlink files coming +from other directories. +See `helm-ff-serial-rename-1'." + (helm-ff-serial-rename-action 'symlink)) + +(defun helm-ff-serial-rename-by-copying (_candidate) + "Serial rename all marked files to `helm-ff-default-directory'. +Rename only file of current directory, and copy files coming from +other directories. +See `helm-ff-serial-rename-1'." + (helm-ff-serial-rename-action 'copy)) + +(defvar helm-ff-query-replace-fnames-history-from nil) +(defvar helm-ff-query-replace-fnames-history-to nil) +(defun helm-ff-query-replace-on-filenames (candidates) + "Query replace on filenames of CANDIDATES. +This doesn't replace inside the files, only modify filenames." + (with-helm-display-marked-candidates + helm-marked-buffer-name + (mapcar 'helm-basename candidates) + (let* ((regexp (read-string "Replace regexp on filename(s): " + nil 'helm-ff-query-replace-history-from + (helm-basename (car candidates)))) + (rep (read-string (format "Replace regexp `%s' with: " regexp) + nil 'helm-ff-query-replace-history-to))) + (cl-loop with query = "y" + with count = 0 + for old in candidates + for new = (helm-ff--query-replace-in-fname-set-new-name + old regexp rep count) + ;; If `regexp' is not matched in `old' + ;; `replace-regexp-in-string' will + ;; return `old' unmodified. + unless (string= old new) + do (progn + (when (file-exists-p new) + (setq new (concat (file-name-sans-extension new) + (format "(%s)" count) + (file-name-extension new t)))) + (unless (string= query "!") + (setq query (helm-read-answer (format + "Replace `%s' by `%s' [!,y,n,q,h]" + (helm-basename old) + (helm-basename new)) + '("y" "n" "!" "q") + #'helm-read-answer-default-help-fn))) + (when (string= query "q") + (cl-return (message "Operation aborted"))) + (unless (string= query "n") + (rename-file old new) + (cl-incf count))) + finally (message "%d Files renamed" count)))) + ;; This fix the emacs bug where "Emacs-Lisp:" is sent + ;; in minibuffer (not the echo area). + (sit-for 0.1) + (with-current-buffer (window-buffer (minibuffer-window)) + (delete-minibuffer-contents))) + +(defun helm-ff--query-replace-in-fname-set-new-name (old regexp rep count) + "Setup a new name for OLD replacing part matching REGEXP with REP. +COUNT is used for incrementing new name if needed." + (let (subexp target) + (concat (helm-basedir old) + (helm--replace-regexp-in-buffer-string + (save-match-data + (cond ((string= regexp "%.") + (setq subexp 1) + (helm-ff--prepare-str-with-regexp + (setq target (helm-basename old t)))) + ((string= regexp ".%") + (setq subexp 1) + (helm-ff--prepare-str-with-regexp + (setq target (file-name-extension old)))) + ((string= regexp "%") + (regexp-quote + (setq target (helm-basename old)))) + ((string-match "%:\\([0-9]+\\):\\([0-9]+\\)" regexp) + (setq subexp 1) + (let ((beg (match-string 1 regexp)) + (end (match-string 2 regexp)) + (str (helm-basename old))) + (setq target (substring str + (string-to-number beg) + (string-to-number end))) + (helm-ff--prepare-str-with-regexp str beg end))) + (t regexp))) + (save-match-data + (cond (;; Handle incremental + ;; replacement with \# in + ;; search and replace + ;; feature in placeholder \@. + (string-match "\\\\@/\\(.*\\)/\\(.*\\)/" rep) + (helm-aand (save-match-data + (replace-regexp-in-string + "\\\\#" (format "%03d" (1+ count)) + (match-string 2 rep))) + (replace-regexp-in-string + (match-string 1 rep) it target))) + ;; Incremental replacement + ;; before or after \@. + ((or (string-match "\\`\\\\#\\\\@\\'" rep) + (string-match "\\`\\\\@\\\\#\\'" rep)) + (replace-regexp-in-string + "\\\\#" (format "%03d" (1+ count)) + (replace-match target t t rep))) + ;; Simple incremental replacement. + ((or (string-match "\\`\\\\#" rep) + (string-match "\\\\#\\'" rep)) + (replace-match + (format "%03d" (1+ count)) t t rep)) + ;; Substring replacement in placeholder. + ((string-match + "\\\\@:\\([0-9]*\\):\\([0-9]*\\)" rep) + (replace-match (substring + target + (string-to-number + (match-string 1 rep)) + (helm-acase (match-string 2 rep) + ((guard* (string= it "")) + (length target)) + (t (string-to-number it)))) + t t rep)) + ;; Simple replacement by placeholder. + ((string-match "\\\\@" rep) + (replace-match target t t rep)) + ;; Replacement with + ;; upcase, downcase or + ;; capitalized text. + ((string= rep "%u") #'upcase) + ((string= rep "%d") #'downcase) + ((string= rep "%c") #'capitalize) + ;; Simple replacement with + ;; whole replacement regexp. + (t rep))) + (helm-basename old) t nil subexp)))) + +(defun helm-ff--prepare-str-with-regexp (str &optional rep1 rep2) + ;; This is used in `helm-ff-query-replace-on-filenames' to prepare + ;; STR when REGEXP is specified as substring e.g %:1:3 in this case + ;; substring from 1 to 3 in STR will be enclosed with parenthesis to + ;; match this substring as a subexp e.g %:1:3 on string "emacs" will + ;; be replaced by "e\\(ma\\)cs" using subexp 1 like this: + ;; (helm--replace-regexp-in-buffer-string "e\\(ma\\)cs" "fo" "emacs" nil t 1) + ;; => "efocs" + ;; ^^ + ;; Where "1" and "3" will be strings extracted with match-string + ;; from regexp and refered respectively in this function as REP1 and + ;; REP2. + (let* ((from (or (and rep1 (string-to-number rep1)) 0)) + (to (or (and rep2 (string-to-number rep2)) (length str))) + (subexp (concat "\\(" (regexp-quote (substring str from to)) "\\)")) + (before-str (unless (zerop from) + (regexp-quote (substring str 0 from)))) + (after-str (unless (= to (length str)) + (regexp-quote (substring str to (length str)))))) + (concat before-str subexp after-str))) + +;; The action. +(defun helm-ff-query-replace-fnames-on-marked (_candidate) + (let ((marked (helm-marked-candidates :with-wildcard t))) + (helm-ff-query-replace-on-filenames marked))) + +;; The command for `helm-find-files-map'. +(helm-make-command-from-action helm-ff-run-query-replace-fnames-on-marked + "Run query-replace on filenames from HFF." + 'helm-ff-query-replace-fnames-on-marked) + +(defun helm-ff-query-replace (_candidate) + (let ((bufs (cl-loop for f in (helm-marked-candidates :with-wildcard t) + collect (buffer-name (find-file-noselect f))))) + (helm-buffer-query-replace-1 nil bufs))) + +(helm-make-command-from-action helm-ff-run-query-replace + "Run query-replace from HFF." + 'helm-ff-query-replace) + +(defun helm-ff-query-replace-regexp (_candidate) + (let ((bufs (cl-loop for f in (helm-marked-candidates :with-wildcard t) + collect (buffer-name (find-file-noselect f))))) + (helm-buffer-query-replace-1 'regexp bufs))) + +(helm-make-command-from-action helm-ff-run-query-replace-regexp + "Run query-replace regexp from HFF." + 'helm-ff-query-replace-regexp) + +(defun helm-ff-toggle-auto-update () + (if helm-ff--deleting-char-backward + (progn + (message "[Auto expansion disabled]") + (sit-for 1) (message nil) + (setq helm-ff--auto-update-state nil)) + (setq helm-ff-auto-update-flag (not helm-ff-auto-update-flag)) + (setq helm-ff--auto-update-state helm-ff-auto-update-flag) + (message "[Auto expansion %s]" + (if helm-ff-auto-update-flag "enabled" "disabled")))) + +(defun helm-ff-run-toggle-auto-update () + (interactive) + (with-helm-alive-p + (helm-ff-toggle-auto-update))) +(put 'helm-ff-run-toggle-auto-update 'helm-only t) + +(defun helm-ff-delete-char-backward () + "Go up one level or disable HFF auto update and delete char backward. + +Going up one level works only when pattern is a directory endings +with \"/\", otherwise this command deletes char backward. + +Going up one level can be disabled if necessary by deleting \"/\" +at end of pattern using \\\\[backward-char] and +\\[helm-delete-minibuffer-contents]." + (interactive) + (with-helm-alive-p + (if (and helm-ff-DEL-up-one-level-maybe + (string-match "/\\'" helm-pattern) + (file-directory-p helm-pattern)) + (call-interactively 'helm-find-files-up-one-level) + (setq helm-ff-auto-update-flag nil) + (setq helm-ff--deleting-char-backward t) + (call-interactively + (lookup-key (current-global-map) + (read-kbd-macro "DEL")))))) +(put 'helm-ff-delete-char-backward 'helm-only t) + +(defun helm-ff-delete-char-backward--exit-fn () + (setq helm-ff-auto-update-flag helm-ff--auto-update-state) + (setq helm-ff--deleting-char-backward nil)) + +(defvar helm-ff--RET-disabled nil) +(defun helm-ff-RET-1 () + "Used for RET action in `helm-find-files' and `helm-read-file-name'. +See `helm-ff-RET' for details." + (catch 'must-match + (let ((sel (helm-get-selection)) + ;; Ensure `file-directory-p' works on remote files. + non-essential) + ;; `helm--minibuffer-completing-file-name' is non nil that's mean we are + ;; in `helm-read-file-name'. + (if (and helm--minibuffer-completing-file-name (null sel)) + (throw 'must-match (minibuffer-message "[No match]")) + (cl-assert sel nil "Trying to exit with no candidates")) + (if (and (or (file-directory-p sel) + (helm-ff--invalid-tramp-name-p sel)) + ;; Allows exiting with default action when a prefix arg + ;; is specified. + (null current-prefix-arg) + (null helm-ff--RET-disabled) + (or (and (file-remote-p sel) + (string= "." (helm-basename sel)) + (string-match-p "\\`[/].*:.*:\\'" + helm-pattern)) + (not (string= "." (helm-basename sel))))) + (helm-execute-persistent-action) + (helm-maybe-exit-minibuffer))))) + +(defun helm-ff-RET () + "Default action for RET in `helm-find-files'. + +Behave differently depending on `helm-selection': + +- candidate basename is \".\" => open it in dired. +- candidate is a directory => expand it. +- candidate is a file => open it." + (interactive) + (helm-ff-RET-1)) +(put 'helm-ff-RET 'helm-only t) + +(defun helm-ff-TAB-1 (&optional force-menu) + "Used for TAB action in `helm-find-files'." + (let ((sel (helm-get-selection))) + (if (and (null force-menu) + (file-directory-p sel) + (not (string= "." (helm-basename sel)))) + (helm-execute-persistent-action) + (helm-select-action)))) + +(defun helm-ff-TAB (arg) + "Default action for TAB in `helm-find-files'. + +Behave differently depending on `helm-selection': + +- candidate basename is \".\" => open the action menu. +- candidate is a directory => expand it. +- candidate is a file => open action menu. + +Called with a prefix arg open menu unconditionally." + (interactive "P") + (helm-ff-TAB-1 arg)) +(put 'helm-ff-TAB 'helm-only t) + +(helm-make-command-from-action helm-ff-run-grep + "Run Grep action from `helm-source-find-files'." + 'helm-find-files-grep) + +(helm-make-command-from-action helm-ff-run-git-grep + "Run git-grep action from `helm-source-find-files'." + 'helm-ff-git-grep) + +(helm-make-command-from-action helm-ff-run-grep-ag + "Run grep AG action from `helm-source-find-files'." + 'helm-find-files-ag) + +(helm-make-command-from-action helm-ff-run-pdfgrep + "Run Pdfgrep action from `helm-source-find-files'." + 'helm-ff-pdfgrep) + +(helm-make-command-from-action helm-ff-run-zgrep + "Run Grep action from `helm-source-find-files'." + 'helm-ff-zgrep) + +(helm-make-command-from-action helm-ff-run-copy-file + "Run Copy file action from `helm-source-find-files'." + 'helm-find-files-copy) + +(helm-make-command-from-action helm-ff-run-rsync-file + "Run Rsync file action from `helm-source-find-files'." + 'helm-find-files-rsync) + +(helm-make-command-from-action helm-ff-run-rename-file + "Run Rename file action from `helm-source-find-files'." + 'helm-find-files-rename) + +(helm-make-command-from-action helm-ff-run-byte-compile-file + "Run Byte compile file action from `helm-source-find-files'." + 'helm-find-files-byte-compile) + +(helm-make-command-from-action helm-ff-run-load-file + "Run Load file action from `helm-source-find-files'." + 'helm-find-files-load-files) + +(helm-make-command-from-action helm-ff-run-eshell-command-on-file + "Run eshell command on file action from `helm-source-find-files'." + 'helm-find-files-eshell-command-on-file) + +(helm-make-command-from-action helm-ff-run-ediff-file + "Run Ediff file action from `helm-source-find-files'." + 'helm-find-files-ediff-files) + +(helm-make-command-from-action helm-ff-run-ediff-merge-file + "Run Ediff merge file action from `helm-source-find-files'." + 'helm-find-files-ediff-merge-files) + +(helm-make-command-from-action helm-ff-run-symlink-file + "Run Symlink file action from `helm-source-find-files'." + 'helm-find-files-symlink) + +(helm-make-command-from-action helm-ff-run-relsymlink-file + "Run Symlink file action from `helm-source-find-files'." + 'helm-find-files-relsymlink) + +(helm-make-command-from-action helm-ff-run-hardlink-file + "Run Hardlink file action from `helm-source-find-files'." + 'helm-find-files-hardlink) + +(helm-make-command-from-action helm-ff-run-compress-to + "Run Compress to archive action from `helm-source-find-files'." + 'helm-find-files-compress-to) + +(helm-make-command-from-action helm-ff-run-chmod + "Run chmod action from `helm-source-find-files'." + 'helm-ff-chmod) + +(defun helm-ff-delete-files (candidate) + "Delete files default action." + (funcall helm-ff-delete-files-function candidate)) + +(helm-make-command-from-action helm-ff-run-delete-file + "Run Delete file action from `helm-source-find-files'." + 'helm-ff-delete-files) + +(helm-make-command-from-action helm-ff-run-complete-fn-at-point + "Run complete file name action from `helm-source-find-files'." + 'helm-insert-file-name-completion-at-point) + +(helm-make-command-from-action helm-ff-run-switch-to-shell + "Run switch to eshell action from `helm-source-find-files'." + 'helm-ff-switch-to-shell) + +(helm-make-command-from-action helm-ff-run-switch-other-window + "Run switch to other window action from `helm-source-find-files'. +When a prefix arg is provided, split is done vertically." + 'helm-find-files-other-window) + +(helm-make-command-from-action helm-ff-run-switch-other-frame + "Run switch to other frame action from `helm-source-find-files'." + 'find-file-other-frame) + +(helm-make-command-from-action helm-ff-run-open-file-externally + "Run open file externally command action from `helm-source-find-files'." + 'helm-open-file-externally) + +(helm-make-command-from-action helm-ff-run-open-file-with-default-tool + "Run open file externally command action from `helm-source-find-files'." + 'helm-open-file-with-default-tool) + +(defun helm-ff-locate (candidate) + "Locate action function for `helm-find-files'." + (helm-locate-set-command) + (let ((default (concat (helm-basename + (expand-file-name + candidate + helm-ff-default-directory)) + (unless (or + ;; "-b" is already added when fuzzy matching. + helm-locate-fuzzy-match + ;; The locate '-b' option doesn't exists + ;; in everything (es). + (and (eq system-type 'windows-nt) + (string-match "^es" helm-locate-command))) + " -b")))) + (helm-locate-1 helm-current-prefix-arg nil 'from-ff default))) + +(helm-make-command-from-action helm-ff-run-locate + "Run locate action from `helm-source-find-files'." + 'helm-ff-locate) + +(defun helm-files-insert-as-org-link (candidate) + (insert (format "[[%s][]]" candidate)) + (goto-char (- (point) 2))) + +(helm-make-command-from-action helm-ff-run-insert-org-link + "Run insert org link from HFF." + 'helm-files-insert-as-org-link) + +(helm-make-command-from-action helm-ff-run-find-file-as-root + "Run find file as root from HFF." + 'helm-find-file-as-root) + +(helm-make-command-from-action helm-ff-run-find-alternate-file + "Run `find-alternate-file' from HFF." + 'find-alternate-file) + +(helm-make-command-from-action helm-ff-run-mail-attach-files + "Run mail attach files command action from `helm-source-find-files'." + 'helm-ff-mail-attach-files) + +(helm-make-command-from-action helm-ff-run-etags + "Run Etags command action from `helm-source-find-files'." + 'helm-ff-etags-select) + +(defvar lpr-printer-switch) +(defun helm-ff-print (_candidate) + "Print marked files. + +You may to set in order variables `lpr-command',`lpr-switches' +and/or `printer-name', but with no settings Helm should detect +your printer(s) and print with the default `lpr' settings. + +NOTE: DO NOT set the \"-P\" flag in `lpr-switches'. If you really +have to modify this, do it in `lpr-printer-switch'. + +Same as `dired-do-print' but for Helm." + (require 'lpr) + (when (or helm-current-prefix-arg + (not helm-ff-printer-list)) + (setq helm-ff-printer-list + (helm-ff-find-printers))) + (let* ((file-list (helm-marked-candidates :with-wildcard t)) + (len (length file-list)) + (printer-name (if helm-ff-printer-list + (helm-comp-read + "Printer: " helm-ff-printer-list) + printer-name)) + (lpr-switches + (if (and (stringp printer-name) + (string< "" printer-name)) + (cons (concat lpr-printer-switch " " printer-name) + lpr-switches) + lpr-switches)) + (command (helm-read-string + (format "Print *%s File(s):\n%s with: " + len + (mapconcat + (lambda (f) (format "- %s\n" f)) + file-list "")) + (when (and lpr-command lpr-switches) + (mapconcat 'identity + (cons lpr-command + (if (stringp lpr-switches) + (list lpr-switches) + lpr-switches)) + " ")))) + (file-args (mapconcat #'shell-quote-argument + file-list " ")) + (cmd-line (concat command " " file-args))) + (if command + (start-process-shell-command "helm-print" nil cmd-line) + (error "Error: Please verify your printer settings in Emacs.")))) + +(helm-make-command-from-action helm-ff-run-print-file + "Run Print file action from `helm-source-find-files'." + 'helm-ff-print) + +(defun helm-ff-checksum (file) + "Calculate the checksum of FILE. +The checksum is copied to `kill-ring'. +Checksum is calculated with the md5sum, sha1sum, sha224sum, +sha256sum, sha384sum and sha512sum when available, otherwise the +Emacs function `secure-hash' is used but it is slow and may crash +Emacs and even the whole system as it eats all memory." + (cl-assert (file-regular-p file) + nil "`%s' is not a regular file" file) + (let* ((algo (intern (helm-comp-read + "Algorithm: " + '(md5 sha1 sha224 sha256 sha384 sha512)))) + (cmd (concat (symbol-name algo) "sum")) + (bn (helm-basename file)) + proc) + (message "Calculating %s checksum for %s..." algo bn) + (if (executable-find cmd) + (progn + (set-process-filter + (setq proc (start-file-process cmd nil cmd "-b" file)) + (lambda (_process output) + (when output (kill-new output)))) + (set-process-sentinel + proc + `(lambda (_process event) + (when (string= event "finished\n") + (message "Calculating %s checksum for `%s' done and copied to kill-ring" + ,(symbol-name algo) ,bn))))) + (async-let ((sum (with-temp-buffer + (insert-file-contents-literally file) + (secure-hash algo (current-buffer))))) + (kill-new sum) + (message "Calculating %s checksum for `%s' done and copied to kill-ring" + algo bn))))) + +(defun helm-ff-toggle-basename () + (with-helm-buffer + (setq helm-ff-transformer-show-only-basename + (not helm-ff-transformer-show-only-basename)) + (let* ((cand (helm-get-selection)) + (target (if helm-ff-transformer-show-only-basename + (helm-basename cand) cand))) + (helm-force-update + (format helm-ff-last-expanded-candidate-regexp + (regexp-quote target)))))) + +(defun helm-ff-run-toggle-basename () + (interactive) + (with-helm-alive-p + (unless (helm-empty-source-p) + (helm-ff-toggle-basename)))) +(put 'helm-ff-run-toggle-basename 'helm-only t) + +(defun helm-ff-mark-similar-files-1 () + "Mark similar files. +Files are considered similar if they have the same face and same +extension." + (with-helm-window + (let* ((src (helm-get-current-source)) + (file (helm-get-selection nil 'withprop src)) + (face (get-text-property (min 2 (length file)) 'face file)) + (ext (file-name-extension file))) + (helm-map-candidates-in-source src + (lambda (_cand) (helm-make-visible-mark)) + (lambda (cand) + (and (not (helm-this-visible-mark)) + (eq (get-text-property (min 2 (length cand)) 'face cand) face) + (equal ext (file-name-extension cand))))) + (helm-mark-current-line) + (helm-display-mode-line src t) + (when helm-marked-candidates + (message "%s candidates marked" (length helm-marked-candidates)) + (set-window-margins (selected-window) 1))))) + +(defun helm-ff-mark-similar-files () + "Mark all files similar to selection." + (interactive) + (with-helm-alive-p + (let ((marked (helm-marked-candidates))) + (if (and (>= (length marked) 1) + (with-helm-window helm-visible-mark-overlays)) + (helm-unmark-all) + (helm-ff-mark-similar-files-1))))) +(put 'helm-ff-mark-similar-files 'helm-only t) + +(defun helm-reduce-file-name-1 (fname level) + ;; This is the old version of helm-reduce-file-name, we still use it + ;; with ftp fnames as expand-file-name is not working as expected + ;; with ftp fnames (emacs bug). + (cl-loop with result + with iter = (helm-iter-reduce-fname (expand-file-name fname)) + repeat level do (setq result (helm-iter-next iter)) + finally return (or result (expand-file-name "/")))) + +(defun helm-reduce-file-name-2 (fname level) + ;; This version comes from Bug#2004 (UNC paths) and should fix + ;; it. It works with local files and remote files as well but not + ;; with ftp, see helm-reduce-file-name-1. + (while (> level 0) + (unless (or (string= fname "/") + (string= (file-remote-p fname 'localname) "/")) + (setq fname (expand-file-name + (concat (expand-file-name fname) "/../")))) + (setq level (1- level))) + fname) + +(defun helm-reduce-file-name (fname level) + "Reduce FNAME by number LEVEL from end." + (if (helm-aand (file-remote-p fname 'method) + (string= it "ftp")) + (helm-reduce-file-name-1 fname level) + (helm-reduce-file-name-2 fname level))) + +(defun helm-iter-reduce-fname (fname) + "Yield FNAME reduced by one level at each call." + (let ((split (split-string fname "/" t))) + (unless (or (null split) + (string-match "\\`\\(~\\|[[:alpha:]]:\\)" (car split))) + (setq split (cons "/" split))) + (lambda () + (when (and split (cdr split)) + (cl-loop for i in (setq split (butlast split)) + concat (if (string= i "/") i (concat i "/"))))))) + +(defvar helm-find-files--level-tree nil) +(defvar helm-find-files--level-tree-iterator nil) +(defun helm-find-files-up-one-level (arg) + "Go up one level like unix command `cd ..'. +If prefix numeric arg is given go ARG level up." + (interactive "p") + (with-helm-alive-p + (helm-ff-after-persistent-show-all) + (let ((src (helm-get-current-source))) + (when (and (helm-file-completion-source-p src) + (not (helm-ff--invalid-tramp-name-p))) + (with-helm-window + (when (helm-follow-mode-p) + (helm-follow-mode -1) (message nil))) + ;; When going up one level we want to be at the line + ;; corresponding to actual directory, so store this info + ;; in `helm-ff-last-expanded'. + (let ((cur-cand (helm-get-selection nil nil src)) + (new-pattern (helm-reduce-file-name helm-pattern arg))) + ;; Ensure visibility on all candidates for preselection. + (unless (helm-empty-source-p) + ;; We may have an empty source in read-file-name when a + ;; predicate is used e.g. images and the default is a non + ;; file image. + (helm-set-attr 'candidate-number-limit + (if helm-ff-dynamic-candidate-number-limit + (max (gethash new-pattern + helm-ff--directory-files-length + helm-ff-candidate-number-limit) + helm-ff-candidate-number-limit) + helm-ff-candidate-number-limit))) + (cond ((file-directory-p helm-pattern) + (setq helm-ff-last-expanded helm-ff-default-directory)) + ((file-exists-p helm-pattern) + (setq helm-ff-last-expanded helm-pattern)) + ((and cur-cand (file-exists-p cur-cand)) + (setq helm-ff-last-expanded cur-cand))) + (unless helm-find-files--level-tree + (setq helm-find-files--level-tree + (cons helm-ff-default-directory + helm-find-files--level-tree))) + (setq helm-find-files--level-tree-iterator nil) + (push new-pattern helm-find-files--level-tree) + (setq helm-ff--show-thumbnails + (member new-pattern helm-ff--thumbnailed-directories)) + (helm-set-pattern new-pattern helm-suspend-update-flag) + (with-helm-after-update-hook (helm-ff-retrieve-last-expanded))))))) +(put 'helm-find-files-up-one-level 'helm-only t) + +(defun helm-find-files-down-last-level () + "Retrieve previous paths reached by `C-l' in helm-find-files." + (interactive) + (with-helm-alive-p + (when (and (helm-file-completion-source-p) + (not (helm-ff--invalid-tramp-name-p))) + (unless helm-find-files--level-tree-iterator + (setq helm-find-files--level-tree-iterator + (helm-iter-list (cdr helm-find-files--level-tree)))) + (setq helm-find-files--level-tree nil) + (helm-aif (helm-iter-next helm-find-files--level-tree-iterator) + (progn + (setq helm-ff--show-thumbnails + (member it helm-ff--thumbnailed-directories)) + (helm-set-pattern it)) + (setq helm-find-files--level-tree-iterator nil))))) +(put 'helm-find-files-down-last-level 'helm-only t) + +(defun helm-find-files--reset-level-tree () + (setq helm-find-files--level-tree-iterator nil + helm-find-files--level-tree nil)) + +(add-hook 'helm-cleanup-hook 'helm-find-files--reset-level-tree) +(add-hook 'post-self-insert-hook 'helm-find-files--reset-level-tree) +(add-hook 'helm-after-persistent-action-hook 'helm-find-files--reset-level-tree) + +(defun helm-ff-retrieve-last-expanded () + "Move overlay to last visited directory `helm-ff-last-expanded'. +This happen after using `helm-find-files-up-one-level', or +hitting C-j on \"..\"." + (when helm-ff-last-expanded + (let ((presel (if helm-ff-transformer-show-only-basename + (helm-basename + (directory-file-name helm-ff-last-expanded)) + (directory-file-name helm-ff-last-expanded)))) + (with-helm-window + (when (re-search-forward + (format helm-ff-last-expanded-candidate-regexp + ;; The space at eol may contain a display property + ;; e.g. "-> symlink truename". + (concat (regexp-quote presel) " ?$")) + nil t) + (forward-line 0) + (helm-mark-current-line))) + (setq helm-ff-last-expanded nil)))) + +(defun helm-ff-undo () + "Undo minibuffer in `helm-find-files'. +Ensure disabling `helm-ff-auto-update-flag' before undoing." + (interactive) + (let ((old--flag helm-ff-auto-update-flag)) + (setq helm-ff-auto-update-flag nil) + (setq helm-ff--auto-update-state nil) + (unwind-protect + (progn + (undo) + (helm-check-minibuffer-input)) + (setq helm-ff-auto-update-flag old--flag) + (setq helm-ff--auto-update-state helm-ff-auto-update-flag)))) +(put 'helm-ff-undo 'helm-only t) + +;;; Auto-update - helm-find-files auto expansion of directories. +;; +;; +(defun helm-ff-update-when-only-one-matched () + "Expand to directory when sole completion. +When only one candidate is remaining and it is a directory, +expand to this directory. +This happen only when `helm-ff-auto-update-flag' is non-nil or +when `helm-pattern' is equal to \"~/\"." + (let ((src (helm-get-current-source))) + (when (and (helm-file-completion-source-p src) + (not (get-buffer-window helm-action-buffer 'visible)) + (not (helm-ff--invalid-tramp-name-p)) + (not (string-match-p "\\`[.]\\{2\\}[^/]+" + (helm-basename helm-pattern)))) + (with-helm-buffer + (let* ((history-p (string= (assoc-default 'name src) + "Read File Name History")) + (pat (helm-ff-set-pattern helm-pattern)) + ;; Try to shut up persistent tramp error with adb method when + ;; adding tilde to path. + (tramp-tolerate-tilde (equal (file-remote-p pat 'method) + tramp-adb-method)) + (completed-p (helm-aand (expand-file-name + (substitute-in-file-name pat)) + (string= (file-name-as-directory it) + helm-ff-default-directory))) + (candnum (helm-get-candidate-number)) + (lt2-p (and (<= candnum 2) + (>= (string-width (helm-basename helm-pattern)) 2))) + (cur-cand (helm-get-selection nil nil src)) + expand-to) + (when (and (or (and helm-ff-auto-update-flag + (null helm-ff--deleting-char-backward) + ;; Bug#295 + ;; File predicates are returning t + ;; with paths like //home/foo. + ;; So check it is not the case by regexp + ;; to allow user to do C-a / to start e.g + ;; entering a tramp method e.g /sudo::. + (not (string-match "\\`//" helm-pattern)) + (not (eq last-command 'helm-yank-text-at-point))) + ;; Fix Bug#542. + (string= helm-pattern "~/") + ;; Only one remaining directory, expand it. + (and (= candnum 1) + helm-ff--auto-update-state + (file-accessible-directory-p pat) + (null helm-ff--deleting-char-backward))) + (or + ;; Only one candidate remaining + ;; and at least 2 char in basename. + lt2-p + ;; Already completed. + completed-p) + (not history-p) ; Don't try to auto complete in history. + (stringp cur-cand) + (file-accessible-directory-p cur-cand)) + (if (and (not (helm-ff-dot-file-p cur-cand)) ; [1] + ;; Maybe we are here because completed-p is true + ;; but check this again to be sure. (Windows fix) + (<= candnum 2)) ; [2] + ;; If after going to next line the candidate + ;; is not one of "." or ".." [1] + ;; and only one candidate is remaining [2], + ;; assume candidate is a new directory to expand, and do it. + (progn + (setq expand-to (file-name-as-directory + (substring-no-properties cur-cand))) + (setq helm-ff--show-thumbnails + (member expand-to helm-ff--thumbnailed-directories)) + (helm-set-pattern expand-to) + ;; Reset flags to show all when changing dir. + (helm-ff-after-persistent-show-all)) + ;; The candidate is one of "." or ".." + ;; that mean we have entered the last letter of the directory name + ;; in prompt, so expansion is already done, just add the "/" at end + ;; of name unless helm-pattern ends with "." + ;; (i.e we are writing something starting with ".") + (unless (string-match "\\`.*[.]\\{1\\}\\'" helm-pattern) + ;; Need to expand-file-name to avoid e.g /ssh:host:./ in prompt. + (setq expand-to (expand-file-name (file-name-as-directory helm-pattern))) + (setq helm-ff--show-thumbnails + (member expand-to helm-ff--thumbnailed-directories)) + (helm-set-pattern expand-to))) + ;; When typing pattern in minibuffer, helm + ;; expand very fast to a directory matching pattern and + ;; don't let undo the time to set a boundary, the result + ;; is when e.g. going to root with "//" and undoing, undo + ;; doesn't undo to previous input. One fix for this is to + ;; advice `undo-auto--boundary-ensure-timer' so that it is + ;; possible to modify its delay (use a value of 1s for + ;; helm), a second fix is to run directly here `undo-boundary' + ;; inside a timer. + (run-at-time helm-input-idle-delay nil #'undo-boundary) + (helm-check-minibuffer-input))))))) + +(defun helm-ff-auto-expand-to-home-or-root () + "Allow expanding to $HOME or \"/\" or text yanked after minibuffer input." + (when (and (helm-file-completion-source-p) + (with-current-buffer (window-buffer (minibuffer-window)) (eolp)) + (not (string-match helm-ff-url-regexp helm-pattern))) + (cond ((and (not (file-remote-p helm-pattern)) + (null (file-exists-p helm-pattern)) + (string-match-p + "\\`\\([.]\\)\\{2\\}[^/]+" + (helm-basename helm-pattern)) + (string-match-p "/\\'" helm-pattern)) + (helm-ff-recursive-dirs helm-pattern) + (helm-ff--maybe-set-pattern-and-update)) + ((string-match + "\\(?:\\`~/\\)\\|/?\\$.*/\\|/\\./\\|/\\.\\./\\|/~.*/\\|//\\|\\(/[[:alpha:]]:/\\)" + helm-pattern) + (let* ((match (match-string 0 helm-pattern)) + (input (cond ((string= match "/./") + (expand-file-name default-directory)) + ((string= helm-pattern "/../") "/") + ((string-match-p "\\`/\\$" match) + (let ((sub (substitute-in-file-name match))) + (if (file-directory-p sub) + sub (replace-regexp-in-string "/\\'" "" sub)))) + (t (helm-ff--expand-substitued-pattern helm-pattern))))) + ;; `file-directory-p' returns t on "/home/me/." (Bug#1844). + (if (and (file-directory-p input) + (not (string-match-p "[^.]\\.\\'" input))) + (progn + (setq helm-ff-default-directory + (setq input (file-name-as-directory input))) + ;; When changing directory ensure to show all. + (helm-ff-after-persistent-show-all)) + (setq helm-ff-default-directory (file-name-as-directory + (file-name-directory input)))) + (helm-ff--maybe-set-pattern-and-update input))) + ((string-match "\\`/\\(-\\):.*" helm-pattern) + (helm-ff--maybe-set-pattern-and-update + (replace-match tramp-default-method t t helm-pattern 1)))))) + +(defun helm-ff--maybe-set-pattern-and-update (&optional str) + (with-helm-window + (when str (helm-set-pattern str)) + (helm-check-minibuffer-input))) + +(defun helm-ff--expand-file-name-no-dot (name &optional directory) + "Prevent expanding \"/home/user/.\" to \"/home/user\"." + ;; Bug#1844 - If user enter "~/." to type an hidden filename + ;; don't expand to /home/him e.g. + ;; (expand-file-name "~/.") =>"/home/thierry" + ;; (helm-ff--expand-substitued-pattern "~/.") =>"/home/thierry/." + (concat (expand-file-name name directory) + (and (string-match "[^.]\\.\\'" name) "/."))) + +(defun helm-ff--expand-substitued-pattern (pattern) + ;; [Windows] On UNC paths "/" expand to current machine, + ;; 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 Bug#2004. + (expand-fn (if directory + #'expand-file-name + #'helm-ff--expand-file-name-no-dot))) + ;; Fix Bug#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))) + +(defun helm-substitute-in-filename (fname) + "Substitute all parts of FNAME from start up to \"~/\" or \"/\". +On windows system substitute from start up to \"/[[:lower:]]:/\". +This function is needed for `helm-ff-auto-expand-to-home-or-root' +and should be used carefully elsewhere, or not at all, using +`substitute-in-file-name' instead." + (cond ((and helm--url-regexp + (string-match-p helm--url-regexp fname)) + fname) + ((and (file-remote-p fname) + helm-substitute-in-filename-stay-on-remote) + (let ((sub (substitute-in-file-name fname))) + (if (file-directory-p sub) + sub (replace-regexp-in-string "/\\'" "" sub)))) + (t + (with-temp-buffer + (insert fname) + (goto-char (point-min)) + (when (memq system-type '(windows-nt ms-dos)) + (skip-chars-forward "/")) ;; Avoid infloop in UNC paths Bug#424 + (if (re-search-forward "~.*/?\\|//\\|/[[:alpha:]]:/" nil t) + (let ((match (match-string 0))) + (goto-char (if (or (string= match "//") + (string-match-p "/[[:alpha:]]:/" match)) + (1+ (match-beginning 0)) + (match-beginning 0))) + (buffer-substring-no-properties (point) (pos-eol))) + fname))))) + +(defun helm-point-file-in-dired (file) + "Put point on filename FILE in dired buffer." + (unless (and helm--url-regexp + (string-match-p helm--url-regexp file)) + (let ((target (expand-file-name (helm-substitute-in-filename file)))) + (dired (file-name-directory target)) + (dired-goto-file target)))) + +(defun helm-marked-files-in-dired (_candidate) + "Open a dired buffer with only marked files. + +With a prefix arg toggle dired buffer to wdired mode. + +Note: This function works only in Emacs-29+ because Wdired doesn't support +editing absolute fnames in previous Emacs versions." + (let* ((marked (helm-marked-candidates :with-wildcard t)) + (current (car marked))) + (unless (and helm--url-regexp + (string-match-p helm--url-regexp current)) + (let ((target (expand-file-name (helm-substitute-in-filename current)))) + (dired (cons helm-ff-default-directory marked)) + (dired-goto-file target) + (when (or helm-current-prefix-arg current-prefix-arg) + (call-interactively 'wdired-change-to-wdired-mode)))))) + +(defun helm-ff-wfnames (_candidate) + "Edit marked fnames with `Wfnames' package." + (cl-assert (require 'wfnames nil t) nil "Wfnames package not found") + (let ((marked (helm-marked-candidates :with-wildcard t))) + (wfnames-setup-buffer + marked #'switch-to-buffer (buffer-live-p (get-buffer wfnames-buffer))))) + +(defun helm-ff-edit-marked-files (candidate) + "Edit marked files with `helm-ff-edit-marked-files-fn' fn." + (funcall helm-ff-edit-marked-files-fn candidate)) + +(helm-make-command-from-action helm-ff-run-edit-marked-files + "Execute `helm-ff-edit-marked-files' interactively." + 'helm-ff-edit-marked-files) + +(defun helm-ff--get-tramp-methods () + "Return a list of the car of `tramp-methods'." + (or helm-ff--tramp-methods + (setq helm-ff--tramp-methods (mapcar 'car tramp-methods)))) + +(defun helm-ff--previous-mh-tramp-method (str) + (save-match-data + (with-temp-buffer + (insert str) + (when (re-search-backward + (concat "\\([|]\\)\\(" + (mapconcat 'identity (helm-ff--get-tramp-methods) "\\|") + "\\):") + nil t) + (list + (buffer-substring-no-properties (pos-bol) (match-beginning 2)) + (buffer-substring-no-properties (match-beginning 2) (match-end 2))))))) + +(defun helm-ff--get-host-from-tramp-invalid-fname (fname) + "Extract hostname from an incomplete tramp file name. +Return nil on valid file name remote or not." + ;; Check first if whole file is remote (file-remote-p is inefficient + ;; in this case) otherwise we are matching e.g. /home/you/ssh:foo/ + ;; which is not a remote name. + ;; FIXME this will not work with a directory or a file named like + ;; "ssh:foo" and located at root (/) but it seems there is no real + ;; solution apart disabling tramp-mode when a file/dir located at / + ;; is matching helm-tramp-file-name-regexp; This would prevent usage + ;; of tramp if one have such a directory at / (who would want to + ;; have such a dir at / ???) See https://debbugs.gnu.org/31489. + (when (string-match-p helm-tramp-file-name-regexp fname) + (let* ((bn (helm-basename fname)) + (bd (replace-regexp-in-string (regexp-quote bn) "" fname)) + (split (split-string bn ":" t)) + (meth (car (member (car split) + (helm-ff--get-tramp-methods))))) + (and meth (string= bd "/") (car (last split)))))) + +(cl-defun helm-ff--tramp-hostnames (&optional (pattern helm-pattern)) + "Get a list of hosts for tramp method found in `helm-pattern'. +Argument PATTERN default to `helm-pattern'. It is here only for +debugging purpose." + (when (string-match helm-tramp-file-name-regexp pattern) + (let* ((mh-method (helm-ff--previous-mh-tramp-method pattern)) + (method (or (cadr mh-method) (match-string 1 pattern)))) + (cl-loop with all-methods = (helm-ff--get-tramp-methods) + for (f . h) in (tramp-get-completion-function method) + append (cl-loop for e in (funcall f (car h)) + for host = (and (consp e) (cadr e)) + ;; On emacs-27 host may be + ;; ("root" t) in sudo method. + when (and (stringp host) + (not (member host all-methods))) + collect (helm-ff-filter-candidate-one-by-one + (concat (or (car mh-method) "/") + method ":" host))) + into comps + finally return + (helm-fast-remove-dups comps :test 'equal))))) + +(defun helm-ff-before-action-hook-fn () + "Exit Helm when user try to execute action on an invalid tramp fname." + (let* ((src (helm-get-current-source)) + (cand (helm-get-selection nil nil src))) + (when (and (helm-file-completion-source-p src) + (stringp cand) + (helm-ff--invalid-tramp-name-p cand) ; Check candidate. + (helm-ff--invalid-tramp-name-p)) ; check helm-pattern. + (error "Error: Unknown file or directory `%s'" cand)))) +(add-hook 'helm-before-action-hook 'helm-ff-before-action-hook-fn) + +(cl-defun helm-ff--invalid-tramp-name-p (&optional (pattern helm-pattern)) + "Return non-nil when PATTERN is an invalid tramp filename." + (or (string= (helm-ff-set-pattern pattern) + "@@TRAMP@@") + ;; Tramp methods completion. + (string-match helm-ff-tramp-method-regexp pattern))) + +(defun helm-ff--tramp-multihops-p (name) + (cl-loop for m in (helm-ff--get-tramp-methods) + thereis (string-match (format "\\`\\(/%s:.*[|]\\).*" m) name))) + +(defun helm-ff-complete-tramp-methods () + "Completion on tramp methods in a nested helm session." + (interactive) + (with-helm-alive-p + (let* (initial-input + (str helm-pattern) + (pattern (with-temp-buffer + (insert str) + (let ((end (point)) beg) + (when (re-search-backward "[/|]" nil t) + (setq beg (1+ (point))) + (unless (= beg end) + (setq initial-input + (buffer-substring beg end)) + (delete-region beg end)) + (buffer-string))))) + (collection (helm-ff--get-tramp-methods)) + (method (helm-comp-read + "Tramp methods: " + (sort collection #'string<) + :initial-input initial-input + :fc-transformer + (lambda (candidates _source) + (cl-loop for c in candidates + collect (propertize c 'face 'helm-ff-file))) + :allow-nest t + :must-match t))) + (helm-set-pattern (concat pattern method ":"))))) +(put 'helm-ff-complete-tramp-methods 'no-helm-mx t) + +(defun helm-ff-set-pattern (pattern) + "Handle tramp filenames in `helm-pattern'." + (let* ((methods (helm-ff--get-tramp-methods)) + ;; Returns the position of last ":" entered. + (postfixed (file-remote-p pattern)) + (reg "\\`/\\([^[/:]+\\|[^/]+]\\):.*:") + cur-method tramp-name) + (when (string-match "\\`/\\(-\\):" pattern) + (setq pattern (replace-match tramp-default-method t t pattern 1))) + ;; In some rare cases tramp can return a nil input, + ;; so be sure pattern is a string for safety (Bug#476). + (unless pattern (setq pattern "")) + (cond ((string-match helm-ff-url-regexp pattern) pattern) + ((string-match "\\`\\$" pattern) + (substitute-in-file-name pattern)) + ((string= pattern "") "") + ((string-match "\\`[.]\\{1,2\\}/\\'" pattern) + (expand-file-name pattern)) + ;; Directories ending by a dot (Bug#1940) + ((string-match "[^/][.]/\\'" pattern) + (expand-file-name pattern)) + ((string-match ".*\\(~?/?[.]\\{1\\}/\\)\\'" pattern) + (expand-file-name default-directory)) + ((string-match ".*\\(~//\\|//\\)\\'" pattern) + (expand-file-name "/")) ; Expand to "/" or "c:/" + ((string-match "\\`\\(~/\\|.*/~/\\)\\'" pattern) + (expand-file-name "~/")) + ((string-match "\\`~/" pattern) + (expand-file-name pattern)) + ((string-match helm-ff-tramp-method-regexp pattern) + pattern) + ;; Match "/method:maybe_hostname:~" + ((and (string-match (concat reg "~") pattern) + postfixed + (setq cur-method (match-string 1 pattern)) + (member cur-method methods)) + (setq tramp-name (expand-file-name + (file-remote-p + (match-string 0 pattern)))) + (replace-match tramp-name nil t pattern)) + ;; Match "/method:maybe_hostname:" + ((and (string-match reg pattern) + postfixed + (setq cur-method (match-string 1 pattern)) + (member cur-method methods)) + (setq tramp-name (file-remote-p + (match-string 0 pattern))) + (replace-match tramp-name nil t pattern)) + ;; Match "/hostname:" + ((and (string-match helm-tramp-file-name-regexp pattern) + postfixed + (setq cur-method (match-string 1 pattern)) + (and cur-method (not (member cur-method methods)))) + (setq tramp-name (file-remote-p + (match-string 0 pattern))) + (replace-match tramp-name nil t pattern)) + ;; Match "/method:" in this case don't try to connect. + ((and (null postfixed) + (string-match helm-tramp-file-name-regexp pattern) + (member (match-string 1 pattern) methods)) + ;; A flag to notify tramp name is incomplete. + "@@TRAMP@@") + ;; Return PATTERN unchanged. + (t pattern)))) + +(defun helm-find-files-get-candidates () + "Create candidate list for `helm-source-find-files'." + (let* ((path (helm-ff-set-pattern helm-pattern)) + (dir-p (file-accessible-directory-p path)) + basedir + invalid-basedir + non-essential + (tramp-verbose helm-tramp-verbose)) ; No tramp message when 0. + ;; Tramp check if path is valid without waiting a valid + ;; connection and may send a file-error. + (setq helm--ignore-errors (file-remote-p path)) + (set-text-properties 0 (length path) nil path) + ;; Bug#118 allow creation of newdir+newfile. + (unless (or + ;; A tramp file name not completed. + (string= path "@@TRAMP@@") + ;; An empty pattern + (string= path "") + (file-remote-p path) + ;; Check if base directory of PATH is valid. + (helm-aif (file-name-directory path) + ;; If PATH is a valid directory IT=PATH, + ;; else IT=basedir of PATH. + (file-directory-p it))) + ;; BASEDIR is invalid, that's mean user is starting + ;; to write a non--existing path in minibuffer + ;; probably to create a 'new_dir' or a 'new_dir+new_file'. + (setq invalid-basedir t)) + ;; Don't set now `helm-pattern' if `path' == "@@TRAMP@@" + ;; like that the actual value (e.g /ssh:) is passed to + ;; `helm-ff--tramp-hostnames'. + (unless (or (string= path "@@TRAMP@@") + invalid-basedir) ; Leave helm-pattern unchanged. + (setq helm-ff-auto-update-flag ; [1] + ;; Unless auto update is disabled start auto updating only + ;; at third char. + (unless (or (null helm-ff--auto-update-state) + ;; But don't enable auto update when + ;; deleting backward. + helm-ff--deleting-char-backward + (and dir-p (not (string-match-p "/\\'" path)))) + (or (>= (length (helm-basename path)) 3) dir-p))) + ;; At this point the tramp connection is triggered. + (helm-log + "helm-find-files-get-candidates" + "Pattern=%S" + (setq helm-pattern (if (string-match helm-ff-tramp-method-regexp path) + ;; A tramp method, don't modify pattern. + helm-pattern + (helm-ff--transform-pattern-for-completion path)))) + ;; This have to be set after [1] to allow deleting char backward. + (setq basedir (or (helm-aand + (if (and dir-p helm-ff-auto-update-flag) + ;; Add the final "/" to path + ;; when `helm-ff-auto-update-flag' is enabled. + (file-name-as-directory path) + (if (string= path "") + "/" (file-name-directory path))) + (expand-file-name it)) + default-directory)) + (setq helm-ff-default-directory + (if (string= helm-pattern "") + (expand-file-name "/") ; Expand to "/" or "c:/" + ;; If path is an url *default-directory have to be nil. + (unless (or (string-match helm-ff-url-regexp path) + (and helm--url-regexp + (string-match helm--url-regexp path))) + basedir)))) + (when (and (string-match ":\\'" path) + (file-remote-p basedir nil t)) + (setq helm-pattern basedir)) + (cond (invalid-basedir nil) + ((string-match helm-ff-tramp-method-regexp path) ; Tramp methods + (mapcar (lambda (method) + (helm-ff-filter-candidate-one-by-one + (concat "/" ":" method))) + (helm-ff--get-tramp-methods))) + ((string= path "@@TRAMP@@") + (helm-ff--tramp-hostnames)) ; Hostnames completion. + ((or (and (file-regular-p path) + (eq last-repeatable-command 'helm-execute-persistent-action)) + ;; `ffap-url-regexp' don't match until url is complete. + (string-match helm-ff-url-regexp path) + (and helm--url-regexp (string-match helm--url-regexp path))) + ;; Do NOT filter boring files here (Bug#2330). + (list (helm-ff-filter-candidate-one-by-one path nil t))) + ((string= path "") (helm-ff-directory-files "/")) + ;; Check here if directory is accessible (not working on Windows). + ((and (file-directory-p path) (not (file-readable-p path))) + ;; Prefix error message with @@@@ for safety + ;; (some files may match file-error See bug#2400) + (list (cons (format "@@@@file-error: Opening directory permission denied `%s'" path) + path))) + ;; A fast expansion of PATH is made only if `helm-ff-auto-update-flag' + ;; is enabled. + ((and dir-p helm-ff-auto-update-flag) + (helm-ff-directory-files path)) + (t (helm-ff-directory-files basedir))))) + +(defun helm-list-directory (directory &optional sel) + "List directory DIRECTORY. + +If DIRECTORY is remote use `helm-list-remote-directory-fn', +otherwise use `directory-files'. +SEL argument is only here for debugging purpose, it default to +`helm-get-selection'." + (let* ((remote (file-remote-p directory 'method)) + (helm-list-remote-directory-fn + (helm-acase remote + ("ftp" #'helm-list-dir-lisp) + ("adb" #'helm-list-dir-adb) + (t helm-list-remote-directory-fn))) + (use-ext-remote-fn + (and remote + (eq helm-list-remote-directory-fn 'helm-list-dir-external))) + (sort-method (helm-acase helm-ff-initial-sort-method + (newest (if use-ext-remote-fn + "-t" #'file-newer-than-file-p)) + (size (if use-ext-remote-fn + "-S" #'helm-ff-file-larger-that-file-p)) + (ext (if use-ext-remote-fn + #'identity + #'helm-group-candidates-by))))) + (if remote + (ignore-errors + (funcall helm-list-remote-directory-fn directory sort-method)) + (helm-acase helm-ff-initial-sort-method + ((newest size) + (sort (helm-local-directory-files + directory t directory-files-no-dot-files-regexp) + sort-method)) + (ext (funcall sort-method + (helm-local-directory-files + directory t directory-files-no-dot-files-regexp) + #'file-name-extension + (or sel (helm-get-selection) ""))) + (t (helm-local-directory-files + directory t directory-files-no-dot-files-regexp)))))) + +(defsubst helm-ff-file-larger-that-file-p (f1 f2) + (let ((attr1 (file-attributes f1)) + (attr2 (file-attributes f2))) + (> (nth 7 attr1) (nth 7 attr2)))) + +(defun helm-list-dir-lisp (directory &optional sort-method) + "List DIRECTORY with `file-name-all-completions' as backend. + +Add a `helm-ff-dir' property on each fname ending with \"/\"." + ;; NOTE: `file-name-all-completions' and `directory-files' and most + ;; tramp file handlers don't handle cntrl characters in fnames, so + ;; the displayed files will be plain wrong in this case, even worst + ;; the filenames will be splitted in two or more filenames. + (cl-loop for f in (sort (file-name-all-completions "" directory) + (or sort-method 'string-lessp)) + unless (or (string= f "") + (member f '("./" "../" "." ".."))) + if (and (helm--dir-name-p f) + (helm--dir-file-name f directory)) + collect (propertize it 'helm-ff-dir t) + else collect (propertize (expand-file-name f directory) + 'helm-ff-file t))) + +(defun helm-file-name-all-completions-internal (directory) + (let ((switches "-1F")) + (with-temp-buffer + (insert-directory (format "%s*" + (file-name-as-directory directory)) + switches t) + (split-string + (buffer-substring-no-properties (point-min) (point-max)) + "\n" t)))) + +(defun helm-list-dir-adb (directory &optional sort-method) + "List DIRECTORY with `helm-file-name-all-completions-internal' as backend. + +This is used for tramp adb backend. + +Add a `helm-ff-dir' property on each fname ending with \"/\"." + (let ((inhibit-message t)) + (cl-loop with files = (helm-file-name-all-completions-internal directory) + for f in (sort files (or sort-method 'string-lessp)) + for split = (split-string f "->" t) + ;; For some reasons adb (or tramp) add a "*" at end of fnames, but + ;; the real name is without the ending "*". + for fname = (helm-aand (replace-regexp-in-string " $" "" (car split)) + (replace-regexp-in-string "\\*\\'" "" it)) + for truename = (cadr split) + collect (cond ((string-match "/\\'" fname) + (propertize (helm--dir-file-name fname directory) + 'helm-ff-dir t)) + (truename + (propertize (expand-file-name + (substring fname 0 (1- (length fname))) + directory) + 'helm-ff-sym truename)) + (t (propertize (expand-file-name fname directory) + 'helm-ff-file t)))))) + +(defun helm-list-dir-external (dir &optional sort-method) + "List directory DIR with external shell command as backend. + +This function is fast enough to be used for remote files and save +the type of files at the same time in a property for using it +later in the transformer." + (let ((default-directory (file-name-as-directory + (expand-file-name dir)))) + (with-temp-buffer + (when (eq (process-file-shell-command + (format + ;; -A remove dot files, -F append [*=@|/>] at eof + ;; and -Q quote the real filename. If not using -Q, + ;; there is no way to distinguish if foo* is a real + ;; file or if it is foo the executable file so with + ;; -Q we have "foo"* for the executable file foo and + ;; "foo*" for the real file foo. The downside is + ;; that we need an extra step to remove the quotes + ;; at the end which impact performances. + "ls -A -1 -F -b -Q %s | awk -v dir=%s '{print dir $0}'" + (or sort-method "") + (shell-quote-argument default-directory)) + nil t nil) + 0) + (goto-char (point-min)) + (save-excursion + (while (re-search-forward "[*=@|/>]$" nil t) + ;; A line looks like /home/you/"foo"@ + (helm-acase (match-string 0) + ("*" (replace-match "") + (put-text-property + (pos-bol) (pos-eol) 'helm-ff-exe t)) + ("@" (replace-match "") + (put-text-property + (pos-bol) (pos-eol) 'helm-ff-sym t)) + ("/" (replace-match "") + (put-text-property + (pos-bol) (pos-eol) 'helm-ff-dir t)) + (("=" "|" ">") (replace-match ""))))) + (while (re-search-forward "[\"]" nil t) + (replace-match "")) + (add-text-properties (point-min) (point-max) '(helm-ff-file t)) + (split-string (buffer-string) "\n" t))))) + +;; This is to fix issue with file-notify.el no more following symlinks +;; on emacs-29 (regression) with inotify backend at least. Also it +;; seems inotify is not configured to follow symlinks on other systems +;; (MacOS) so this should fix as well this issue on such systems see +;; bug#2542. +;; Store here associations of (truename . symlink) when opening a +;; symlinked directory, then add the watch to the truename; When the +;; watcher ring on the truename remove the symlinked directory from cache. +(defvar helm-ff--list-directory-links nil) + +(defun helm-ff-directory-files (directory &optional force-update) + "List contents of DIRECTORY. +Argument FULL mean absolute path. +It is same as `directory-files' but always returns the dotted +filename \\='.' and \\='..' even on root directories in Windows +systems. +When FORCE-UPDATE is non nil recompute candidates even if DIRECTORY is +in cache." + (let* ((method (file-remote-p directory 'method)) + (dfn (directory-file-name directory)) + (truename (and (file-symlink-p dfn) (file-truename dfn)))) + (setq directory (file-name-as-directory + (expand-file-name directory))) + (when truename + (cl-pushnew (cons truename directory) + helm-ff--list-directory-links :test 'equal)) + (or (and (not force-update) + (not (member method helm-ff-inotify-unsupported-methods)) + (gethash directory helm-ff--list-directory-cache)) + (let* (file-error + (ls (condition-case err + (helm-list-directory directory) + ;; Handle file-error from here for Windows + ;; because predicates like `file-readable-p' and friends + ;; seem broken on emacs for Windows systems (always returns t). + ;; This should never be called on GNU/Linux/Unix + ;; as the error is properly intercepted in + ;; `helm-find-files-get-candidates' by `file-readable-p'. + (file-error + (prog1 + ;; Prefix error message with @@@@ for safety + ;; (some files may match file-error See bug#2400) + (list (format "@@@@%s:%s" + (car err) + (mapconcat 'identity (cdr err) " "))) + (setq file-error t))))) + (dot (concat directory ".")) + (dot2 (concat directory "..")) + (candidates (append (and (not file-error) (list dot dot2)) ls)) + watcher) + (puthash directory (+ (length ls) 2) helm-ff--directory-files-length) + (prog1 + (puthash directory + (cl-loop for f in candidates + when (helm-ff-filter-candidate-one-by-one f) + collect it) + helm-ff--list-directory-cache) + ;; Put an inotify watcher to check directory modifications. + (unless (or (null helm-ff-use-notify) + (member method helm-ff-inotify-unsupported-methods) + (helm-aand (setq watcher (gethash + directory + helm-ff--file-notify-watchers)) + ;; [1] If watcher is invalid enter + ;; next and delete it. + (file-notify-valid-p it))) + (condition-case-unless-debug err + (let ((to-watch (or truename directory))) + (when watcher + ;; If watcher is still in cache and we are here, + ;; that's mean test [1] above fails and watcher + ;; is invalid, so delete it. + (file-notify-rm-watch watcher) + (remhash directory helm-ff--file-notify-watchers)) + ;; Keep adding DIRECTORY to + ;; helm-ff--file-notify-watchers but watch on the + ;; truename and not the symlink as before bug#2542. + (puthash directory + (file-notify-add-watch + to-watch + '(change attribute-change) + (helm-ff--inotify-make-callback to-watch)) + helm-ff--file-notify-watchers)) + (file-notify-error (user-error "Error: %S %S" (car err) (cdr err)))))))))) + +(defun helm-ff--inotify-make-callback (directory) + "Return a callback for `file-notify-add-watch'." + (lambda (event) + (let ((desc (cadr event)) + (target directory)) ; Either truename or directory. + (helm-log "Inotify callback" "Event %S called on %S" event directory) + ;; `attribute-changed' means permissions have changed, not + ;; file modifications like file changes, visit + ;; etc... AFAIU the desc for this is `changed' and for our + ;; use case we don't care of this. Elemnts of + ;; `helm-ff--list-directory-links' are of the form + ;; (truename . visited-symlink-directory) + (when (memq desc '(created deleted renamed attribute-changed)) + ;; Watched directory is the truename which is not in the + ;; cache, so remove its associated directory (the symlink) + ;; from the cache bug#2542. + (helm-aif (assoc directory helm-ff--list-directory-links) + (progn + (setq target (cdr it)) + (setq helm-ff--list-directory-links + (delete it helm-ff--list-directory-links)))) + ;; When TARGET is modified remove it from cache. + (helm-log "Inotify callback" + "Removing %S from `helm-ff--list-directory-cache'" target) + (remhash target helm-ff--list-directory-cache))))) + +(defun helm-ff-tramp-cleanup-hook (vec) + "Remove remote directories related to VEC in helm-ff* caches. +Remove as well all related file-notify watchers. + +This is meant to run in `tramp-cleanup-connection-hook'." + (cl-loop for key being the hash-keys in helm-ff--list-directory-cache + when (equal (file-remote-p key 'method) (cadr vec)) + do (remhash key helm-ff--list-directory-cache)) + (cl-loop for key being the hash-keys in helm-ff--file-notify-watchers + when (equal (file-remote-p key 'method) (cadr vec)) + do (progn + (file-notify-rm-watch + (gethash key helm-ff--file-notify-watchers)) + (remhash key helm-ff--file-notify-watchers)))) +(add-hook 'tramp-cleanup-connection-hook #'helm-ff-tramp-cleanup-hook) + +(defun helm-ff-handle-backslash (fname) + ;; Allow creation of filenames containing a backslash. + (cl-loop with bad = '((92 . "")) + for i across fname + if (assq i bad) concat (cdr it) + else concat (string i))) + +;; Keep it like this i.e. a function for evaluation in source definition. +(defun helm-ff--fuzzy-matching-p () + helm-ff-fuzzy-matching) + +(defun helm-ff--transform-pattern-for-completion (pattern) + "Maybe return PATTERN with it's basename modified as a regexp. +This happens only when `helm-ff-fuzzy-matching' is enabled. +This provides a similar behavior as `ido-enable-flex-matching'. +See also `helm--mapconcat-pattern'. +If PATTERN is an url return it unmodified. +When PATTERN contains a space fallback to multi-match. +If basename contains one or more space fallback to multi-match. +If PATTERN is a valid directory name, return PATTERN unchanged." + ;; handle bad filenames containing a backslash (no more needed in + ;; emacs-26, also prevent regexp matching with e.g. "\|"). + ;; (setq pattern (helm-ff-handle-backslash pattern)) + (let ((bn (helm-basename pattern)) + (bd (or (helm-basedir pattern) "")) + ;; Trigger tramp connection with file-directory-p. + (dir-p (file-directory-p pattern)) + (tramp-p (cl-loop for (m . f) in tramp-methods + thereis (string-match m pattern)))) + ;; Always regexp-quote base directory name to handle + ;; crap dirnames such e.g bookmark+ + (cond + ((or (and dir-p tramp-p (string-match ":\\'" pattern)) + (string= pattern "") + (and dir-p (<= (length bn) 2)) + ;; Fix Bug#541 when BD have a subdir similar + ;; to BN, don't switch to match plugin + ;; which will match both. + (and dir-p (string-match (regexp-quote bn) bd))) + ;; Use full PATTERN on e.g "/ssh:host:". + (regexp-quote pattern)) + ;; Prefixing BN with a space call multi-match completion. + ;; This allow showing all files/dirs matching BN (Bug#518). + ;; FIXME: some multi-match methods may not work here. + (dir-p (concat (regexp-quote bd) " " (regexp-quote bn))) + ((or (not (helm-ff--fuzzy-matching-p)) + (string-match "[ !]" bn)) ; Fall back to multi-match. + (concat (regexp-quote bd) " " bn)) + ((or (string-match "[*][.]?.*" bn) ; Allow entering wildcard. + (string-match "/\\'" pattern) ; Allow mkdir. + (string-match helm-ff-url-regexp pattern) + (and (string= helm-ff-default-directory "/") tramp-p)) + ;; Don't treat wildcards ("*") as regexp char. + ;; (e.g ./foo/*.el => ./foo/\\*\\.el) or ./foo/*.[ch] => + ;; ./foo/\\*\\.\\[ch] + (concat (regexp-quote bd) + ;; We were previously using + ;; (replace-regexp-in-string "[*]" "[*]" bn) but this + ;; doesn't handle wilcards like *.[ch], so regexp-quote + ;; bn as well. + (regexp-quote bn))) + (t (concat (regexp-quote bd) + ;; wait 2nd char before transforming to fuzzy. + (if (>= (length bn) 2) + (helm--mapconcat-pattern bn) + ;; Here BN length is 1, we were previously matching + ;; everything before BN i.e. (concat ".*" (regexp-quote bn)) + ;; but it is too slow on large directories. We could use + ;; previous clause for this but keep it here for clarity. + (regexp-quote bn))))))) + +(defalias 'helm-dir-is-dot 'helm-ff-dot-file-p) +(make-obsolete 'helm-dir-is-dot 'helm-ff-dot-file-p "3.8.8") + +(defun helm-ff-save-history () + "Store the last value of `helm-ff-default-directory' in `helm-ff-history'. +Note that only existing directories are saved here." + (when (and helm-ff-default-directory + (helm-file-completion-source-p) + (file-directory-p helm-ff-default-directory)) + (set-text-properties 0 (length helm-ff-default-directory) + nil helm-ff-default-directory) + (push helm-ff-default-directory helm-ff-history))) +(add-hook 'helm-cleanup-hook 'helm-ff-save-history) + +(defun helm-ff-valid-symlink-p (file &optional link) + "Returns the truename of FILE if it exists. +If we already know the truename of FILE we can pass it with LINK arg +to avoid an unnecessary call to `file-truename'." + (helm-aif (condition-case-unless-debug nil + ;; `file-truename' send error + ;; on cyclic symlinks (Bug#692). + (or link (file-truename file)) + (error nil)) + (and (file-exists-p it) it))) + +(defun helm-get-default-mode-for-file (filename) + "Return the default mode to open FILENAME." + (let ((mode (cl-loop for (r . m) in auto-mode-alist + thereis (and (string-match r filename) m)))) + (or (and (symbolp mode) mode) "Fundamental"))) + +(defun helm-ff-properties (candidate) + "Show file properties of CANDIDATE in a tooltip or message." + (require 'helm-external) ; For `helm-get-default-program-for-file'. + (helm-aif (helm-file-attributes candidate) + (let* ((dired-line (helm-file-attributes-dired-line it t t)) + (type (cl-getf it :type)) + (mode-type (cl-getf it :mode-type)) + (owner (cl-getf it :uid)) + (owner-right (cl-getf it :user t)) + (group (cl-getf it :gid)) + (group-right (cl-getf it :group)) + (other-right (cl-getf it :other)) + (octal (cl-getf it :octal)) + (trash (and (helm-ff-trash-file-p candidate) + (helm-ff--get-dest-file-from-trash + (helm-ff-trash-list) + (replace-regexp-in-string + "\\.trashinfo\\'" "" candidate)))) + (size (helm-file-human-size (cl-getf it :size))) + (modif (cl-getf it :modif-time)) + (access (cl-getf it :access-time)) + (ext (helm-get-default-program-for-file candidate)) + (tooltip-hide-delay (or helm-tooltip-hide-delay tooltip-hide-delay)) + (posn (with-helm-window + (posn-at-point (save-excursion (end-of-visual-line) (point))))) + (tooltip-frame-parameters (append tooltip-frame-parameters + `((left . ,(car (posn-x-y posn))) + (top . ,(cdr (posn-x-y posn))))))) + (if (and (display-graphic-p) tooltip-mode) + (tooltip-show + (concat + (helm-basename candidate) "\n" + dired-line "\n" + (format "Mode: %s\n" (helm-get-default-mode-for-file candidate)) + (format "Ext prog: %s\n" (or (and ext (replace-regexp-in-string + " %s" "" ext)) + "Not defined")) + (format "Type: %s: %s\n" type mode-type) + (when (string= type "symlink") + (format "True name: '%s'\n" + (cond ((string-match "^\\.#" (helm-basename candidate)) + "Autosave symlink") + ((helm-ff-valid-symlink-p candidate)) + (t "Invalid Symlink")))) + (format "Owner: %s: %s\n" owner owner-right) + (format "Group: %s: %s\n" group group-right) + (format "Others: %s\n" other-right) + (format "NumMode: %s\n" octal) + (format "Size: %s\n" size) + (when (string= type "directory") + (format "Size used in directory: %s\n" + (helm-directory-size + candidate current-prefix-arg t))) + (format "Modified: %s\n" modif) + (format "Accessed: %s\n" access) + (and (stringp trash) + (format "Trash: %s\n" + (abbreviate-file-name trash))))) + (message dired-line) (sit-for 5))) + (message "Permission denied, file not readable"))) + +(helm-make-persistent-command-from-action helm-ff-properties-persistent + "Show properties without quitting helm." + 'properties-action 'helm-ff-properties) + +(helm-make-persistent-command-from-action helm-ff-persistent-delete + "Delete current candidate without quitting." + 'quick-delete 'helm-ff-quick-delete) + +(defun helm-ff-kill-default-directory (_candidate) + (with-helm-window + (kill-new helm-ff-default-directory) + (message "`%s' copied to kill-ring" helm-ff-default-directory))) + +(helm-make-persistent-command-from-action helm-ff-run-kill-default-directory + "Kill `helm-ff-default-directory'." + 'kill-default-directory + 'helm-ff-kill-default-directory) + +(defun helm-ff-dot-file-p (file) + "Check if FILE is `.' or `..'." + (member (helm-basename file) '("." ".."))) + +(defun helm-ff-kill-buffer-fname (candidate) + (let* ((buf (get-file-buffer candidate)) + (buf-name (buffer-name buf))) + (cond ((and buf (eq buf (get-buffer helm-current-buffer))) + (user-error + "Can't kill `helm-current-buffer' without quitting session")) + (buf (kill-buffer buf) (message "Buffer `%s' killed" buf-name)) + (t (message "No buffer to kill"))))) + +(defun helm-ff-kill-or-find-buffer-fname (candidate) + "Find file CANDIDATE or kill its buffer if it is visible. +Never kill `helm-current-buffer'. +Never kill buffer modified. +This is called normally on third hit of \ +\\\\[helm-execute-persistent-action] +in `helm-find-files-persistent-action-if'." + (let* ((buf (get-file-buffer candidate)) + (buf-name (buffer-name buf)) + (win (get-buffer-window buf)) + (helm--reading-passwd-or-string t) + ;; Prevent tramp from asking yes-or-no-p for + ;; `tramp-allow-unsafe-temporary-files'. + auto-save-default) + (cond ((and buf win (eql buf (get-buffer helm-current-buffer))) + (user-error + "Can't kill `helm-current-buffer' without quitting session")) + ((and buf win (buffer-modified-p buf)) + (message "Can't kill modified buffer, please save it before")) + ((and buf win) + (kill-buffer buf) + (if (and helm-persistent-action-display-window + (window-dedicated-p (next-window win 1))) + (delete-window helm-persistent-action-display-window) + (set-window-buffer win helm-current-buffer)) + (message "Buffer `%s' killed" buf-name)) + (t (find-file candidate))))) + +(helm-make-persistent-command-from-action helm-ff-run-kill-buffer-persistent + "Execute `helm-ff-kill-buffer-fname' without quitting." + 'kill-buffer-fname 'helm-ff-kill-buffer-fname) + +;; Preview with external tool +(defun helm-ff-persistent-open-file-externally (file) + (require 'helm-external) + (if (helm-get-default-program-for-file file) + (helm-open-file-externally file) + (message "Please configure an external program for `*%s' file in `helm-external-programs-associations'" + (file-name-extension file t)))) + +(helm-make-persistent-command-from-action helm-ff-run-preview-file-externally + "Run open file externally without quitting helm." + 'open-file-externally 'helm-ff-persistent-open-file-externally) + +(defun helm-ff-prefix-filename (disp fname &optional new-file) + "Return DISP maybe prefixed with a string or an icon. + +Arg FNAME is the real filename whereas DISP is the display part of candidate. + +Icons are used when `helm-ff-icon-mode' is enabled. + +When NEW-FILE is non nil, returns a string prefixed with +[+] or [@] or a special icon, otherwise DISP is +returned prefixed with its icon or unchanged." + (let (prefix-new prefix-url) + (cond ((and new-file + (or (string-match helm-ff-url-regexp disp) + (and helm--url-regexp + (string-match helm--url-regexp disp)))) + (setq prefix-url + (if helm-ff-icon-mode + (helm-acase (match-string 1 disp) + ("mailto:" + (helm-x-icons-generic "mail")) + (t (helm-x-icons-generic "link-external"))) + (propertize + " " 'display + (propertize "[@]" 'face 'helm-ff-prefix)))) + (add-text-properties 0 1 '(helm-url t) prefix-url) + (concat prefix-url " " disp)) + (new-file + (setq prefix-new + (if helm-ff-icon-mode + (if (string-match "/\\'" disp) + (helm-x-icons-generic "create_new_folder") + (helm-x-icons-generic "note_add")) + (propertize + " " 'display + (propertize "[+]" 'face 'helm-ff-prefix)))) + (add-text-properties 0 1 '(helm-new-file t) prefix-new) + (concat prefix-new " " disp)) + (t (concat (helm-ff-get-icon disp fname) disp))))) + +(defun helm-ff-score-candidate-for-pattern (real disp pattern) + (cond ((member real '("." "..")) 900000) + ((and (string-match-p "\\`\\s-\\{2\\}" disp) + (string= real (substring-no-properties disp 2))) + ;; Incomplete filenames are prefixed with two spaces, the + ;; first one beeing propertized with a 'display prop + ;; i.e. "[+] foo". + 900001) + (t (helm-score-candidate-for-pattern real pattern)))) + +(defun helm-ff-sort-candidates-1 (candidates input) + "Sort function for `helm-source-find-files'. +Return candidates prefixed with basename of INPUT first." + (if (or (and (file-directory-p input) + (string-match "/\\'" input)) + (string-match "\\`\\$" input) + (null candidates)) + candidates + (let* ((memo-src (make-hash-table :test 'equal)) + (all (sort candidates + (lambda (s1 s2) + (let* ((score (lambda (disp real) + (helm-ff-score-candidate-for-pattern + disp real (helm-basename input)))) + ;; Reals + (r1 (helm-basename (if (consp s1) (cdr s1) s1))) + (r2 (helm-basename (if (consp s2) (cdr s2) s2))) + ;; Displays + (d1 (helm-basename (if (consp s1) (car s1) s1))) + (d2 (helm-basename (if (consp s2) (car s2) s2))) + (sc1 (or (gethash r1 memo-src) + (puthash r1 (funcall score r1 d1) memo-src))) + (sc2 (or (gethash r2 memo-src) + (puthash r2 (funcall score r2 d2) memo-src)))) + ;; The score fn may return a string (happens with "/adb:"). + (cond ((or (stringp sc1) (stringp sc2))) + ((= sc1 sc2) + (< (string-width r1) + (string-width r2))) + ((> sc1 sc2)))))))) + all))) + +(defun helm-ff-sort-candidates (candidates _source) + "Sort function for `helm-source-find-files'. +Return candidates prefixed with basename of `helm-input' first." + (helm-ff-sort-candidates-1 candidates helm-input)) + +(defun helm-ff-boring-file-p (file) + "Returns non nil when FILE is matching boring regexps." + ;; Prevent user doing silly thing like + ;; adding the dotted files to boring regexps (#924). + (and helm-ff-skip-boring-files + (not (string-match "\\.$" file)) + (string-match helm-ff--boring-regexp file))) + +(defvar helm-ff--git-found-p nil) +(defun helm-ff-git-ignored-p (file) + "Returns non nil when FILE is matched in \".gitignore\" file." + (and helm-ff-skip-git-ignored-files + (not (file-remote-p file)) + (or helm-ff--git-found-p + (setq helm-ff--git-found-p (executable-find "git"))) + (zerop (call-process "git" nil nil nil "check-ignore" "-q" file)))) + +(defun helm-ff-fct (candidates _source) + "Filter in charge of displaying basename or full path in HFF. +Because CANDIDATES are directly stored as (basename . full_path), when +`helm-ff-transformer-show-only-basename' is non nil do nothing and +return directly CANDIDATES." + (if (null helm-ff-transformer-show-only-basename) + (cl-loop for (_disp . real) in candidates + for fc = (helm-ff-filter-candidate-one-by-one real 'reverse) + when fc collect fc) + candidates)) + +(defun helm-ff-filter-candidate-one-by-one (file &optional reverse skip-boring-check) + "Transform file in a cons cell like (DISPLAY . REAL). +DISPLAY is shown as basename of FILE and REAL as full path of FILE. +If REVERSE is non nil DISPLAY is shown as full path. +If SKIP-BORING-CHECK is non nil don't filter boring files." + (let* ((basename (helm-basename file)) + (dot (helm-ff-dot-file-p file)) + (urlp (string-match-p helm-ff-url-regexp file)) + (tramp-invalid-fname (helm-ff--get-host-from-tramp-invalid-fname file)) + (disp (or tramp-invalid-fname + ;; Filename with cntrl chars e.g. foo^J + (replace-regexp-in-string + "[[:cntrl:]]" "?" + (if (or reverse urlp (and dot helm-ff-show-dot-file-path)) + file basename)))) + (len (length disp)) + (backup (backup-file-name-p disp))) + (when (string-match "/\\'" file) + (setq disp (concat disp "/") + len (1+ len))) + ;; We want to filter boring files only on the files coming + ;; from the output of helm-ff-directory-files not on single + ;; candidate (Bug#2330). + (unless (and (not skip-boring-check) + (or (helm-ff-boring-file-p basename) + (helm-ff-git-ignored-p file))) + ;; Highlight extensions. + (helm-aif (and (not backup) + (not urlp) + (helm-file-name-extension disp)) + (when (condition-case _err + (string-match (format "\\.\\(%s\\)\\'" it) disp) + (invalid-regexp nil)) + (add-face-text-property + (match-beginning 1) (match-end 1) + 'helm-ff-file-extension t disp))) + ;; Handle tramp files with minimal highlighting. + (if (and (or (string-match-p helm-tramp-file-name-regexp helm-pattern) + (helm-file-on-mounted-network-p helm-pattern))) + (helm-acond (;; Dot directories . and .. + dot + (cons (helm-ff-prefix-filename + (propertize disp 'face 'helm-ff-dotted-directory) + file) + file)) + ;; Directories. + ((get-text-property 1 'helm-ff-dir file) + (cons (helm-ff-prefix-filename + (propertize disp 'face 'helm-ff-directory) + file) + file)) + ;; Backup files. + (backup + (cons (helm-ff-prefix-filename + (propertize disp 'face 'helm-ff-backup-file) + file) + file)) + ;; Executable files. + ((get-text-property 1 'helm-ff-exe file) + (add-face-text-property 0 len 'helm-ff-executable t disp) + (cons (helm-ff-prefix-filename disp file) file)) + ;; Symlinks. + ((get-text-property 1 'helm-ff-sym file) + (add-face-text-property 0 len 'helm-ff-symlink t disp) + (if (stringp it) ; adb method. + (progn + (add-face-text-property 0 (length it) 'helm-ff-truename nil it) + (cons (propertize disp 'display (concat disp " ->" it)) file)) + (cons (helm-ff-prefix-filename disp file) file))) + ;; Regular files. + ((get-text-property 1 'helm-ff-file file) + (add-face-text-property 0 len 'helm-ff-file t disp) + (cons (helm-ff-prefix-filename disp file) file)) + ;; Tramp methods. + ((string-match helm-ff-tramp-method-regexp file) + (let ((method (match-string 1 file)) + (mh (helm-ff--tramp-multihops-p helm-pattern))) + (cons (propertize (concat (if mh "" "/") method) 'face 'helm-ff-file) + (if mh + (concat (match-string 1 helm-pattern) ":" method) + (concat "/:" method))))) + ;; non existing files. + (t + (add-face-text-property 0 len 'helm-ff-file t disp) + (when tramp-invalid-fname + (add-text-properties 0 len `(host ,tramp-invalid-fname) disp)) + (cons (helm-ff-prefix-filename + disp + file + (unless tramp-invalid-fname 'new-file)) + file))) + + ;; Highlight local files showing everything, symlinks, exe, + ;; dirs etc... + (let* ((attr (condition-case err + (file-attributes file) + (file-error + ;; Possible error not happening during listing + ;; but when calling file-attributes see error + ;; with sshfs bug#2405 + (message "%s:%s" (car err) (cdr err)) nil))) + (type (car attr)) + x-bit) + (cond (;; Not a file but the message error printed in + ;; helm-buffer. Such a message should not have a + ;; subdir so matching on bol should suffice, but to + ;; be sure use @@@@ as prefix in file-error message + ;; to be safe bug#2400. + (string-match "\\`@@@@file-error:" file) file) + (;; A dead symlink. + (and (stringp type) + (not (helm-ff-valid-symlink-p file)) + (not (string-match "^\\.#" basename))) + (add-face-text-property 0 len 'helm-ff-invalid-symlink t disp) + (cons (helm-ff-prefix-filename disp file) file)) + ;; A dotted directory symlinked. + ((and dot (stringp type)) + (cons (helm-ff-prefix-filename + (propertize disp 'face 'helm-ff-dotted-symlink-directory) + file) + file)) + ;; A dotted directory. + (dot + (cons (helm-ff-prefix-filename + (propertize disp 'face 'helm-ff-dotted-directory) + file) + file)) + ;; Backup files. + (backup + (cons (helm-ff-prefix-filename + (propertize disp 'face 'helm-ff-backup-file) + file) + file)) + ;; A symlink. + ((stringp type) + (let* ((abbrev (abbreviate-file-name type)) + (len-abbrev (length abbrev))) + (helm-aif (helm-file-name-extension abbrev) + (when (string-match (format "\\.\\(%s\\)\\'" it) abbrev) + (add-face-text-property + (match-beginning 1) (match-end 1) + 'helm-ff-file-extension t abbrev))) + (add-face-text-property 0 len-abbrev 'helm-ff-truename t abbrev) + ;; Colorize extension only on truename. + (add-face-text-property 0 len 'helm-ff-symlink nil disp) + (cons (concat (helm-ff-prefix-filename disp file) + ;; Displaying this in a space with display prop + ;; allows retrieving the candidate with + ;; `helm-ff-retrieve-last-expanded'. If we put + ;; the display prop on the whole candidate + ;; `helm-fuzzy-highlight-matches' don't match + ;; properly. + (propertize " " 'display (concat " -> " abbrev))) + file))) + ;; A directory. + ((eq t type) + (cons (helm-ff-prefix-filename + (propertize disp 'face 'helm-ff-directory) + file) + file)) + ;; A character device file. + ((and attr (string-match + "\\`[cp]" (setq x-bit (substring (nth 8 attr) 0 4)))) + (add-face-text-property 0 len 'helm-ff-pipe t disp) + (cons (helm-ff-prefix-filename disp file) file)) + ;; A socket file. + ((and attr (string-match "\\`[s]" x-bit)) + (add-face-text-property 0 len 'helm-ff-socket t disp) + (cons (helm-ff-prefix-filename disp file) file)) + ;; An executable file. + ((and attr (string-match "x\\'" x-bit)) + (add-face-text-property 0 len 'helm-ff-executable t disp) + (cons (helm-ff-prefix-filename disp file) file)) + ;; An executable file with suid + ((and attr (string-match "s\\'" x-bit)) + (add-face-text-property 0 len 'helm-ff-suid t disp) + (cons (helm-ff-prefix-filename disp file) file)) + ;; A file. + ((and attr (null type)) + (add-face-text-property 0 len 'helm-ff-file t disp) + (cons (helm-ff-prefix-filename disp file) file)) + ;; A tramp method + ;; At this point no need to handle multi hops syntax + ;; which is considered remote and handled in first + ;; cond before. + ((string-match helm-ff-tramp-method-regexp file) + (cons (propertize (concat "/" (match-string 1 file)) + 'face 'helm-ff-nofile) + (concat "/:" (match-string 1 file)))) + ;; A non--existing file. + (t + (add-face-text-property 0 len 'helm-ff-nofile t disp) + (cons (helm-ff-prefix-filename disp file 'new-file) + file)))))))) + +(defun helm-ff-get-icon (disp file) + "Get icon from `helm-x-icons-provider' for FILE. +Arg DISP is the display part of the candidate. +Arg FILE is the real part of candidate, a filename with no props." + (when helm-ff-icon-mode + (let ((icon (helm-acond (;; Non symlink directories. + (helm-ff--is-dir-from-disp disp) + (helm-aif (helm-x-icons-match-to-alist + (helm-basename file) + 'dir) + (apply (car it) (cdr it)) + (helm-x-icons-generic "file-directory"))) + (;; All files, symlinks may be symlink directories. + (helm-ff--is-file-from-disp disp) + ;; Detect symlink directories. We must call + ;; `file-directory-p' here but it is + ;; limited to symlinks, so it should not + ;; degrade too much performances. + (if (and (memq it '(helm-ff-symlink + helm-ff-dotted-symlink-directory)) + (file-directory-p file)) + (helm-x-icons-generic "file-symlink-directory") + (helm-x-icons-icon-for-file (helm-basename file))))))) + (when icon (concat icon " "))))) + +(defun helm-ff--is-dir-from-disp (disp) + "Return the face used for candidate when candidate is a directory." + (helm-aand (get-text-property 0 'face disp) + (memq it '(helm-ff-directory helm-ff-dotted-directory)) + (car it))) + +(defun helm-ff--is-file-from-disp (disp) + "Return the face used for file's candidate or dotted-symlink dirs." + (helm-aand (get-text-property 0 'face disp) + (memq it '(helm-ff-file + helm-ff-suid + helm-ff-executable + helm-ff-socket + helm-ff-pipe + helm-ff-symlink + helm-ff-dotted-symlink-directory + helm-ff-backup-file + helm-ls-git-untracked-face)) + (car it))) + +;;;###autoload +(define-minor-mode helm-ff-icon-mode + "Display icons from `helm-x-icons-provider' package in HFF when enabled." + :global t + :group 'helm-files + (when helm-ff-icon-mode + (unless (require helm-x-icons-provider nil t) + (setq helm-ff-icon-mode nil) + (message "No suitable Icons package found"))) + (clrhash helm-ff--list-directory-cache)) + +;;; Action transformer +;; +(defun helm-ff--in-backup-directory () + (when backup-directory-alist + (cl-loop for (_p . f) in backup-directory-alist + thereis (file-equal-p f helm-ff-default-directory)))) + +(defun helm-ff-restore-backups (_candidate) + (let ((mkd (helm-marked-candidates)) + (copied 0) + ovw) + (cl-dolist (file mkd) + (let (dest) + (when (string-match "\\(?:\\`\\([!]\\)[^!]*\\1.*\\)\\|\\(?:~\\'\\)" + (helm-basename file)) + (setq dest (helm-aand (replace-regexp-in-string + "\\.~[[:digit:]]*~?" + "" (helm-basename file)) + (helm-ff--normalize-backup-name it) + (if (string-match "\\`/" it) + it + ;; If basename doesn't contain now + ;; "/", that's mean it was a backup file + ;; stored in current directory, just + ;; expand it to this directory. + (expand-file-name it helm-ff-default-directory)))) + (if (and (file-exists-p dest) (null ovw)) + (helm-acase (helm-read-answer + (format "Overwrite `%s' (answer [y,n,!,q])? " dest) + '("y" "n" "!" "q")) + ("y" (cl-incf copied) (copy-file file dest t t t t)) + ("n" (ignore)) + ("!" (setq ovw t) (cl-incf copied) (copy-file file dest t t t t)) + ("q" (setq copied nil) (cl-return (message "Abort restoring files")))) + (cl-incf copied) + (copy-file file dest t t t t))))) + (when (numberp copied) + (message "(%s/%s) files copied" copied (length mkd))))) + +(defun helm-ff--normalize-backup-name (fname) + "Normalize backup FNAME to its original name." + ;; When Emacs build a backup filename for the backup directory it + ;; replace "/" by "!" in the basedir of file and double the "!" in + ;; the basename, this is done by `make-backup-file-name-1'. We want + ;; to replace only the "!" in the basedir part of FNAME. + (with-temp-buffer + (insert fname) + (goto-char (point-min)) + (save-excursion + (when (looking-at "!") (replace-match "/")) + (while (re-search-forward "[^!]\\([!]\\)[^!]" nil t) + (replace-match "/" nil nil nil 1))) + (let ((count 0) rep) + (while (re-search-forward "!" nil t) + (cl-incf count)) + (setq rep (make-string (/ count 2) ?!)) + (replace-regexp-in-string "[!]+" rep (buffer-string))))) + +(defun helm-ff-update-directory-autoloads (_candidate) + "Action to update or create autoloads file in current directory." + (let ((default-directory helm-ff-default-directory) + (file + (read-file-name "Write autoload definitions to file: " + helm-ff-default-directory + nil nil nil + (lambda (f) + (string-match "autoloads\\|loaddefs" f))))) + (if (fboundp 'loaddefs-generate) + (loaddefs-generate default-directory file nil nil nil t) + (let ((generated-autoload-file file)) + (update-directory-autoloads default-directory))))) + +(defun helm-find-files-action-transformer (actions candidate) + "Action transformer for `helm-source-find-files'." + (let ((str-at-point (with-helm-current-buffer + (buffer-substring-no-properties + (pos-bol) (pos-eol))))) + (when (file-regular-p candidate) + (setq actions (helm-append-at-nth + actions '(("Checksum File" . helm-ff-checksum)) 4))) + (when (file-exists-p (expand-file-name + (format "#%s#" (helm-basename candidate)) + (helm-basedir candidate))) + (setq actions (helm-append-at-nth + actions '(("Recover file" . recover-file)) 4))) + (cond ((helm-ff-trash-file-p candidate) + (helm-append-at-nth + actions + '(("Restore file(s) from trash" . helm-restore-file-from-trash) + ("Delete file(s) from trash" . helm-ff-trash-rm)) + 1)) + ((and helm--url-regexp + (not (string-match-p helm--url-regexp str-at-point)) + (not (with-helm-current-buffer (eq major-mode 'dired-mode))) + (string-match-p ":\\([0-9]+:?\\)" str-at-point)) + (append '(("Find file to line number" . helm-ff-goto-linum)) + actions)) + ((string-match (image-file-name-regexp) candidate) + (helm-append-at-nth + actions + (helm-make-actions + "Rotate image right `M-r'" 'helm-ff-rotate-image-right + "Rotate image left `M-l'" 'helm-ff-rotate-image-left + "Start slideshow with marked" 'helm-ff-start-slideshow-on-marked + (lambda () + (and (fboundp 'image-dired-wallpaper-set) + (display-graphic-p) + "Change wallpaper")) + 'image-dired-wallpaper-set) + 3)) + ((string-match "\\.el\\'" candidate) + (helm-append-at-nth + actions + `(("Byte compile lisp file(s) `M-B, C-u to load'" + . helm-find-files-byte-compile) + ("Byte compile file(s) async" + . ,(lambda (_candidate) + (cl-loop for file in (helm-marked-candidates) + do (async-byte-compile-file file)))) + ("Byte recompile directory async" + . ,(lambda (_) + (async-byte-recompile-directory + helm-ff-default-directory))) + ("Load File(s) `M-L'" . helm-find-files-load-files) + ("Update directory autoloads" . helm-ff-update-directory-autoloads)) + 2)) + ((string-match (concat (regexp-opt load-suffixes) "\\'") candidate) + (helm-append-at-nth + actions + '(("Load File(s) `M-L'" . helm-find-files-load-files)) + 2)) + ((and (string-match "\\.html?$" candidate) + (file-exists-p candidate)) + (helm-append-at-nth + actions '(("Browse url file" . browse-url-of-file)) 2)) + ((and (helm-ff--in-backup-directory) + (cl-loop for file in (helm-marked-candidates) + always (string-match "\\(?:\\`\\([!]\\)[^!]*\\1.*\\)\\|\\(?:~\\'\\)" + (helm-basename file)))) + (helm-append-at-nth + actions '(("Restore backup file(s)" . helm-ff-restore-backups)) 1)) + (t actions)))) + +;;; Trashing files +;; +(defun helm-ff-trash-action (fn names &rest args) + "Execute a trash action FN on marked files. + +Arg NAMES is a list of strings to pass to messages. +E.g. \\='(\"delete\" \"deleting\") + +ARGS are other arguments to be passed to FN." + (let ((mkd (helm-marked-candidates)) + errors aborted) + (with-helm-display-marked-candidates + helm-marked-buffer-name + (if (and args (string= (car names) "restore")) + (cl-loop for f in mkd + for bd = (helm-basename f) + for assoc = (assoc bd (car args)) + when assoc + collect (concat (truncate-string-to-width + (car assoc) 40 nil nil t) + " -> " + (truncate-string-to-width + (helm-basedir (cdr assoc)) 40 nil nil t))) + (helm-ff--count-and-collect-dups (mapcar 'helm-basename mkd))) + (if (y-or-n-p (format "%s %s files from trash? " + (capitalize (car names)) + (length mkd))) + (progn + (message "%s files from trash..." (capitalize (cadr names))) + (cl-loop for f in mkd do + (condition-case err + (apply fn f args) + (error (push (format "%s" (cadr err)) errors) + nil)))) + (message "%s files from trash aborted" (capitalize (cadr names))) + (setq aborted t))) + ;; Handle errors from outside the + ;; with-helm-display-marked-candidates block otherwise warning is + ;; never displayed. + (if errors + (progn + (display-warning 'helm + (with-temp-buffer + (insert (format-time-string "%Y-%m-%d %H:%M:%S\n" + (current-time))) + (insert (format + "Failed to %s %s/%s files from trash\n" + (car names) (length errors) (length mkd))) + (insert (mapconcat 'identity errors "\n") "\n ") + (buffer-string)) + :error + "*helm restore warnings*") + (message "%s files from trash aborted" (capitalize (cadr names)))) + (unless aborted + (message "%s %s files from trash done" + (capitalize (cadr names)) (length mkd)))))) + +(defun helm-ff-trash-rm (_candidate) + "Delete marked-files from a Trash directory. + +The Trash directory should be a directory compliant with + and each +file should have its \\='*.trashinfo' correspondent file in +Trash/info directory." + (helm-ff-trash-action 'helm-ff-trash-rm-1 '("delete" "deleting"))) + +(defun helm-ff-trash-rm-1 (file) + (let ((info-file (concat (helm-reduce-file-name file 2) + "info/" (helm-basename file "trashinfo") + ".trashinfo"))) + (cl-assert (file-exists-p file) + nil (format "No such file or directory `%s'" + file)) + (cl-assert (file-exists-p info-file) + nil (format "No such file or directory `%s'" + info-file)) + (if (file-directory-p file) + (delete-directory file t) + (delete-file file)) + (delete-file info-file))) + +(defun helm-restore-file-from-trash (_candidate) + "Restore marked-files from a Trash directory. + +The Trash directory should be a directory compliant with + and each +file should have its \\='*.trashinfo' corresponding file in +Trash/info directory." + (let* ((default-directory (file-name-as-directory + helm-ff-default-directory)) + (trashed-files (helm-ff-trash-list))) + (helm-ff-trash-action 'helm-restore-file-from-trash-1 + '("restore" "restoring") + trashed-files))) + +(defun helm-restore-file-from-trash-1 (file trashed-files) + "Restore FILE from a trash directory. +Arg TRASHED-FILES is an alist of (fname_in_trash . dest) obtained +with `helm-ff-trash-list'." + ;; Emacs trash duplicate files with a unique name + .trashinfo in + ;; the filename which is wrong, only files in info directory should + ;; end with .trashinfo, so fix the filename before looking for dest name. + (let* ((fname (replace-regexp-in-string "\\.trashinfo\\'" "" file)) + (info-file (concat (helm-reduce-file-name fname 2) + "info/" + (helm-basename fname) + ".trashinfo")) + (dest-file (helm-ff--get-dest-file-from-trash + trashed-files fname))) + (cl-assert (not (file-exists-p dest-file)) nil + (format "File `%s' already exists" dest-file)) + (cl-assert dest-file nil "No such file in trash") + (message "Restoring %s to %s..." (helm-basename file) (helm-basedir dest-file)) + (rename-file file dest-file) + (message "Restoring %s to %s done" (helm-basename file) (helm-basedir dest-file)) + (delete-file info-file))) + +(defun helm-ff-trash-file-p (file) + "Return t when FILE is a trashed file." + (and (file-exists-p file) + (string-match helm-ff--trash-directory-regexp (helm-basedir file)) + (not (member (helm-basename file) '("." ".."))))) + +(defun helm-ff--get-dest-file-from-trash (trashed-files file) + (assoc-default (helm-basename file) trashed-files)) + +(cl-defun helm-ff-trash-list (&optional (trash-dir nil strash-dir)) + "Return an alist of trashed files basename and dest name. +Assume the trash system in use is freedesktop compatible, see + +This function is intended to be used from a trash directory i.e. it +use `helm-ff-default-directory', but it may be used elsewhere by +specifying the trash directory with TRASH-DIR arg." + (unless (or (fboundp 'system-move-file-to-trash) + (and strash-dir (null trash-dir))) + ;; Files owned by root are trashed in /root/.local/share/Trash. + ;; Files owned by user and trashed by root are trashed in + ;; /home/.Trash. + ;; Files owned by user and trashed by user are trashed in + ;; ~/.local/share/Trash. + (cl-loop for f in (directory-files + (expand-file-name + ;; helm-ff-default-directory is currently the + ;; trash directory. + "info" (helm-basedir (directory-file-name + (or trash-dir helm-ff-default-directory)))) + t directory-files-no-dot-files-regexp) + collect (cons (helm-basename (replace-regexp-in-string "\\.trashinfo\\'" "" f)) + (with-temp-buffer + (save-excursion + (insert-file-contents f)) + (when (re-search-forward "^path=" nil t) + (let ((path (helm-url-unhex-string + (buffer-substring-no-properties + (point) (pos-eol))))) + (if (string-match "\\`/" path) + ;; path is absolute + path + ;; When path is relative, assume the + ;; trash directory is located at + ;; /home/.Trash and path is the + ;; relative name of file from /home. + (expand-file-name path "/home"))))))))) + +(defun helm-ff-goto-linum (candidate) + "Find file CANDIDATE and maybe jump to line number found in fname at point. +Line number should be added at end of fname preceded with \":\". +E.g. \"foo:12\"." + (let ((linum (with-helm-current-buffer + (let ((str (buffer-substring-no-properties + (pos-bol) (pos-eol)))) + (when (string-match ":\\([0-9]+:?\\)" str) + (match-string 1 str)))))) + (find-file candidate) + (and linum (not (string= linum "")) + (helm-goto-line (string-to-number linum) t)))) + +(defun helm-ff-mail-attach-files (_candidate) + "Run `mml-attach-file' on `helm-marked-candidates'." + (require 'mml) + (let ((flist (helm-marked-candidates :with-wildcard t)) + (dest-buf (and (derived-mode-p 'message-mode 'mail-mode) + (current-buffer))) + bufs) + (unless dest-buf + (setq bufs (cl-loop for b in (buffer-list) + when (with-current-buffer b + (derived-mode-p 'message-mode 'mail-mode)) + collect (buffer-name b))) + (if (and bufs (y-or-n-p "Attach files to existing mail composition buffer? ")) + (setq dest-buf + (if (cdr bufs) + (helm-comp-read "Attach to buffer: " bufs :nomark t) + (car bufs))) + (compose-mail) + (setq dest-buf (current-buffer)))) + (switch-to-buffer dest-buf) + (save-restriction + (widen) + (save-excursion + (goto-char (point-max)) + (cl-loop for f in flist + do (mml-attach-file f (or (mm-default-file-encoding f) + "application/octet-stream"))))))) + +(defvar image-dired-display-image-buffer) +(defun helm-ff-rotate-current-image-1 (file angle) + "Rotate current image at ANGLE degrees." + (cl-assert (and (file-exists-p file) + (string-match (image-file-name-regexp) file)) + nil "Can't rotate non image file") + (setq file (file-truename file)) ; For symlinked images. + (let ((default-directory (file-name-directory file)) + (basename (helm-basename file)) + ;; convert ANGLE to a suitable value for exiftran. + (num-arg (if (string= helm-ff-rotate-image-program "exiftran") + (cl-case angle + (90 "-9") ; 90 clockwise + (270 "-2")) ; 270 clockwise == -90 + (number-to-string angle))) + rotation-failed) + ;; Try to rotate image with exiftran even with helm-ff-display-image-native. + (if (and helm-ff-rotate-image-program + (executable-find helm-ff-rotate-image-program)) + (apply #'process-file helm-ff-rotate-image-program nil nil nil + (append helm-ff-rotate-image-switch + (list num-arg basename))) + (setq rotation-failed t)) + ;; Display image in image-mode. + (if (helm-ff-display-image-native-p) + (if rotation-failed + ;; When rotation fails fallback to `image-rotate' with no + ;; transformation of file. + (with-selected-window (helm-persistent-action-display-window) + (condition-case _err + (with-no-warnings (image-rotate angle)) + (wrong-number-of-arguments (image-rotate)))) + (helm-ff--display-image-native file)) + ;; Use image-dired to display image. + (when rotation-failed + (error "%s not found" (or helm-ff-rotate-image-program + "`helm-ff-rotate-image-program'"))) + (when (buffer-live-p image-dired-display-image-buffer) + (kill-buffer image-dired-display-image-buffer)) + (image-dired-display-image basename) + (message nil) + (display-buffer (get-buffer image-dired-display-image-buffer))))) + +(defun helm-ff-rotate-image-left (candidate) + "Rotate image file CANDIDATE left. +This affects directly file CANDIDATE." + (helm-ff-rotate-current-image-1 candidate 270)) + +(defun helm-ff-rotate-image-right (candidate) + "Rotate image file CANDIDATE right. +This affects directly file CANDIDATE." + (helm-ff-rotate-current-image-1 candidate 90)) + +(defun helm-ff-rotate-left-persistent () + "Rotate image left without quitting helm." + (interactive) + (with-helm-alive-p + (helm-set-attr 'image-action1 'helm-ff-rotate-image-left) + (helm-execute-persistent-action 'image-action1))) +(put 'helm-ff-rotate-left-persistent 'helm-only t) + +(defun helm-ff-rotate-right-persistent () + "Rotate image right without quitting helm." + (interactive) + (with-helm-alive-p + (helm-set-attr 'image-action2 'helm-ff-rotate-image-right) + (helm-execute-persistent-action 'image-action2))) +(put 'helm-ff-rotate-right-persistent 'helm-only t) + +(defun helm-ff-resize-image-1 (arg) + ;; `image-decrease-size' and `image-increase-size' are not usable + ;; because they run directly `image--change-size' in a timer without + ;; taking care of the selected-window. + (cl-assert (and (fboundp 'image--change-size) + (helm-ff-display-image-native-p)) + nil "Resizing image not available") + (if (> arg 0) + (helm-ff--image-change-size 1.2) + (helm-ff--image-change-size 0.8))) + +(defun helm-ff--image-change-size (factor) + (run-with-idle-timer + 0.3 nil + (lambda () + (with-selected-window (helm-persistent-action-display-window) + (image--change-size factor))))) + +(defun helm-ff-increase-image-size (_candidate) + (helm-ff-resize-image-1 1)) + +(defun helm-ff-decrease-image-size (_candidate) + (helm-ff-resize-image-1 -1)) + +(defun helm-ff-increase-image-size-persistent () + "Increase image size without quitting helm." + (interactive) + (with-helm-alive-p + (helm-set-attr 'image-action3 'helm-ff-increase-image-size) + (helm-execute-persistent-action 'image-action3))) +(put 'helm-ff-increase-image-size-persistent 'helm-only t) + +(defun helm-ff-decrease-image-size-persistent () + "Decrease image size without quitting helm." + (interactive) + (with-helm-alive-p + (helm-set-attr 'image-action4 'helm-ff-decrease-image-size) + (helm-execute-persistent-action 'image-action4))) +(put 'helm-ff-decrease-image-size-persistent 'helm-only t) + +(defun helm-ff-exif-data (candidate) + "Extract exif data from file CANDIDATE using `helm-ff-exif-data-program'." + (if (and helm-ff-exif-data-program + (executable-find helm-ff-exif-data-program)) + (shell-command-to-string (format "%s %s %s" + helm-ff-exif-data-program + helm-ff-exif-data-program-args + candidate)) + (format "No program %s found to extract exif" + helm-ff-exif-data-program))) + +(defvar helm-ff-image-native-buffer "*image-native-display*") + +(defvar helm-ff-sound-file-extensions '("wav" "au")) + +(defun helm-ff--maybe-follow (candidate) + (let ((file (if helm-ff-ignore-following-on-directory + (file-exists-p candidate) + (file-regular-p candidate))) + (image (string-match-p (image-file-name-regexp) candidate)) + (ext (file-name-extension candidate))) + (and file + (or image (not (member ext helm-ff-follow-blacklist-file-exts)))))) + +(cl-defun helm-find-files-persistent-action-if (candidate) + "Open subtree CANDIDATE without quitting helm. +If CANDIDATE is not a directory expand CANDIDATE filename. +If CANDIDATE is alone, open file CANDIDATE filename. +That means: +First hit on C-j expands CANDIDATE, second hit opens file. +If a prefix arg is given or `helm-follow-mode' is on, then open +file." + (let* ((follow (or (helm-follow-mode-p) + helm--temp-follow-flag)) + (image-cand (string-match-p (image-file-name-regexp) candidate)) + (sound-cand (member (file-name-extension candidate) + helm-ff-sound-file-extensions)) + (selection (helm-get-selection)) + (insert-in-minibuffer (lambda (fname) + (with-selected-window (or (active-minibuffer-window) + (minibuffer-window)) + (unless follow + (delete-minibuffer-contents) + (set-text-properties 0 (length fname) + nil fname) + ;; Backup files have "!" to replace "/" + ;; in their basenames. + (insert (replace-regexp-in-string + "/!" "/\\\\!" fname))))))) + (helm-set-attr 'candidate-number-limit helm-ff-candidate-number-limit) + (unless (helm-ff--maybe-follow candidate) + (when follow + (helm-follow-mode -1) (message nil) + (cl-return-from helm-find-files-persistent-action-if + (prog1 + #'ignore + (user-error "Can't follow this kind of file"))))) + (cond (;; Tramp methods completion. + (string-match helm-ff-tramp-method-regexp candidate) + (let ((method (match-string 1 candidate))) + (cons (lambda (candidate) + (funcall insert-in-minibuffer + (if (helm-ff--tramp-multihops-p candidate) + (concat (match-string 1 candidate) method ":") + (concat "/" method ":")))) + 'never-split))) + ((and (helm-ff--invalid-tramp-name-p) + (string-match helm-tramp-file-name-regexp candidate)) + (cons (lambda (_candidate) + ;; First hit insert hostname and + ;; second hit insert ":" and expand. + (if (string= candidate helm-pattern) + (funcall insert-in-minibuffer (concat candidate ":")) + (funcall insert-in-minibuffer candidate))) + 'never-split)) + (;; A symlink directory, expand it but not to its truename + ;; unless a prefix arg is given. + (and (file-directory-p candidate) (file-symlink-p candidate)) + (cons (lambda (_candidate) + (helm-ff-after-persistent-show-all) + (let ((new-dir (file-name-as-directory + (if current-prefix-arg + (file-truename (expand-file-name candidate)) + (expand-file-name candidate))))) + (setq helm-ff--show-thumbnails + (member new-dir helm-ff--thumbnailed-directories)) + (funcall insert-in-minibuffer new-dir))) + 'never-split)) + ;; A directory, open it. + ((file-directory-p candidate) + (cons (lambda (_candidate) + (helm-ff-after-persistent-show-all) + (when (string= (helm-basename candidate) "..") + (setq helm-ff-last-expanded helm-ff-default-directory)) + (let ((new-dir (file-name-as-directory + (expand-file-name candidate)))) + (setq helm-ff--show-thumbnails + (member new-dir helm-ff--thumbnailed-directories)) + (funcall insert-in-minibuffer new-dir)) + (with-helm-after-update-hook (helm-ff-retrieve-last-expanded))) + 'never-split)) + ;; A symlink file, expand to it's true name. (first hit) + ((and (file-symlink-p candidate) (not current-prefix-arg) (not follow)) + (cons (lambda (_candidate) + (funcall insert-in-minibuffer (file-truename candidate)) + (helm-check-minibuffer-input)) ; Force update. + 'never-split)) + ;; A regular file, expand it, (first hit) + ((and (not (file-equal-p selection helm-pattern)) + (not current-prefix-arg) (not follow)) + (cons (lambda (_candidate) + (funcall insert-in-minibuffer selection) + (helm-check-minibuffer-input)) ; Force update. + 'never-split)) + (sound-cand (lambda (candidate) (play-sound-file candidate))) + ;; An image file and it is the second hit on C-j, display it. + (image-cand + (if (helm-ff-display-image-native-p) + #'helm-ff--display-or-kill-image-native + (lambda (_candidate) + (require 'image-dired) + (let* ((win (get-buffer-window + image-dired-display-image-buffer 'visible)) + (fname (and win + (with-selected-window win + (get-text-property (point-min) + 'original-file-name)))) + (remove-buf-only (and win + fname + (with-helm-buffer + (file-equal-p candidate fname))))) + (when remove-buf-only + (with-helm-window + (if (and helm-persistent-action-display-window + (window-dedicated-p (next-window win 1))) + (delete-window helm-persistent-action-display-window) + (set-window-buffer win helm-current-buffer)))) + (when (buffer-live-p (get-buffer image-dired-display-image-buffer)) + (kill-buffer image-dired-display-image-buffer)) + (unless remove-buf-only + ;; Fix emacs bug never fixed upstream. + (unless (file-directory-p image-dired-dir) + (make-directory image-dired-dir)) + (switch-to-buffer image-dired-display-image-buffer) + (message "Resizing image...") + (cl-letf (((symbol-function 'message) #'ignore)) + (image-dired-display-image candidate)) + (message "Resizing image done") + (with-current-buffer image-dired-display-image-buffer + (let ((exif-data (helm-ff-exif-data candidate))) + (setq default-directory helm-ff-default-directory) + (image-dired-update-property 'help-echo exif-data)))))))) + ;; Allow browsing archive on avfs fs. + ;; Assume volume is already mounted with mountavfs. + ((helm-aand helm-ff-avfs-directory + (file-name-directory candidate) + (string-match + (regexp-quote (expand-file-name helm-ff-avfs-directory)) + it) + (helm-ff-file-compressed-p candidate)) + (cons (lambda (_candidate) + (funcall insert-in-minibuffer (concat candidate "#/"))) + 'never-split)) + ;; File is not existing and have no basedir, typically when + ;; user hit C-k (minibuffer is empty) and then write foo and + ;; hit C-j. This make clear that when no basedir, helm will + ;; create the file in default-directory. + ((and (not (file-exists-p candidate)) + (not (helm-basedir candidate))) + (cons (lambda (_candidate) + (funcall insert-in-minibuffer + (expand-file-name candidate default-directory))) + 'never-split)) + ;; On second hit we open file. + ;; On Third hit we kill it's buffer maybe. + (t + (lambda (candidate) + (funcall helm-ff-kill-or-find-buffer-fname-fn candidate)))))) + +;; Native image display (with image-mode). +;; +(defvar helm-ff--image-cache nil) + +(defun helm-ff-display-image-native-p () + "Use `helm-ff-display-image-native' when returns `t'." + (or helm-ff-display-image-native + ;; Image-dired in emacs-29 uses image-mode but + ;; display is no more working with our old + ;; image-dired code, so force usage of + ;; helm-ff-display-image-native. + (fboundp 'image-dired-display-image-mode))) + +(defun helm-ff--display-or-kill-image-native (candidate) + ;; Display images in same buffer + ;; `helm-ff-image-native-buffer'. + (if (and (buffer-live-p (get-buffer helm-ff-image-native-buffer)) + (file-equal-p (buffer-file-name + (get-buffer helm-ff-image-native-buffer)) + candidate) + ;; Allow redisplaying + ;; `helm-ff-image-native-buffer' when it + ;; already exists and display same image as candidate. + (get-buffer-window helm-ff-image-native-buffer 'visible)) + (progn + (set-window-buffer + helm-persistent-action-display-window helm-current-buffer) + (kill-buffer helm-ff-image-native-buffer)) + (helm-ff--display-image-native candidate))) + +(defun helm-ff-clean-image-cache () + (when helm-ff--image-cache + (cl-loop for img in helm-ff--image-cache + do (clear-image-cache img) + finally do (setq helm-ff--image-cache nil)))) + +(defun helm-ff--display-image-native (candidate) + (when (string-match-p (image-file-name-regexp) candidate) + (when (buffer-live-p (get-buffer helm-ff-image-native-buffer)) + (kill-buffer helm-ff-image-native-buffer)) + ;; Avoid hight memory consumption see + ;; https://lists.gnu.org/archive/html/bug-gnu-emacs/2021-11/msg00879.html. + (when (> (length helm-ff--image-cache) + (* helm-ff-image-cache-max-len 2)) + ;; Only keep the last `helm-ff-image-cache-max-len' images in cache. + (cl-loop for img in (butlast helm-ff--image-cache + (1+ helm-ff-image-cache-max-len)) + do (clear-image-cache img) + (setq helm-ff--image-cache + (delete img helm-ff--image-cache)))) + (cl-letf* (((symbol-function 'message) #'ignore) + (buf (find-file-noselect candidate t))) + ;; When going back reuse the cached images. + (unless (member candidate helm-ff--image-cache) + (setq helm-ff--image-cache + (append helm-ff--image-cache + (list (expand-file-name candidate))))) + (with-current-buffer buf + (rename-buffer helm-ff-image-native-buffer)) + (display-buffer buf)))) + +;;; Slideshow action +;; +(defvar helm-ff--slideshow-iterator nil) +(defvar helm-ff--slideshow-sequence nil) +(defvar helm-ff--slideshow-in-pause nil) +(defvar helm-ff-slideshow-helper + "Type `\\[helm-ff-slideshow-pause-or-restart]' to %s, \ +`\\[helm-ff-slideshow-next]' for next, `\\[helm-ff-slideshow-previous]' for previous, \ +`\\[helm-ff-slideshow-quit]' to quit") + +(defvar helm-slideshow-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map image-mode-map) + (define-key map (kbd "SPC") 'helm-ff-slideshow-pause-or-restart) + (define-key map (kbd "q") 'helm-ff-slideshow-quit) + (define-key map (kbd "n") 'helm-ff-slideshow-next) + (define-key map (kbd "p") 'helm-ff-slideshow-previous) + map)) + +(define-derived-mode helm-slideshow-mode + image-mode "helm-image-mode" + "Mode to display images from helm-find-files. + +Special commands: +\\{helm-slideshow-mode-map} +") +(put 'helm-slideshow-mode 'no-helm-mx t) + +(defun helm-ff-slideshow-help-string (counter-string state) + (concat counter-string + (substitute-command-keys + (format helm-ff-slideshow-helper state)))) + +(defun helm-ff-start-slideshow-on-marked (_candidate) + "Start a slideshow on marked files." + (let ((marked (helm-remove-if-not-match + (image-file-name-regexp) + (helm-marked-candidates :with-wildcard t)))) + (cl-assert (cdr marked) nil "Can't start a slideshow on a single file") + (setq helm-ff--slideshow-sequence marked) + (setq helm-ff--slideshow-iterator (helm-iter-circular marked)) + (helm-ff--display-image-native (helm-iter-next helm-ff--slideshow-iterator)) + (delete-other-windows (get-buffer-window helm-ff-image-native-buffer)) + (cl-letf (((symbol-function 'message) #'ignore)) + (helm-slideshow-mode)) + (setq mode-line-format (helm-ff-slideshow-help-string + (format "(1/%s) " (length marked)) "pause")) + (helm-ff-slideshow-loop helm-ff--slideshow-iterator))) + +(defun helm-ff-slideshow-state () + (format "(%s/%s) " + (1+ (helm-position + (buffer-file-name) helm-ff--slideshow-sequence + :test 'equal)) + (length helm-ff--slideshow-sequence))) + +(defun helm-ff-slideshow-sequence-from-current (&optional reverse) + (helm-reorganize-sequence-from-elm + helm-ff--slideshow-sequence (buffer-file-name) reverse)) + +(defun helm-ff-slideshow-loop (iterator &optional restart) + (while (sit-for helm-ff-slideshow-default-delay) + (helm-ff--display-image-native (helm-iter-next iterator)) + (delete-other-windows (get-buffer-window helm-ff-image-native-buffer)) + (cl-letf (((symbol-function 'message) #'ignore)) + (helm-slideshow-mode)) + (when restart + (message "Helm Slideshow started") + (sit-for 1) + (message nil) + (setq restart nil)) + (setq mode-line-format + (helm-ff-slideshow-help-string + (helm-ff-slideshow-state) "pause")))) + +(defun helm-ff-slideshow-pause-or-restart () + (interactive) + (setq helm-ff--slideshow-in-pause (not helm-ff--slideshow-in-pause)) + (if helm-ff--slideshow-in-pause + (setq mode-line-format (helm-ff-slideshow-help-string nil "restart")) + (message "Helm Slideshow restarting...") + (setq helm-ff--slideshow-iterator + (helm-iter-circular (helm-ff-slideshow-sequence-from-current))) + (helm-ff-slideshow-loop helm-ff--slideshow-iterator 'restart))) +(put 'helm-ff-slideshow-pause-or-restart 'no-helm-mx t) + +(defun helm-ff-slideshow-next () + (interactive) + (setq helm-ff--slideshow-in-pause t) + (setq helm-ff--slideshow-iterator nil) + (helm-ff--display-image-native + (car (helm-ff-slideshow-sequence-from-current))) + (delete-other-windows (get-buffer-window helm-ff-image-native-buffer)) + (cl-letf (((symbol-function 'message) #'ignore)) + (helm-slideshow-mode)) + (message (concat (helm-ff-slideshow-state) + (substitute-command-keys + (format helm-ff-slideshow-helper "restart"))))) +(put 'helm-ff-slideshow-next 'no-helm-mx t) + +(defun helm-ff-slideshow-previous () + (interactive) + (setq helm-ff--slideshow-in-pause t) + (setq helm-ff--slideshow-iterator nil) + (helm-ff--display-image-native + (car (helm-ff-slideshow-sequence-from-current 'reverse))) + (delete-other-windows (get-buffer-window helm-ff-image-native-buffer)) + (cl-letf (((symbol-function 'message) #'ignore)) + (helm-slideshow-mode)) + (message (concat (helm-ff-slideshow-state) + (substitute-command-keys + (format helm-ff-slideshow-helper "restart"))))) +(put 'helm-ff-slideshow-previous 'no-helm-mx t) + +(defun helm-ff-slideshow-quit () + (interactive) + (setq helm-ff--slideshow-iterator nil) + (setq helm-ff--slideshow-in-pause nil) + (helm-ff-clean-image-cache) + (quit-window)) +(put 'helm-ff-slideshow-quit 'no-helm-mx t) + +;;; Thumbnails view +;; +(defun helm-ff-maybe-show-thumbnails (candidates _source) + (require 'image-dired) + (if (and helm-ff--show-thumbnails + (null (file-remote-p helm-ff-default-directory))) + (prog1 + (cl-loop with scale = (image-compute-scaling-factor nil) + for (disp . img) in candidates + for type = (helm-acase (file-name-extension img) + ((guard* (and (member it '("png" "jpg" "jpeg")) + (memq image-dired-thumbnail-storage + '(standard standard-large)))) + 'png) + (("jpg" "jpeg") 'jpeg) + ("png" 'png)) + if type collect + (let ((thumbnail (plist-get + (cdr (helm-ff--image-dired-get-thumbnail-image + img type scale)) + :file))) + ;; When icons are displayed the leading space handling disp + ;; prop is already here, just replace icon with the thumbnail. + (unless helm-ff-icon-mode (setq disp (concat " " disp))) + (add-text-properties 0 1 `(display (image + :type ,type + :margin 5 + :file ,thumbnail) + rear-nonsticky '(display)) + disp) + (cons disp img)) + else collect (cons disp img)) + ;; Ensure this is done AFTER previous clause otherwise thumb files will + ;; never be created if they don't already exist. + (cl-pushnew helm-ff-default-directory + helm-ff--thumbnailed-directories :test 'equal)) + candidates)) + +;; Same as `image-dired-get-thumbnail-image' but use +;; `helm-ff--image-dired-thumb-name' which cache thumbnails for further use. +(defun helm-ff--image-dired-get-thumbnail-image (file &optional type scale) + "Return the image descriptor for a thumbnail of image file FILE." + (unless (string-match-p (image-file-name-regexp) file) + (error "%s is not a valid image file" file)) + (let* ((thumb-file (helm-ff--image-dired-thumb-name file)) + thumb-attr) + ;; Don't check status of files with `file-attributes' if it has already been + ;; done in this session. + (when (and (not (member helm-ff-default-directory + helm-ff--thumbnailed-directories)) + (or (not (setq thumb-attr (file-attributes thumb-file))) + (time-less-p (file-attribute-modification-time thumb-attr) + (file-attribute-modification-time + (file-attributes file))))) + (image-dired-create-thumb file thumb-file)) + (create-image thumb-file type nil :scale scale))) + +(defvar helm-ff-image-dired-thumbnails-cache (make-hash-table :test 'equal) + "Store associations of image_file/thumbnail_file.") +(defun helm-ff--image-dired-thumb-name (file) + (or (gethash file helm-ff-image-dired-thumbnails-cache) + (let ((thumb-name (image-dired-thumb-name file))) + (puthash file thumb-name helm-ff-image-dired-thumbnails-cache) + thumb-name))) + +(defun helm-ff-toggle-thumbnails () + (interactive) + (cl-assert (null (file-remote-p helm-ff-default-directory)) + nil "Thumbnails show not supported on remote files") + (setq helm-ff--show-thumbnails (not helm-ff--show-thumbnails)) + (when helm-ff--show-thumbnails + (message "Loading thumbnails...") + (with-helm-after-update-hook + (message "Loading thumbnails done"))) + (when (and (null helm-ff--show-thumbnails) + (member helm-ff-default-directory + helm-ff--thumbnailed-directories)) + (setq helm-ff--thumbnailed-directories + (delete helm-ff-default-directory helm-ff--thumbnailed-directories))) + (helm-force-update (regexp-quote (replace-regexp-in-string + "\\`[[:multibyte:] ]*" "" + (helm-get-selection nil t))))) +(put 'helm-ff-toggle-thumbnails 'no-helm-mx t) + +;;;###autoload +(defun helm-ff-clear-image-dired-thumbnails-cache () + "Clear `helm-ff-image-dired-thumbnails-cache'. +You may want to do this after customizing +`image-dired-thumbnail-storage' which may change the place where +thumbnail files are stored." + (interactive) + (clrhash helm-ff-image-dired-thumbnails-cache)) + +;;;###autoload +(defun helm-ff-cleanup-image-dired-dir-and-cache () + "Cleanup `image-dired-dir' directory. +Delete all thumb files that are no more associated with an existing +image file in `helm-ff-image-dired-thumbnails-cache'." + (interactive) + (cl-loop for key being the hash-keys in helm-ff-image-dired-thumbnails-cache + using (hash-value val) + unless (file-exists-p key) do + (progn + (message "Deleting %s" val) + (delete-file val) + (remhash key helm-ff-image-dired-thumbnails-cache)))) + +;;; Recursive dirs completion +;; +(defun helm-find-files-recursive-dirs (directory &optional input) + (when (string-match "\\([.]\\)\\{2\\}" input) + (setq input (replace-match "" nil t input))) + (message "Recursively searching %s from %s ..." + input (abbreviate-file-name directory)) + ;; Ensure to not create a new frame + (let (helm-actions-inherit-frame-settings) + (helm :sources + (helm-make-source + "Recursive directories" 'helm-locate-subdirs-source + :header-name + (lambda (name) + (format "%s from `%s'" + name + (abbreviate-file-name helm-ff-default-directory))) + :basedir (if (string-match-p + "\\`es" helm-locate-recursive-dirs-command) + directory + (shell-quote-argument directory)) + :subdir (shell-quote-argument input) + :candidate-transformer + `(,(lambda (candidates) + (cl-loop for c in candidates + when (and (file-directory-p c) + (null (helm-boring-directory-p + c helm-boring-file-regexp-list)) + (string-match-p (regexp-quote input) + (helm-basename c))) + collect (propertize c 'face 'helm-ff-dirs))) + helm-w32-pathname-transformer + ,(lambda (candidates) + (helm-ff-sort-candidates-1 candidates input))) + :persistent-action 'ignore + :action (lambda (c) + (helm-set-pattern + (file-name-as-directory (expand-file-name c))))) + :candidate-number-limit 999999 + :allow-nest t + :resume 'noresume + :ff-transformer-show-only-basename nil + :buffer "*helm recursive dirs*"))) + +(defun helm-ff-recursive-dirs (_candidate) + "Launch a recursive search in `helm-ff-default-directory'." + (with-helm-default-directory helm-ff-default-directory + (helm-find-files-recursive-dirs + default-directory + (helm-basename (helm-get-selection))))) + +(defun helm-ff-file-compressed-p (candidate) + "Whether CANDIDATE is a compressed file or not." + (member (file-name-extension candidate) + helm-ff-file-compressed-list)) + +(defun helm-ff--fname-at-point () + "Try to guess fname at point." + (let ((end (point)) + (limit (helm-aif (bounds-of-thing-at-point 'filename) + (car it) + (point)))) + (save-excursion + (while (re-search-backward "\\(~\\|/\\|[[:lower:][:upper:]]:/\\)" + limit t)) + (buffer-substring-no-properties (point) end)))) + +(defun helm-insert-file-name-completion-at-point (_candidate) + "Insert file name completion at point. + +When completing i.e. there is already something at point, insert +filename abbreviated, relative or full according to initial +input, whereas when inserting i.e. there is nothing at point, +insert filename full, abbreviated or relative according to prefix +arg, respectively no prefix arg, one prefix arg or two prefix +arg." + (with-helm-current-buffer + (if buffer-read-only + (error "Error: Buffer `%s' is read-only" (buffer-name)) + (let* ((mkds (helm-marked-candidates :with-wildcard t)) + (candidate (car mkds)) + (end (point)) + (tap (helm-ffap-guesser)) + (guess (and (stringp tap) + (substring-no-properties tap))) + (beg (helm-aif (and guess + (save-excursion + (when (re-search-backward + (regexp-quote guess) + (pos-bol) t) + (point)))) + it (point))) + (full-path-p (and (stringp guess) + (or (string-match-p + (concat "^" (getenv "HOME")) + guess) + (string-match-p + "\\`\\(/\\|[[:lower:][:upper:]]:/\\)" + guess)))) + (escape-fn (if (memq major-mode + helm-modes-using-escaped-strings) + #'shell-quote-argument #'identity))) + (when (and beg end) + (delete-region beg end)) + (insert + (funcall + escape-fn + (helm-ff--format-fname-to-insert + candidate beg end full-path-p guess + helm-current-prefix-arg)) + (if (cdr mkds) " " "") + (mapconcat escape-fn + (cl-loop for f in (cdr mkds) + collect (helm-ff--format-fname-to-insert + f nil nil nil nil + helm-current-prefix-arg)) + " ")))))) + +(defun helm-ff--format-fname-to-insert (candidate + &optional beg end full-path guess prefarg) + (set-text-properties 0 (length candidate) nil candidate) + (if (and beg end guess (not (string= guess "")) + (null prefarg) + (or (string-match + "^\\(~/\\|/\\|[[:lower:][:upper:]]:/\\)" + guess) + (file-exists-p candidate))) + (cond (full-path + (expand-file-name candidate)) + ((string= (match-string 1 guess) "~/") + (abbreviate-file-name candidate)) + (t (file-relative-name candidate))) + (helm-acase prefarg + ((4) (abbreviate-file-name candidate)) + ((16) (file-relative-name candidate)) + ((64) (helm-basename candidate)) + (t candidate)))) + +(cl-defun helm-find-files-history (arg &key (comp-read t)) + "The `helm-find-files' history. +Show the first `helm-ff-history-max-length' elements of +`helm-ff-history' in an `helm-comp-read'." + (interactive "p") + (let ((history (when helm-ff-history + (helm-fast-remove-dups helm-ff-history + :test 'equal)))) + (when history + (setq helm-ff-history + (if (>= (length history) helm-ff-history-max-length) + (helm-take history helm-ff-history-max-length) + history)) + (if comp-read + (let ((src (helm-build-sync-source "Helm Find Files History" + :candidates helm-ff-history + :fuzzy-match (helm-ff--fuzzy-matching-p) + :persistent-action 'ignore + :migemo t + :action (lambda (candidate) + (if arg + (helm-set-pattern + (expand-file-name candidate)) + (identity candidate)))))) + (helm :sources src + :resume 'noresume + :buffer helm-ff-history-buffer-name + :allow-nest t)) + helm-ff-history)))) +(put 'helm-find-files-history 'helm-only t) + +;; The `helm-drag-mouse-1-fn' for helm-find-files, it is bound to +;; in `helm--bind-mouse-for-selection'. +;; See https://freedesktop.org/wiki/Specifications/XDND/ +;; and (info "(elisp) Drag and Drop") for more infos. +(defun helm-ff-mouse-drag (event) + "Drag-and-drop marked files at EVENT. + +It is the drag-an-drop function of dired adapted for helm-find-files." + (interactive "e") + (when mark-active (deactivate-mark)) + (let ((action helm-ff-drag-mouse-1-default-action)) + (save-excursion + (with-selected-window (posn-window (event-end event)) + (goto-char (posn-point (event-end event)))) + (track-mouse + (let ((beginning-position (mouse-pixel-position)) + new-event) + (catch 'track-again + (setq new-event (read-event)) + (if (not (eq (event-basic-type new-event) 'mouse-movement)) + (when (eq (event-basic-type new-event) 'mouse-1) + (push new-event unread-command-events)) + (let ((current-position (mouse-pixel-position))) + ;; If the mouse didn't move far enough, don't + ;; inadvertently trigger a drag. + (when (and (eq (car current-position) (car beginning-position)) + (ignore-errors + (and (> 3 (abs (- (cadr beginning-position) + (cadr current-position)))) + (> 3 (abs (- (caddr beginning-position) + (caddr current-position))))))) + (throw 'track-again nil))) + ;; We can get an error if there's by some chance no file + ;; name at point. + (condition-case error + (let ((files (with-helm-window (helm-marked-candidates)))) + (dnd-begin-drag-files files nil action t)) + (error (when (eq (event-basic-type new-event) 'mouse-1) + (push new-event unread-command-events)) + ;; Errors from `dnd-begin-drag-files' should be + ;; treated as user errors, since they should + ;; only occur when the user performs an invalid + ;; action, such as trying to create a link to + ;; a remote file. + (user-error (cadr error))))))))))) +(put 'helm-ff-mouse-drag 'helm-only t) + +(defvar helm-dnd-protocol-alist + '(("^file:///" . helm-dnd-handle-local-file) + ("^file://" . helm-dnd-handle-file) + ("^file:" . helm-dnd-handle-local-file)) + "The functions to call when dropping to helm-buffer. +Prevent dropping to helm buffer when user starts a drag-and-drop action +and release the mouse in this same buffer.") + +(defun helm-dnd-handle-local-file (_uri _action) + "Prevent dropping files to helm buffer." + (user-error "Can't drop files in helm buffer")) +(defun helm-dnd-handle-file (_uri _action) + "Prevent dropping files to helm buffer." + (user-error "Can't drop files in helm buffer")) + +;; This is used to advice `x-dnd-handle-drag-n-drop-event'. +(defun helm-ff--restore-frame (&rest _args) + (let ((hframe (window-frame (helm-window)))) + (if (eql (selected-frame) hframe) + (select-window (active-minibuffer-window)) + (select-frame hframe)))) + +(defun helm-find-files-1 (fname &optional preselect) + "Find FNAME filename with PRESELECT filename preselected. + +Use it for non-interactive calls of `helm-find-files'." + (require 'tramp) + (require 'dnd) + ;; Resolve FNAME now outside of helm. + ;; [FIXME] When `helm-find-files-1' is used directly from lisp + ;; and FNAME is an abbreviated path, for some reasons + ;; `helm-update' is called many times before resolving + ;; the abbreviated path (Bug#1939) so be sure to pass a + ;; full path to helm-find-files-1. + (unless (string-match-p helm-ff-url-regexp fname) + (setq fname (expand-file-name (substitute-in-file-name fname)))) + (when (get-buffer helm-action-buffer) + (kill-buffer helm-action-buffer)) + (setq helm-find-files--toggle-bookmark nil) + (let* ( ;; Be sure we don't erase the precedent minibuffer if some. + (helm-ff-auto-update-initial-value + (and helm-ff-auto-update-initial-value + (not (minibuffer-window-active-p (minibuffer-window))))) + (tap (thing-at-point 'filename)) + (def (and tap (or (file-remote-p tap) + (expand-file-name tap)))) + ;; Ensure not being prompted for password each time we + ;; navigate to a directory. + (password-cache t)) + (helm-set-local-variable 'helm-follow-mode-persistent nil) + (when (fboundp 'dnd-begin-drag-files) + (helm-set-local-variable 'helm-drag-mouse-1-fn 'helm-ff-mouse-drag + 'dnd-protocol-alist + (append helm-dnd-protocol-alist dnd-protocol-alist)) + (advice-add 'x-dnd-handle-drag-n-drop-event :after #'helm-ff--restore-frame)) + (unless helm-source-find-files + (setq helm-source-find-files (helm-make-source + "Find Files" 'helm-source-ffiles))) + (when (helm-get-attr 'follow helm-source-find-files) + (helm-set-attr 'follow -1 helm-source-find-files)) + ;; If preselected candidate is further than `helm-ff-candidate-number-limit' + ;; in the directory file list, we have to increase `candidate-number-limit' + ;; attr to have this candidate visible for preselection. + (when (and preselect helm-ff-dynamic-candidate-number-limit) + (helm-set-attr 'candidate-number-limit + (helm-aif (gethash fname helm-ff--directory-files-length) + (max it helm-ff-candidate-number-limit) + 99999) + helm-source-find-files)) + (helm-ff-setup-update-hook) + (add-hook 'helm-resume-after-hook 'helm-ff--update-resume-after-hook) + (unwind-protect + (helm :sources '(helm-source-find-files helm-find-files-dummy-source) + :input fname + :case-fold-search helm-file-name-case-fold-search + :preselect preselect + :ff-transformer-show-only-basename + helm-ff-transformer-show-only-basename + :dim-prompt-on-update helm-ff-dim-prompt-on-update + :default def + :prompt "Find files or url: " + :buffer "*helm find files*") + (helm-ff--update-resume-after-hook nil t) + (setq helm-ff-default-directory nil) + (advice-remove 'x-dnd-handle-drag-n-drop-event 'helm-ff--restore-frame)))) + +(defvar helm-find-files-dummy-source + (helm-build-dummy-source "New file or directory" + :filtered-candidate-transformer + (lambda (_candidates _source) + ;; Unquote helm-pattern maybe quoted by PA. + (unless (file-exists-p (replace-regexp-in-string "\\s\\" "" helm-pattern)) + (list (helm-ff-filter-candidate-one-by-one helm-pattern nil t)))) + :all-marked t + :keymap 'helm-find-files-map + :action 'helm-find-files-actions + :action-transformer 'helm-find-files-dummy-action-transformer)) + +(defun helm-find-files-dummy-action-transformer (actions candidate) + "Action transformer for `helm-find-files-dummy-source'." + (let (cand-no-linum linum) + (cond ((and helm--url-regexp + (not (string-match-p helm--url-regexp candidate)) + (string-match "\\(:[[:digit:]]+:?\\)\\'" candidate) + (file-exists-p + (setq cand-no-linum (replace-match "" t t candidate 1)))) + (setq linum (replace-regexp-in-string + ":" "" (match-string 1 candidate))) + (helm-append-at-nth + actions + `(("Find file to line number" + . ,(lambda (_candidate) + (find-file cand-no-linum) + (helm-goto-line (string-to-number linum) t)))) + 1)) + (t actions)))) + +(defun helm-ff--update-resume-after-hook (sources &optional nohook) + "Meant to be used in `helm-resume-after-hook'. +When NOHOOK is non-nil run inconditionally, otherwise only when +source is `helm-source-find-files'." + ;; When using the action `helm-find-files-load-files' on helm-files.el, + ;; `helm-source-find-files' is reseted to nil hence error when calling + ;; `helm-set-attr' outside helm => "no buffer named *helm*". + (unless helm-source-find-files + (setq helm-source-find-files (helm-make-source + "Find Files" 'helm-source-ffiles))) + (when (or nohook (string= "Find Files" + (assoc-default 'name (car sources)))) + (helm-set-attr 'resume `(lambda () + (helm-ff-setup-update-hook) + (setq helm-ff-default-directory + ,helm-ff-default-directory + helm-ff-last-expanded + ,helm-ff-last-expanded)) + helm-source-find-files))) + +(defun helm-ff-clean-initial-input () + ;; When using hff in an external frame initial input is printed in + ;; the minibuffer of initial-frame, delete it. + (with-selected-frame helm-initial-frame + (helm-clean-up-minibuffer))) + +(defun helm-ff-setup-update-hook () + (dolist (hook '(helm-ff-clean-initial-input ; Add to be called first. + helm-ff-update-when-only-one-matched + helm-ff-auto-expand-to-home-or-root)) + (add-hook 'helm-after-update-hook hook))) + +(defun helm-find-files-cleanup () + (mapc (lambda (hook) + (remove-hook 'helm-after-update-hook hook)) + '(helm-ff-auto-expand-to-home-or-root + helm-ff-update-when-only-one-matched + helm-ff-clean-initial-input)) + (maphash (lambda (k _v) + (when (member k helm-ff--thumbnailed-directories) + (remhash k helm-ff--list-directory-cache))) + helm-ff--list-directory-cache) + (setq helm-ff--show-directories-only nil + helm-ff--show-files-only nil + helm-ff--show-thumbnails nil + helm-ff--thumbnailed-directories nil) + (helm-ff-clean-image-cache)) + +(defun helm-ff-bookmark () + (helm :sources 'helm-source-bookmark-helm-find-files + :buffer "*helm ff bookmarks*")) + +(defun helm-find-files-switch-to-bookmark () + "Switch to helm-bookmark for `helm-find-files' from `helm-find-files.'" + (interactive) + (require 'helm-bookmark) + (with-helm-alive-p + (helm-run-after-exit 'helm-ff-bookmark))) +(put 'helm-find-files-switch-to-bookmark 'helm-only t) + +(defun helm-ff-bookmark-insert-location () + "Insert helm-find-files bookmark in minibuffer." + (interactive) + (require 'helm-bookmark) + (with-helm-alive-p + (helm :sources (helm-bookmark-build-source + "bookmark insert location" + 'helm-bookmark-helm-find-files-setup-alist + 'helm-source-in-buffer + :filtered-candidate-transformer + '(helm-adaptive-sort + helm-highlight-bookmark) + :action (lambda (candidate) + (with-selected-window (minibuffer-window) + (delete-minibuffer-contents) + (bookmark-insert-location candidate)))) + :buffer "*helm bookmark insert*" + :allow-nest t))) +(put 'helm-ff-bookmark-insert-location 'helm-only t) + +(defun helm-find-files-initial-input (&optional input) + "Return INPUT if present, otherwise try to guess it." + (let ((guesser (helm-acase (helm-ffap-guesser) + ("" nil) + (t it)))) + (unless (eq major-mode 'image-mode) + (if input + (if (or (file-remote-p input) + (string-match helm-ff-url-regexp input)) + input + (expand-file-name input)) + (helm-find-files-input + (if (and helm-ff-allow-non-existing-file-at-point + guesser + (not (string-match ffap-url-regexp guesser))) + ;; Keep the ability of jumping to numbered lines even + ;; when allowing non existing filenames at point. + (helm-aand guesser + (thing-at-point 'filename) + (replace-regexp-in-string + ":[0-9]+\\'" "" it)) + guesser) + (thing-at-point 'filename)))))) + +(defun helm-ffap-guesser () + "Same as `ffap-guesser' but without gopher and machine support." + (require 'ffap) + ;; Avoid "Stack overflow in regexp matcher" error + ;; in evil `ffap-guesser' by removing crap `ffap-gopher-at-point' + ;; (bug fixed in emacs-26 http://debbugs.gnu.org/cgi/bugreport.cgi?bug=25391) . + ;; `ffap-machine-at-point' have been removed too as it was anyway + ;; disabled with `ffap-machine-p-known' bound to 'reject. + ;; `ffap-file-at-point' can be neutralized with + ;; `helm-ff-guess-ffap-filenames' and `ffap-url-at-point' with + ;; `helm-ff-guess-ffap-urls' + ;; Note also that `ffap-url-unwrap-remote' can override these + ;; variables. + (let ((ffap-alist (and helm-ff-guess-ffap-filenames ffap-alist)) + (ffap-url-regexp helm--url-regexp)) + (if (eq major-mode 'dired-mode) + (let ((beg (save-excursion (dired-move-to-filename))) + (end (save-excursion (dired-move-to-end-of-filename t)))) + (helm-aif (and beg end (member (buffer-substring beg end) + '("." ".."))) + (concat (file-name-as-directory + (expand-file-name dired-directory)) + (car it)) + (dired-get-filename 'no-dir t))) + (let* ((beg (and (use-region-p) (region-beginning))) + (end (and (use-region-p) (region-end))) + (str (and beg end (buffer-substring-no-properties beg end))) + (ffap (or (helm-aand helm-ff-guess-ffap-urls ffap-url-regexp + (ffap-url-at-point) + (ffap-fixup-url it) + (and (string-match ffap-url-regexp it) it)) + (and helm-ff-guess-ffap-urls ffap-url-regexp + (fboundp 'ffap-fixup-email) ; Emacs-30 + (ffap-fixup-email (thing-at-point 'email))) + (ffap-file-at-point)))) + ;; Workaround emacs bugs: + ;; When the region is active and a file is detected + ;; `ffap-string-at-point' returns the region prefixed with + ;; "/", e.g. at a beginning of a patch (first bug) and make + ;; `file-remote-p' returning an error (second bug), so in such + ;; case returns the region itself instead of the region + ;; corrupted by ffap. + (if (and str ffap) str ffap))))) + +(defun helm-find-files-input (file-at-pt thing-at-pt) + "Try to guess a default input for `helm-find-files'." + (let* ((non-essential t) + (remp (or (and file-at-pt (file-remote-p file-at-pt)) + (and thing-at-pt (file-remote-p thing-at-pt)))) + (def-dir (helm-current-directory)) + (urlp (and file-at-pt helm--url-regexp + (string-match helm--url-regexp file-at-pt))) + (lib (when helm-ff-search-library-in-sexp + (helm-find-library-at-point))) + (hlink (helm-ff-find-url-at-point)) + (file-p (and file-at-pt + (not (string= file-at-pt "")) + (not remp) + (or (file-exists-p file-at-pt) + helm-ff-allow-non-existing-file-at-point) + (not urlp) + thing-at-pt + (not (string= thing-at-pt "")) + (file-exists-p + (file-name-directory + (expand-file-name thing-at-pt def-dir)))))) + (cond (lib) ; e.g we are inside a require sexp. + (hlink) ; String at point is an hyperlink. + (file-p ; a regular file + (and file-at-pt (if (not (member (helm-basename file-at-pt) + '("." ".."))) + (expand-file-name file-at-pt) + file-at-pt))) + (urlp (helm-html-decode-entities-string file-at-pt)) ; possibly an url or email. + ((and file-at-pt + (not remp) + (or helm-ff-allow-non-existing-file-at-point + (file-exists-p file-at-pt))) + (expand-file-name file-at-pt))))) + +(defun helm-ff-find-url-at-point () + "Try to find link to an url in text-property at point." + (let* ((he (get-text-property (point) 'help-echo)) + (ov (overlays-at (point))) + (ov-he (and ov (overlay-get + (car (overlays-at (point))) 'help-echo))) + (w3m-l (get-text-property (point) 'w3m-href-anchor)) + (nt-prop (get-text-property (point) 'nt-link))) + ;; Org link. + (when (and (stringp he) (string-match "^LINK: " he)) + (setq he (replace-match "" t t he))) + (cl-loop for i in (list he ov-he w3m-l nt-prop) + thereis (and (stringp i) helm--url-regexp (string-match helm--url-regexp i) i)))) + +(defun helm-find-library-at-point () + "Try to find library path at point. +Find inside `require' and `declare-function' sexp." + (require 'find-func) + (let* ((beg-sexp (save-excursion (search-backward "(" (pos-bol) t))) + (end-sexp (save-excursion (ignore-errors (end-of-defun)) (point))) + (sexp (and beg-sexp end-sexp + (buffer-substring-no-properties + (1+ beg-sexp) (1- end-sexp))))) + (ignore-errors + (cond (;; Should work only when point is on the use-package line + ;; i.e. first line of sexp otherwise it prevents matching + ;; urls with helm-find-files (bug #2469). + (and sexp (string-match "use-package +\\([^ )\n]+\\)" sexp)) + (find-library-name (match-string 1 sexp))) + ((and sexp (string-match "require +[']\\([^ )]+\\)" sexp)) + ;; If require use third arg, ignore it, + ;; always use library path found in `load-path'. + (find-library-name (match-string 1 sexp))) + ;; Assume declare-function sexps are on one line. + ((and sexp (string-match "declare-function .+? \"\\(?:ext:\\)?\\([^ )]+\\)\"" sexp)) + (find-library-name (match-string 1 sexp))) + (t nil))))) + + +;;; Handle copy, rename, symlink, relsymlink and hardlink from helm. +;; +;; +(defun helm-ff--valid-default-directory () + (with-helm-current-buffer + (cl-loop for b in (buffer-list) + for cd = (with-current-buffer b default-directory) + when (eq (car (file-attributes cd)) t) + return cd))) + +(cl-defun helm-dired-action (destination + &key action follow (files (dired-get-marked-files))) + "Execute ACTION on FILES to DESTINATION. +Where ACTION is a symbol that can be one of: +\\='copy', \\='rename', \\='symlink', \\='relsymlink', \\='hardlink' or \\='backup'. +Argument FOLLOW when non-nil specifies to follow FILES to +DESTINATION for the actions copy and rename." + (require 'dired-async) + (require 'dired-x) ; For dired-keep-marker-relsymlink + (when (get-buffer dired-log-buffer) (kill-buffer dired-log-buffer)) + ;; When default-directory in current-buffer is an invalid directory, + ;; (e.g buffer-file directory have been renamed somewhere else) + ;; be sure to use a valid value to give to dired-create-file. + ;; i.e start-process is creating a process buffer based on default-directory. + (let ((default-directory (helm-ff--valid-default-directory)) + (fn (cl-case action + (copy 'dired-copy-file) + (rename 'dired-rename-file) + (symlink 'make-symbolic-link) + (relsymlink 'dired-make-relative-symlink) + (hardlink 'dired-hardlink) + (backup 'backup-file))) + (marker (cl-case action + ((copy rename backup) dired-keep-marker-copy) + (symlink dired-keep-marker-symlink) + (relsymlink dired-keep-marker-relsymlink) + (hardlink dired-keep-marker-hardlink))) + (dirflag (and (= (length files) 1) + (file-directory-p (car files)) + (not (file-directory-p destination)))) + (dired-async-state (if (and (boundp 'dired-async-mode) + dired-async-mode) + 1 -1))) + (and follow (fboundp 'dired-async-mode) (dired-async-mode -1)) + ;; When dired-create-destination-dirs is available (emacs-27.1+) such error + ;; is handled later in dired-create-files. + (when (and (null (boundp 'dired-create-destination-dirs)) + (cdr files) (not (file-directory-p destination))) + (error "%s: target `%s' is not a directory" action destination)) + (unwind-protect + (dired-create-files + fn (symbol-name action) files + (if (file-directory-p destination) + ;; When DESTINATION is a directory, build file-name in this directory. + ;; Else we use DESTINATION. + (lambda (from) + (expand-file-name (file-name-nondirectory from) destination)) + (lambda (_from) destination)) + marker) + (and (fboundp 'dired-async-mode) + (dired-async-mode dired-async-state))) + (push (file-name-as-directory + (if (file-directory-p destination) + (expand-file-name destination) + (file-name-directory destination))) + helm-ff-history) + ;; If follow is non--nil we should not be in async mode. + (when (and follow + (not (memq action '(symlink relsymlink hardlink))) + (not (get-buffer dired-log-buffer))) + (let ((target (directory-file-name destination)) + (cands-to-mark (helm-get-dest-fnames-from-list files destination dirflag))) + (with-helm-after-update-hook (helm-ff-maybe-mark-candidates cands-to-mark)) + ;; Wait for the notify callback ends before calling HFF. + (run-at-time + 0.1 nil + (lambda () + (if (and dirflag (eq action 'rename)) + (helm-find-files-1 (file-name-directory target) + (format helm-ff-last-expanded-candidate-regexp + (if helm-ff-transformer-show-only-basename + (helm-basename target) target))) + (helm-find-files-1 (if (file-directory-p destination) + (file-name-as-directory + (expand-file-name destination)) + (expand-file-name (helm-basedir destination))) + (format helm-ff-last-expanded-candidate-regexp + (if helm-ff-transformer-show-only-basename + (helm-basename (car files)) + (car files))))))))))) + +(defun helm-get-dest-fnames-from-list (flist dest-cand rename-dir-flag) + "Transform filenames of FLIST to abs of DEST-CAND. +If RENAME-DIR-FLAG is non-nil collect the `directory-file-name' +of transformed members of FLIST." + ;; At this point files have been renamed/copied at destination. + ;; That's mean DEST-CAND exists. + (cl-loop + with dest = (expand-file-name dest-cand) + for src in flist + for basename-src = (helm-basename src) + for fname = (cond (rename-dir-flag (directory-file-name dest)) + ((file-directory-p dest) + (concat (file-name-as-directory dest) basename-src)) + (t dest)) + when (file-exists-p fname) + collect fname into tmp-list + finally return (sort tmp-list 'string<))) + +(defun helm-ff-maybe-mark-candidates (seq) + "Add visible mark to all candidates in SEQ. +This is used when copying/renaming/symlinking etc. and following +files to destination." + (when (and (string= (assoc-default 'name (helm-get-current-source)) + (assoc-default 'name helm-source-find-files)) + seq) + (with-helm-window + (while seq + (if (string= (car seq) (helm-get-selection)) + (progn + (helm-make-visible-mark) + (helm-next-line) + (setq seq (cdr seq))) + (helm-next-line))) + (unless (helm-this-visible-mark) + (helm-prev-visible-mark))))) + + +;;; Compress/uncompress files +;; +;; +(define-minor-mode helm-ff--compress-async-modeline-mode + "Notify mode-line that an async process run." + :group 'dired-async + :global t + :lighter (:eval (propertize (format " [%s async job (Un)compressing file(s)]" + (length (dired-async-processes + 'helm-async-compress))) + 'face 'helm-delete-async-message)) + (unless helm-ff--compress-async-modeline-mode + (let ((visible-bell t)) (ding)))) + +(defun helm-do-compress-to (ifiles ofile) + "Compress IFILES files/directories to the OFILE archive. +Choose the archiving command based on the OFILE extension +and `dired-compress-files-alist'." + (let ((cmd (cl-loop for (r . c) in dired-compress-files-alist + when (string-match r ofile) return c)) + (error-file (expand-file-name + "dired-shell-command-output" temporary-file-directory))) + (cl-assert + cmd nil + "No compression rule found for %s, see `dired-compress-files-alist'" ofile) + (when (and (file-exists-p ofile) + (not (y-or-n-p + (format "%s exists, overwrite?" + (abbreviate-file-name ofile))))) + (message "Compression aborted")) + (message "Compressing %d file(s) to `%s'..." + (length ifiles) (helm-basename ofile)) + (process-put + (async-start + `(lambda () + (require 'cl-lib) + (require 'dired-aux) + (let* ((default-directory + (cl-loop with base = (car ',ifiles) + for file in ',ifiles + do (setq base (fill-common-string-prefix base file)) + finally return (file-name-directory base))) + (local-name (shell-quote-argument (file-local-name ,ofile))) + (input (mapconcat + (lambda (in-file) + (shell-quote-argument (file-relative-name in-file))) + ',ifiles " ")) + process-status) + (when (not (zerop + (setq process-status + (dired-shell-command + (format-spec ,cmd `((?o . ,local-name) (?i . ,input))))))) + (let ((error-output (with-current-buffer " *dired-check-process output*" + (buffer-string)))) + (with-temp-file ,error-file + (insert error-output)))) + process-status)) + (lambda (result) + (unless (dired-async-processes 'helm-async-compress) + (helm-ff--compress-async-modeline-mode -1)) + (if (zerop result) ; dired-shell-command succeed. + (progn + (message "Compressed %d file(s) to `%s' done" + (length ifiles) + (file-name-nondirectory ofile)) + (run-with-timer + 0.1 nil + (lambda (flist dest) + (dired-async-mode-line-message + "%s %d file(s) to %s done" + 'helm-delete-async-message + "Compressing" + (length flist) (helm-basename dest))) + ifiles ofile)) + (when (file-exists-p error-file) + (pop-to-buffer (find-file-noselect error-file)))))) + 'helm-async-compress t) + (helm-ff--compress-async-modeline-mode 1))) + +(defun helm-ff--dired-compress-file (file) + ;; `dired-compress-file' doesn't take care of binding `default-directory' when + ;; uncompressing FILE, as a result FILE is uncompressed in the directory where + ;; helm was started i.e. the current value of `default-directory'. + (with-helm-default-directory helm-ff-default-directory + (dired-compress-file file))) + +(defun helm-ff-quick-compress (_candidate) + "Compress or uncompress marked files without quitting." + (with-helm-window + (let (cfile) + (unwind-protect + (helm-read-answer-dolist-with-action + "Compress or uncompress file `%s'? " + (helm-marked-candidates) + (lambda (c) + (setq cfile (save-selected-window + (helm-ff--dired-compress-file c))) + (message nil) + (helm--remove-marked-and-update-mode-line c)) + #'abbreviate-file-name) + (setq helm-marked-candidates nil + helm-visible-mark-overlays nil) + (helm-force-update + (let ((presel (helm-get-selection))) + ;; FIXME: Probably this would never happen, I see no cases here where + ;; helm-get-selection doesn't exist. + (unless (file-exists-p presel) + (setq presel cfile)) + (when presel + (format helm-ff-last-expanded-candidate-regexp + (regexp-quote + (if (and helm-ff-transformer-show-only-basename + (not (helm-ff-dot-file-p presel))) + (helm-basename presel) presel)))))))))) + +(helm-make-persistent-command-from-action helm-ff-persistent-compress + "Compress or uncompress marked candidates without quitting." + 'quick-compress 'helm-ff-quick-compress) + +;;; Delete and trash files +;; +;; +(defun helm-file-buffers (filename) + "Return a list of buffer names corresponding to FILENAME." + (cl-loop with name = (expand-file-name filename) + for buf in (buffer-list) + for bfn = (buffer-file-name buf) + when (and bfn (string= name bfn)) + collect (buffer-name buf))) + +(defun helm-ff--delete-by-moving-to-trash (file) + "Decide to trash or delete FILE. +Return non-nil when FILE needs to be trashed." + (let ((remote (file-remote-p file))) + (or + (and delete-by-moving-to-trash + (null helm-current-prefix-arg) + (null current-prefix-arg) + (or (and remote helm-trash-remote-files) + (null remote))) + (and (null delete-by-moving-to-trash) + (or helm-current-prefix-arg + current-prefix-arg) + (or (and remote helm-trash-remote-files) + (null remote)))))) + +(defun helm-trash-directory () + "Try to find a trash directory. +Return the \"files\" subdirectory of trash directory. +When `helm-trash-default-directory' is set use it as trash directory." + (let* ((xdg-data-dir + (or helm-trash-default-directory + (directory-file-name + (expand-file-name "Trash" + (or (getenv "XDG_DATA_HOME") + "~/.local/share"))))) + (trash-files-dir (expand-file-name "files" xdg-data-dir))) + ;; Just return nil if the Trash directory is not yet created. It will be + ;; created later by `delete-directory'. + (and (file-exists-p trash-files-dir) trash-files-dir))) + +(cl-defun helm-ff-file-already-trashed (file &optional (trash-alist nil strash-alist)) + "Return FILE when it is already in trash. + +Optional arg TRASH-ALIST should be an alist as what +`helm-ff-trash-list' returns." + (unless (or (fboundp 'system-move-file-to-trash) + (and strash-alist (null trash-alist))) + (let ((trash-files-dir (helm-trash-directory))) + (cl-loop for (_bn . fn) in (or trash-alist + (helm-ff-trash-list trash-files-dir)) + thereis (and (file-equal-p file fn) file))))) + +(defun helm-ff-quick-delete (_candidate) + "Delete file CANDIDATE without quitting. + +When a prefix arg is given, meaning of +`delete-by-moving-to-trash' is the opposite." + (with-helm-window + (let* ((marked (helm-marked-candidates)) + (trash (helm-ff--delete-by-moving-to-trash (car marked))) + (old--allow-recursive-deletes helm-ff-allow-recursive-deletes) + (buffers '())) + (unwind-protect + (progn + (helm-read-answer-dolist-with-action + "Really %s file `%s'" + marked + (lambda (file) + (helm-ff--quick-delete-action file trash) + (setq buffers (append (helm-file-buffers file)))) + (list (if trash "Trash" "Delete") #'abbreviate-file-name)) + (when buffers + (helm-read-answer-dolist-with-action + "Kill buffer `%s', too? " + buffers #'kill-buffer))) + (setq helm-marked-candidates nil + helm-visible-mark-overlays nil) + (helm-force-update + (let ((presel (helm-get-selection))) + (when presel + (format helm-ff-last-expanded-candidate-regexp + (regexp-quote (if (and helm-ff-transformer-show-only-basename + (not (helm-ff-dot-file-p presel))) + (helm-basename presel) presel)))))) + (setq helm-ff-allow-recursive-deletes old--allow-recursive-deletes))))) + +(defun helm-ff--quick-delete-action (candidate trash) + "Delete or trash CANDIDATE and remove it from display." + (helm-preselect + (format helm-ff-last-expanded-candidate-regexp + (regexp-quote + (if (and helm-ff-transformer-show-only-basename + (not (helm-ff-dot-file-p candidate))) + (helm-basename candidate) candidate)))) + (helm-acase (helm-delete-file + candidate helm-ff-signal-error-on-dot-files + trash) + (skip + ;; This happens only when trying to + ;; trash a file already trashed. + (helm-delete-visible-mark (helm-this-visible-mark)) + (if (helm-end-of-source-p) + (helm-previous-line) + (helm-next-line))) + (t (helm-delete-current-selection))) + (message nil) + (helm--remove-marked-and-update-mode-line candidate)) + +(defun helm-delete-file (file &optional error-if-dot-file-p trash) + "Delete FILE after querying the user. + +When a prefix arg is given, meaning of +`delete-by-moving-to-trash' is the opposite. + +Return error when ERROR-IF-DOT-FILE-P is non-nil and user tries +to delete a dotted file i.e. \".\" or \"..\". + +Ask user when directory are not empty to allow recursive deletion +unless `helm-ff-allow-recursive-deletes' is non nil. +When user is asked and reply with \"!\" don't ask for remaining +directories. + +Ask to kill buffers associated with that file, too. + +When TRASH is non nil, trash FILE even if `delete-by-moving-to-trash' +is nil." + (require 'dired) + (cl-block nil + (when (and error-if-dot-file-p + (helm-ff-dot-file-p file)) + (error "Error: Cannot operate on `.' or `..'")) + (let ((helm--reading-passwd-or-string t) + (file-attrs (file-attributes file)) + (trash (or trash (helm-ff--delete-by-moving-to-trash file))) + (delete-by-moving-to-trash trash)) + (cond ((and (eq (nth 0 file-attrs) t) ; a not empty directory. + (directory-files file t directory-files-no-dot-files-regexp)) + (if (or helm-ff-allow-recursive-deletes trash) + (delete-directory file 'recursive trash) + (helm-acase (helm-read-answer + (format "Recursive delete of `%s'? [y,n,!,q,h]" + (abbreviate-file-name file)) + '("y" "n" "!" "q") + #'helm-read-answer-default-help-fn) + ("y" (delete-directory file 'recursive trash)) + ("!" (setq helm-ff-allow-recursive-deletes t) + (delete-directory file 'recursive trash)) + ("n" (cl-return 'skip)) + ("q" (throw 'helm-abort-delete-file + (progn + (message "Abort file deletion") (sleep-for 1))))))) + ((eq (nth 0 file-attrs) t) ; a directory. + (delete-directory file nil trash)) + (t (delete-file file trash)))))) + +(defun helm-delete-marked-files (_ignore) + "Delete marked files with `helm-delete-file'. + +When a prefix arg is given, meaning of +`delete-by-moving-to-trash' is the opposite." + (let* ((files (helm-marked-candidates :with-wildcard t)) + (len 0) + (trash (helm-ff--delete-by-moving-to-trash (car files))) + (prmt (if trash "Trash" "Delete")) + (old--allow-recursive-deletes helm-ff-allow-recursive-deletes) + (buffers (cl-loop for f in files + append (helm-file-buffers f)))) + (with-helm-display-marked-candidates + helm-marked-buffer-name + (helm-ff--count-and-collect-dups files) + (if (not (y-or-n-p (format "%s *%s File(s)" prmt (length files)))) + (message "(No deletions performed)") + (catch 'helm-abort-delete-file + (unwind-protect + (progn + (dolist (i files) + (set-text-properties 0 (length i) nil i) + (let ((res (helm-delete-file + i helm-ff-signal-error-on-dot-files trash))) + (if (eq res 'skip) + (progn (message "Directory is not empty, skipping") + (sleep-for 1)) + (cl-incf len)))) + (when buffers + (helm-read-answer-dolist-with-action + "Kill buffer `%s', too? " + buffers #'kill-buffer))) + (setq helm-ff-allow-recursive-deletes old--allow-recursive-deletes))) + (message "%s File(s) %s" len (if trash "trashed" "deleted")))))) + +;;; Delete files async +;; +;; +(defvar helm-ff-delete-log-file + (locate-user-emacs-file "helm-delete-file.log") + "The file use to communicate with Emacs child when deleting files async.") + +(defvar helm-ff--trash-flag nil) + +(define-minor-mode helm-ff--delete-async-modeline-mode + "Notify mode-line that an async process run." + :group 'dired-async + :global t + :lighter (:eval (propertize (format " %s file(s) async [%s job]..." + (if helm-ff--trash-flag + "Trashing" "Deleting") + (length (dired-async-processes + 'helm-delete-async))) + 'face 'helm-delete-async-message)) + (unless helm-ff--delete-async-modeline-mode + (let ((visible-bell t)) (ding)) + (setq helm-ff--trash-flag nil))) + +(defalias 'helm-delete-async-mode-line-message 'dired-async-mode-line-message) +(make-obsolete 'helm-delete-async-mode-line-message + 'dired-async-mode-line-message "3.9.8") + +(defun helm-delete-async-kill-process () + "Kill async process created by helm delete files async." + (interactive) + (let* ((processes (dired-async-processes)) + (proc (car (last processes)))) + (and proc (delete-process proc)) + (unless (> (length processes) 1) + (helm-ff--delete-async-modeline-mode -1)))) + +(defun helm-delete-marked-files-async (_ignore) + "Same as `helm-delete-marked-files' but async. + +When a prefix arg is given, meaning of +`delete-by-moving-to-trash' is the opposite. + +This function is not using `helm-delete-file' and BTW not asking +user for recursive deletion of directory, be warned that +directories are always deleted with no warnings." + (let* ((files (helm-marked-candidates :with-wildcard t)) + (trash (helm-ff--delete-by-moving-to-trash (car files))) + (prmt (if trash "Trash" "Delete")) + buffers callback + ;; Workaround emacs-26 bug with tramp see + ;; https://github.com/jwiegley/emacs-async/issues/80. + (async-quiet-switch "-q")) + (cl-loop for f in files + for buf = (helm-file-buffers f) + for dot-file-p = (helm-ff-dot-file-p f) + when (and helm-ff-signal-error-on-dot-files + dot-file-p) + do (cl-return (error "Error: Cannot operate on `.' or `..'")) + when buf + do (setq buffers (nconc buf buffers))) + (setq callback (lambda (result) + (unless (dired-async-processes 'helm-delete-async) + (helm-ff--delete-async-modeline-mode -1)) + (when (file-exists-p helm-ff-delete-log-file) + (display-warning 'helm + (with-temp-buffer + (insert-file-contents + helm-ff-delete-log-file) + (buffer-string)) + :error + "*helm delete files*") + (fit-window-to-buffer (get-buffer-window + "*helm delete files*")) + (delete-file helm-ff-delete-log-file)) + (when buffers + (helm-read-answer-dolist-with-action + "Kill buffer `%s', too? " + buffers #'kill-buffer)) + (run-with-timer + 0.1 nil + (lambda () + (dired-async-mode-line-message + "%s (%s/%s) file(s) async done" + 'helm-delete-async-message + (if trash "Trashing" "Deleting") + result (length files)))))) + (setq helm-ff--trash-flag trash) + (with-helm-display-marked-candidates + helm-marked-buffer-name + (helm-ff--count-and-collect-dups files) + (if (not (y-or-n-p (format "%s *%s File(s)" prmt (length files)))) + (message "(No deletions performed)") + (process-put + (async-start + `(lambda () + (require 'cl-lib) + ;; `delete-by-moving-to-trash' have to be set globally, + ;; using the TRASH argument of delete-file or + ;; delete-directory is not enough. + (setq delete-by-moving-to-trash ,trash) + (let ((result 0)) + (dolist (file ',files result) + (condition-case err + (cond ((eq (nth 0 (file-attributes file)) t) + (delete-directory file 'recursive ,trash) + (setq result (1+ result))) + (t (delete-file file ,trash) + (setq result (1+ result)))) + (error (with-temp-file ,helm-ff-delete-log-file + (insert (format-time-string "%x:%H:%M:%S\n")) + (insert (format "%S\n " err)))))))) + callback) + 'helm-delete-async t) + (helm-ff--delete-async-modeline-mode 1))))) + +(defun helm-find-file-or-marked (candidate) + "Open file CANDIDATE or open helm marked files in separate windows. +Called with one prefix arg open files in separate windows in a +vertical split. +Called with two prefix arg open files in background without +selecting them." + (let ((marked (helm-marked-candidates :with-wildcard t)) + (url-p (and helm--url-regexp ; we should have only one candidate. + (string-match helm--url-regexp candidate))) + (ffap-newfile-prompt helm-ff-newfile-prompt-p) + (find-file-wildcards nil) + (helm--reading-passwd-or-string t)) + (if (cdr marked) + (if (equal helm-current-prefix-arg '(16)) + (mapc 'find-file-noselect marked) + ;; If helm-current-prefix-arg is detected split is done + ;; vertically. + (helm-window-show-buffers (mapcar 'find-file-noselect marked))) + (let ((dir (and (not url-p) (helm-basedir candidate)))) + (cond ((and dir (file-directory-p dir)) + (find-file (substitute-in-file-name candidate))) + (url-p (find-file-at-point candidate)) + ;; A a non--existing filename ending with / + ;; Create a directory and jump to it. + ((and (not (file-exists-p candidate)) + (string-match "/$" candidate)) + (helm-ff--mkdir candidate 'helm-ff)) + ;; A non--existing filename NOT ending with / or + ;; an existing filename, create or jump to it. + ;; If the basedir of candidate doesn't exists, + ;; ask for creating it. + (dir + (helm-ff--mkdir dir) + (find-file candidate)) + ;; Find file at `default-directory' when basedir is + ;; unspecified e.g user hit C-k foo RET. + (t (find-file candidate))))))) + +(defun helm-ff-find-file-other-tab (_candidate) + "Display marked files in a new tab. +See `helm-buffers-switch-buffers-in-tab-1' for more infos." + (helm-buffers-switch-buffers-in-tab-1 + (mapcar 'find-file-noselect (helm-marked-candidates)))) + +(helm-make-command-from-action helm-ff-run-find-file-other-tab + "Run find file in other tab action from `helm-find-files'." + 'helm-ff-find-file-other-tab + (cl-assert (fboundp 'tab-bar-mode) nil "Tab-bar-mode not available")) + +(defun helm-ff--new-dirs-to-update (path) + "Collect directories to update when creating new directory PATH." + (let ((result (list path))) + (helm-awhile (helm-reduce-file-name path 1) + (if (not (file-directory-p it)) + (progn (push it result) (setq path it)) + (push it result) + (cl-return))) + result)) + +(defun helm-ff--mkdir (dir &optional helm-ff) + (when (or (not confirm-nonexistent-file-or-buffer) + (y-or-n-p (format "Create directory `%s'? " + (abbreviate-file-name + (expand-file-name dir))))) + (let ((dirfname (directory-file-name dir)) + (to-update (and helm-ff (helm-ff--new-dirs-to-update dir)))) + (if (file-exists-p dirfname) + (error + "Mkdir: Unable to create directory `%s': file exists." + (helm-basename dirfname)) + (make-directory dir 'parent)) + (when helm-ff + ;; Refresh cache. + (mapc (lambda (x) (helm-ff-directory-files x t)) to-update) + ;; Allow having this new dir in history + ;; to be able to retrieve it immediately + ;; if we want to e.g copy a file from somewhere in it. + (setq helm-ff-default-directory + (file-name-as-directory (expand-file-name dir))) + (push helm-ff-default-directory helm-ff-history)) + (or (and helm-ff (helm-find-files-1 dir)) t)))) + +(defun helm-transform-file-load-el (actions candidate) + "Add action to load the file CANDIDATE if it is an Emacs Lisp +file. Else return ACTIONS unmodified." + (if (member (file-name-extension candidate) '("el" "elc")) + (append actions '(("Load Emacs Lisp File" . load-file))) + actions)) + +(defun helm-transform-file-browse-url (actions candidate) + "Add an action to browse the file CANDIDATE if it is a HTML file or URL. +Else return ACTIONS unmodified." + (let ((browse-action '("Browse with Browser" . browse-url))) + (cond ((string-match "^http\\|^ftp" candidate) + (cons browse-action actions)) + ((string-match "\\.html?$" candidate) + (append actions (list browse-action))) + (t actions)))) + +(defun helm-file-on-mounted-network-p (file) + "Return non-nil when FILE is part of a mounted remote directory. + +This function is checking `helm-mounted-network-directories' +list." + (when helm-mounted-network-directories + (cl-loop for dir in helm-mounted-network-directories + thereis (file-in-directory-p file dir)))) + +;; helm-find-files bindings for filecache +(defvar file-cache-alist) + +(defun helm-ff-cache-add-file (_candidate) + (require 'filecache) + (let ((mkd (helm-marked-candidates :with-wildcard t))) + (mapc 'file-cache-add-file mkd))) + +(defun helm-ff-file-cache-remove-file-1 (file) + "Remove FILE from `file-cache-alist'." + (let ((entry (assoc (helm-basename file) file-cache-alist)) + (dir (helm-basedir file)) + new-entry) + (setq new-entry (remove dir entry)) + (when (= (length entry) 1) + (setq new-entry nil)) + (setq file-cache-alist + (cons new-entry (remove entry file-cache-alist))))) + +(defun helm-ff-file-cache-remove-file (_file) + "Remove marked files from `file-cache-alist.'" + (let ((mkd (helm-marked-candidates))) + (mapc 'helm-ff-file-cache-remove-file-1 mkd))) + +;;; Find files in file +;; +;; +(defclass helm-find-files-in-file-class (helm-source-in-file helm-type-file) ()) +(cl-defmethod helm--setup-source ((source helm-find-files-in-file-class)) + (helm-aif (slot-value source 'candidate-transformer) + (setf (slot-value source 'candidate-transformer) + (append (helm-mklist it) + `(,(lambda (candidates) + (cl-loop for c in candidates + when (and (not (string= c "")) + (file-exists-p c)) + collect c))))))) + +(defun helm-find-files-in-file-build-source (file) + (helm-make-source + (format "Find files in `%s'" (helm-basename file)) + 'helm-find-files-in-file-class + :candidates-file file)) + +(defun helm-find-files-in-file (_file) + "Helm action for listing filenames listed in marked files." + (require 'helm-for-files) + (let ((sources (cl-loop for f in (helm-marked-candidates) + collect (helm-find-files-in-file-build-source f)))) + (helm :sources sources + :quit-if-no-candidate (lambda () + (message "No files found in file(s)")) + :buffer "*helm find files in files*"))) + +(cl-defun helm-ff-mcp (_candidate) + "Copy the car of marked candidates to the remaining marked candidates. + +The car of marked should be a regular file and the rest of marked (cdr) should +be existing directories." + (let* ((mkd (helm-marked-candidates)) + (file (car mkd)) + (targets (cdr mkd)) + (skipped 0) + operations) + (cl-assert (file-regular-p file) nil (format "ERROR: Not a regular file `%s'" file)) + (cl-assert targets nil (format "ERROR: No destination specified for file `%s'" file)) + (cl-assert (cl-loop for f in targets always (file-directory-p f)) nil + "ERROR: Destinations must be existing directories") + (when targets + (cl-loop with yes-for-all + for dest in targets + for dest-file = (expand-file-name (helm-basename file) dest) + for dir-ok = (file-accessible-directory-p dest) + for exists = (and dir-ok + (file-exists-p + (expand-file-name + (helm-basename file) dest))) + for overwrite = (or (null exists) + yes-for-all + (helm-acase (helm-read-answer + (format + "File `%s' already-exists, overwrite (y,n,!,q) ? " + dest-file) + '("y" "n" "!" "q")) + ("y" t) + ("n" nil) + ("!" (prog1 t + (setq yes-for-all t))) + ("q" (cl-return-from helm-ff-mcp + (message "Operation aborted"))))) + if dir-ok + do (if overwrite + (push (list file (file-name-as-directory dest) overwrite) operations) + (cl-incf skipped)) + else do (cl-incf skipped)) + (when operations + (with-helm-display-marked-candidates + helm-marked-buffer-name + (mapcar #'abbreviate-file-name targets) + (if (y-or-n-p (format "Copy `%s' to directories?" (helm-basename file))) + (progn + (process-put + (async-start + `(lambda () + (require 'cl-lib) + (cl-loop with copies = 0 + with skipped = ,skipped + for (file dest overwrite) in ',operations + do (condition-case _err + (progn + (copy-file file dest overwrite) + (cl-incf copies)) + (file-error (cl-incf skipped))) + finally return (list file copies skipped))) + (lambda (result) + (let ((copied (nth 1 result))) + (unless (dired-async-processes) + (dired-async--modeline-mode -1)) + (run-with-idle-timer + 0.1 nil + (lambda () + (dired-async-mode-line-message + "Mcp done, %s %s of %s done, %s files skipped" + 'dired-async-message + copied + (if (> copied 1) + "copies" "copy") + (helm-basename (nth 0 result)) + (nth 2 result))))))) + 'dired-async-process t) + (dired-async--modeline-mode 1)) + (message "Operation aborted"))))))) + +(helm-make-command-from-action helm-ff-run-mcp + "Copy the car of marked candidates to the remaining marked candidates." + 'helm-ff-mcp) + +;;; File name history +;; +;; +(defvar helm-source-file-name-history + (helm-build-sync-source "File Name History" + :candidates 'file-name-history + :persistent-action #'ignore + ;; See comments in `helm-recentf-source' about bug#2709. + ;; This is probably not needed as long as we use + ;; `helm-file-name-history-transformer' which uses only propertize. + :coerce 'substring-no-properties + :match-on-real t + :candidate-transformer #'helm-file-name-history-transformer + :action 'helm-type-file-actions)) + +(defvar helm-file-name-history-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (define-key map (kbd "C-x C-f") 'helm-ff-file-name-history-run-ff) + map)) + +(defun helm-file-name-history-transformer (candidates) + ;; As this transformer uses propertize and not add-text-properties or similar + ;; it doesn't suffer of nasty side effect like in bug#2709. + (cl-loop with lgst = helm-file-name-history-max-length + for elm in candidates + for c = (truncate-string-to-width + elm helm-file-name-history-max-length nil nil t) + for disp = (cond ((or (file-remote-p elm) + (and (fboundp 'tramp-archive-file-name-p) + (tramp-archive-file-name-p c))) + (propertize c 'face 'helm-history-remote)) + ((file-exists-p elm) + (let ((last-access (format-time-string "%d/%m/%Y %X" + (nth 4 (file-attributes elm))))) + (concat (propertize c 'face 'helm-ff-file) + (make-string (1+ (- lgst (length c))) ? ) + last-access))) + ;; Should not happen as long as we use recentf. + (t (propertize c 'face 'helm-history-deleted))) + when disp + collect (cons (if helm-ff-icon-mode + (concat (helm-x-icons-icon-for-file + (helm-basename elm)) + " " disp) + disp) + elm))) + +(defun helm-ff-file-name-history-ff (candidate) + (helm-set-pattern + (expand-file-name candidate))) + +(helm-make-command-from-action helm-ff-file-name-history-run-ff + "Switch back to current HFF session with selection as preselect." + 'helm-ff-file-name-history-ff) + +(defun helm-ff-file-name-history () + "Switch to `recentf' without quitting `helm-find-files'." + (interactive) + (when helm-turn-on-recentf (recentf-mode 1)) + (let ((src (helm-build-sync-source "File name history" + :candidate-number-limit + (helm-aand + (or + (and (boundp 'recentf-max-saved-items) + recentf-max-saved-items) + (get 'file-name-history 'history-length) + history-length) + (and (numberp it) it)) + :candidates (lambda () recentf-list) + :help-message 'helm-file-name-history-help-message + :fuzzy-match t + :match-on-real t + :persistent-action 'ignore + :migemo t + :candidate-transformer 'helm-file-name-history-transformer + :action (helm-make-actions + "Find file" (lambda (candidate) + (helm-set-pattern + (expand-file-name candidate)) + (with-helm-after-update-hook (helm-exit-minibuffer))) + "Find file in helm" 'helm-ff-file-name-history-ff) + :keymap helm-file-name-history-map))) + (with-helm-alive-p + (helm :sources src + :buffer "*helm-file-name-history*" + :allow-nest t + :resume 'noresume)))) +(put 'helm-ff-file-name-history 'helm-only t) + +;;; Browse project +;; Need dependencies: +;; +;; +;; Only hg and git are supported for now. +(defvar helm--browse-project-cache (make-hash-table :test 'equal)) +(defvar helm-buffers-in-project-p) + +(defvar helm-browse-project-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-generic-files-map) + (define-key map (kbd "M-g a") 'helm-browse-project-run-ag) + map)) + +(defun helm-browse-project-get-buffers (root-directory) + (cl-loop for b in (helm-buffer-list) + ;; FIXME: Why default-directory is root-directory + ;; for current-buffer when coming from helm-quit-and-find-file. + for cd = (with-current-buffer b default-directory) + for bn = (buffer-file-name (get-buffer b)) + if (or (and bn (file-in-directory-p bn root-directory)) + (and (null bn) + (not (file-remote-p cd)) + (file-in-directory-p cd root-directory))) + collect b)) + +(defun helm-browse-project-build-buffers-source (directory) + (helm-make-source "Buffers in project" 'helm-source-buffers + :header-name (lambda (name) + (format + "%s (%s)" + name (abbreviate-file-name directory))) + :buffer-list (lambda () (helm-browse-project-get-buffers directory)))) + +(defun helm-browse-project-walk-directory (directory) + "Default function for `helm-browse-project-default-find-files-fn'." + (helm-walk-directory + directory + :directories nil :path 'full :skip-subdirs t)) + +(defun helm-browse-project-find-files-1 (directory program) + "List files in DIRECTORY recursively with external PROGRAM." + (require 'helm-fd) + (let* ((fd-exe (or helm-fd-executable + (executable-find "fdfind") + (executable-find "fd"))) + (cmd (cl-ecase program + (ag "ag --hidden -g '.*' %s") + (rg "rg --files --hidden -g '*' %s") + (fd (concat fd-exe " --hidden --type f --glob '*' %s"))))) + (with-temp-buffer + (call-process-shell-command + (format cmd directory) + nil t nil) + (mapcar (lambda (f) (expand-file-name f directory)) + (split-string (buffer-string) "\n"))))) + +(defun helm-browse-project-ag-find-files (directory) + "A suitable function for `helm-browse-project-default-find-files-fn'. +Use AG as backend." + (helm-browse-project-find-files-1 directory 'ag)) + +(defun helm-browse-project-rg-find-files (directory) + "A suitable function for `helm-browse-project-default-find-files-fn'. +Use RG as backend." + (helm-browse-project-find-files-1 directory 'rg)) + +(defun helm-browse-project-fd-find-files (directory) + "A suitable function for `helm-browse-project-default-find-files-fn'. +Use FD as backend." + (helm-browse-project-find-files-1 directory 'fd)) + +(defun helm-browse-project-ag (_candidate) + "A `helm-grep' AG action for `helm-browse-project'." + (let ((dir (with-helm-buffer (helm-get-attr 'root-dir)))) + (helm-grep-ag dir helm-current-prefix-arg))) + +(helm-make-command-from-action helm-browse-project-run-ag + "Run `helm-grep' AG from `helm-browse-project'." + 'helm-browse-project-ag) + +(defclass helm-browse-project-source (helm-source-in-buffer helm-type-file) + ((root-dir :initarg :root-dir + :initform nil + :custom 'file) + (match-part :initform + (lambda (c) + (if (with-helm-buffer + helm-ff-transformer-show-only-basename) + (helm-basename c) c))) + (filter-one-by-one :initform + (lambda (c) + (if (with-helm-buffer + helm-ff-transformer-show-only-basename) + (cons (propertize (helm-basename c) + 'face 'helm-ff-file) + c) + (propertize c 'face 'helm-ff-file))))) + "Class to define a source in `helm-browse-project' handling non +VC handled directories.") + +(cl-defmethod helm--setup-source :after ((source helm-browse-project-source)) + (let ((actions (slot-value source 'action))) + (setf (slot-value source 'action) + (helm-append-at-nth + (symbol-value actions) + '(("Grep project with AG `M-g a, C-u select type'" . helm-browse-project-ag)) + 7)) + (setf (slot-value source 'keymap) helm-browse-project-map))) + +(defun helm-browse-project-find-files (directory &optional refresh) + "Browse non VC handled directory DIRECTORY." + (when refresh (remhash directory helm--browse-project-cache)) + (unless (gethash directory helm--browse-project-cache) + (puthash directory (funcall helm-browse-project-default-find-files-fn + directory) + helm--browse-project-cache)) + (helm :sources `(,(helm-browse-project-build-buffers-source directory) + ,(helm-make-source "Browse project" + 'helm-browse-project-source + :root-dir directory + :data (gethash directory helm--browse-project-cache) + :header-name + (lambda (name) + (format + "%s (%s)" + name (abbreviate-file-name directory))))) + :ff-transformer-show-only-basename nil + :buffer "*helm browse project*")) + +(defvar helm-browse-project-history nil) + +;;;###autoload +(defun helm-projects-history (&optional arg) + "Jump to project already visisted with `helm-browse-project'. +Prefix arg allows browsing files recursively under a project not handled +by git or hg, otherwise it has no effect." + (interactive "P") + (setq helm-browse-project-history + (cl-loop for p in helm-browse-project-history + when (and (stringp p) (file-directory-p p)) + collect p)) + (helm :sources + (helm-build-sync-source "Project history" + :candidates helm-browse-project-history + :filtered-candidate-transformer 'helm-adaptive-sort + :action (helm-make-actions + "Browse project" + (lambda (candidate) + (with-helm-default-directory candidate + (helm-browse-project + (or arg helm-current-prefix-arg)))) + "Remove project(s)" + (lambda (_candidate) + (let ((mkd (helm-marked-candidates))) + (cl-loop for c in mkd do + (setq helm-browse-project-history + (delete c helm-browse-project-history))) + (message "%s projects removed" (length mkd)))))) + :buffer "*helm browse project history*")) + +;;;###autoload +(defun helm-browse-project (arg) + "Preconfigured helm to browse projects. +Browse files and see status of project with its VCS. +GIT, HG and SVN are supported for now, but only git is fully featured with +`helm-ls-git' package. +Fall back to `helm-browse-project-find-files' if current +directory is not under control or one of those VCS. +With a prefix ARG browse files recursively, with two prefix ARG +rebuild the cache. +If the current directory is found in the cache, start +`helm-browse-project-find-files' even with no prefix ARG. +NOTE: The prefix ARG have no effect on the VCS controlled +directories. + +Needed dependencies for VCS (not mandatory, pickup what you need): + + +." + (interactive "P") + (require 'helm-x-files) + (require 'vc) + (let* ((helm-type-buffer-actions + (remove (assoc "Browse project from buffer" + helm-type-buffer-actions) + helm-type-buffer-actions)) + (helm-buffers-in-project-p t) + (git-project (and (require 'helm-ls-git nil t) + (fboundp 'helm-ls-git-root-dir) + (helm-ls-git-root-dir))) + (hg-project (and (require 'helm-ls-hg nil t) + (fboundp 'helm-hg-root) + (helm-hg-root))) + (svn-project (and (require 'helm-ls-svn nil t) + (fboundp 'helm-ls-svn-root-dir) + (helm-ls-svn-root-dir))) + ;; handle nested projects (Hg inside Git or vice versa) issue#2723. + (project-type (vc-deduce-backend))) + (cl-flet ((push-to-hist (root) + (setq helm-browse-project-history + (cons root (delete root helm-browse-project-history))))) + (helm-acond ((and (equal project-type 'Git) git-project) + (push-to-hist it) + (helm-ls-git)) + ((and (equal project-type 'Hg) hg-project) + (push-to-hist it) + (helm-hg-find-files-in-project)) + ((and (equal project-type 'Svn) svn-project) + (push-to-hist it) + (helm-ls-svn-ls)) + ((helm-browse-project-get--root-dir (helm-current-directory)) + (if (or arg (gethash it helm--browse-project-cache)) + (progn + (push-to-hist (abbreviate-file-name it)) + (helm-browse-project-find-files it (equal arg '(16)))) + (helm :sources (helm-browse-project-build-buffers-source it) + :buffer "*helm browse project*"))))))) + +(defun helm-browse-project-get--root-dir (directory) + (cl-loop with dname = (file-name-as-directory directory) + while (and dname (not (gethash dname helm--browse-project-cache))) + if (file-remote-p dname) + do (setq dname nil) else + do (setq dname (helm-basedir (substring dname 0 (1- (length dname))))) + finally return (or dname (file-name-as-directory directory)))) + +(defun helm-ff-browse-project (_candidate) + "Browse project in current directory. +See `helm-browse-project'." + (with-helm-default-directory helm-ff-default-directory + (helm-browse-project helm-current-prefix-arg))) + +(helm-make-command-from-action helm-ff-run-browse-project + "Run browse project." + 'helm-ff-browse-project) + +;;; Actions calling helm and main interactive functions. +;; +;; +(defun helm-ff-gid (_candidate) + (with-helm-default-directory helm-ff-default-directory + (helm-gid))) + +(helm-make-command-from-action helm-ff-run-gid + "Run gid from HFF." + 'helm-ff-gid) + +;; helm-find bindings for helm-find-files. +(defun helm-ff-find-sh-command (_candidate) + "Run `helm-find' from `helm-find-files'." + (require 'helm-find) + (helm-find-1 helm-ff-default-directory)) + +(helm-make-command-from-action helm-ff-run-find-sh-command + "Run find shell command action with key from `helm-find-files'." + 'helm-ff-find-sh-command) + +;; helm-hd bindings for hff +(defun helm-ff-fd (_candidate) + "Run fd shell command from `helm-find-files'." + (require 'helm-fd) + (helm-fd-1 helm-ff-default-directory)) + +(helm-make-command-from-action helm-ff-run-fd + "Run fd shell command action with key from `helm-find-files'." + 'helm-ff-fd) + +;;;###autoload +(defun helm-find-files (arg) + "Preconfigured `helm' for helm implementation of `find-file'. +Called with a prefix arg show history if some. +Don't call it from programs, use `helm-find-files-1' instead. +This is the starting point for nearly all actions you can do on +files." + (interactive "P") + (let* (tramp-archive-enabled ; Disable tramp-archive which is + ; kicking in unexpectedly. + (hist (and arg helm-ff-history (helm-find-files-history nil))) + (smart-input (or hist (helm-find-files-initial-input))) + (default-input (expand-file-name (helm-current-directory))) + (input (cond ((and (null hist) + helm-find-files-ignore-thing-at-point) + default-input) + ((and (eq major-mode 'org-agenda-mode) + org-directory + (not smart-input)) + (file-name-as-directory + (expand-file-name org-directory))) + ((and (eq major-mode 'dired-mode) smart-input) + (file-name-directory smart-input)) + ((and (not (string= smart-input "")) + smart-input)) + (t default-input))) + (input-as-presel (null (file-directory-p input))) + (presel (helm-aif (or hist + (and input-as-presel input) + (buffer-file-name (current-buffer)) + (and (eq major-mode 'dired-mode) + smart-input) + (and (eq major-mode 'Info-mode) + Info-current-file)) + (if (and helm-ff-transformer-show-only-basename + (null hist) + (not (string-match-p "[.]\\{1,2\\}\\'" it))) + (helm-basename it) + it)))) + ;; Continue using the same display function as history which used + ;; probably itself the same display function as inner HFF call, + ;; i.e. if history was using frame use a frame otherwise use a window. + (when (and hist (buffer-live-p (get-buffer helm-ff-history-buffer-name))) + (helm-set-local-variable 'helm-display-function + (with-current-buffer helm-ff-history-buffer-name + helm-display-function) + 'helm--last-frame-parameters + (with-current-buffer helm-ff-history-buffer-name + helm--last-frame-parameters))) + (set-text-properties 0 (length input) nil input) + (setq current-prefix-arg nil) + ;; Allow next helm session to reuse helm--last-frame-parameters as + ;; resume would do. + (let ((helm--executing-helm-action (not (null hist)))) + (helm-find-files-1 input (and presel (null helm-ff-no-preselect) + (format helm-ff-last-expanded-candidate-regexp + (regexp-quote presel))))))) + + + +(provide 'helm-files) + +;;; helm-files.el ends here diff --git a/elpa/helm-20260424.1357/helm-find.el b/elpa/helm-20260424.1357/helm-find.el new file mode 100644 index 00000000..e43ef266 --- /dev/null +++ b/elpa/helm-20260424.1357/helm-find.el @@ -0,0 +1,182 @@ +;;; helm-find.el --- helm interface for find command. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2026 Thierry Volpiatto + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Code: + +(require 'helm-files) +(require 'helm-external) + +(defcustom helm-findutils-skip-boring-files t + "Ignore boring files in find command results." + :group 'helm-files + :type 'boolean) + +(defcustom helm-findutils-search-full-path nil + "Search in full path with shell command find when non-nil. +I.e. use the -path/ipath arguments of find instead of +-name/iname." + :group 'helm-files + :type 'boolean) + +(defcustom helm-find-noerrors nil + "Prevent showing error messages in helm buffer when non nil." + :group 'helm-files + :type 'boolean) + +(defcustom helm-find-show-full-path-fn #'identity + "Function used in transformer to show the full path of candidate. +You may want to show the relative path or the abbreviated path instead of the +full path. The basename is accessible with +\\\\[helm-ff-run-toggle-basename], so no need to use a function +that display the basename of candidate here." + :group 'helm-files + :type '(choice + (const :tag "Display absolute path" identity) + (const :tag "Display relative path" file-relative-name) + (const :tag "Display abbreviated path" abbreviate-file-name))) + +(defvar helm-find-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-generic-files-map) + (define-key map (kbd "DEL") 'helm-delete-backward-no-update) + map)) + +(defvar helm-source-findutils + (helm-build-async-source "Find" + :header-name (lambda (name) + (concat name " in [" (helm-default-directory) "]")) + :candidates-process 'helm-find-shell-command-fn + :filtered-candidate-transformer 'helm-findutils-transformer + :action-transformer 'helm-transform-file-load-el + :persistent-action 'helm-ff-kill-or-find-buffer-fname + :action 'helm-type-file-actions + :help-message 'helm-generic-file-help-message + :keymap helm-find-map + :candidate-number-limit 9999 + :requires-pattern 3)) + +(defun helm-findutils-transformer (candidates _source) + (let (non-essential + (default-directory (helm-default-directory))) + (cl-loop for i in candidates + for abs = (expand-file-name + (helm-aif (file-remote-p default-directory) + (concat it i) i)) + for type = (car (file-attributes abs)) + for fname = (if (and helm-ff-transformer-show-only-basename + (not (string-match "[.]\\{1,2\\}$" i))) + (helm-basename abs) + (funcall helm-find-show-full-path-fn abs)) + for disp = (helm-acase type + ('t (propertize fname 'face 'helm-ff-directory)) + ((guard* (stringp it)) + (propertize fname 'face 'helm-ff-symlink)) + (otherwise (propertize fname 'face 'helm-ff-file))) + collect (cons (helm-ff-prefix-filename disp abs) abs)))) + +(defun helm-find--build-cmd-line () + (require 'find-cmd) + (let* ((default-directory (or (file-remote-p default-directory 'localname) + default-directory)) + (patterns+options (split-string helm-pattern "\\(\\`\\| +\\)\\* +")) + (fold-case (helm-set-case-fold-search (car patterns+options))) + (patterns (split-string (car patterns+options))) + (additional-options (and (cdr patterns+options) + (list (concat (cadr patterns+options) " ")))) + (ignored-dirs ()) + (ignored-files (when helm-findutils-skip-boring-files + (cl-loop for f in completion-ignored-extensions + if (string-match "/$" f) + do (push (replace-match "" nil t f) + ignored-dirs) + else collect (concat "*" f)))) + (path-or-name (if helm-findutils-search-full-path + '(ipath path) '(iname name))) + (name-or-iname (if fold-case + (car path-or-name) (cadr path-or-name)))) + (find-cmd (and ignored-dirs + `(prune (name ,@ignored-dirs))) + (and ignored-files + `(not (name ,@ignored-files))) + `(and ,@(mapcar + (lambda (pattern) + `(,name-or-iname ,(concat "*" pattern "*"))) + patterns) + ,@additional-options)))) + +(defun helm-find-shell-command-fn () + "Asynchronously fetch candidates for `helm-find'. +Additional find options can be specified after a \"*\" +separator." + (let* (process-connection-type + non-essential + (cmd (concat (helm-find--build-cmd-line) + (if helm-find-noerrors "2> /dev/null" ""))) + (proc (start-file-process-shell-command "hfind" helm-buffer cmd))) + (helm-log "helm-find-shell-command-fn" "Find command:\n%s" cmd) + (prog1 proc + (set-process-sentinel + proc + (lambda (process event) + (helm-process-deferred-sentinel-hook + process event (helm-default-directory)) + (if (or (string= event "finished\n") + (process-get process 'reach-limit)) + (helm-locate-update-mode-line "Find") + (helm-log "helm-find-shell-command-fn sentinel" "Error: Find %s" + (replace-regexp-in-string "\n" "" event)))))))) + +(defun helm-find-1 (dir) + (let ((default-directory (file-name-as-directory dir))) + (helm :sources 'helm-source-findutils + :buffer "*helm find*" + :ff-transformer-show-only-basename nil + :case-fold-search helm-file-name-case-fold-search))) + + +;;; Preconfigured commands +;; +;; +;;;###autoload +(defun helm-find (arg) + "Preconfigured `helm' for the find shell command. + +Recursively find files whose names are matched by all specified +globbing PATTERNs under the current directory using the external +program specified in `find-program' (usually \"find\"). Every +input PATTERN is silently wrapped into two stars: *PATTERN*. + +With prefix argument, prompt for a directory to search. + +When user option `helm-findutils-search-full-path' is non-nil, +match against complete paths, otherwise, against file names +without directory part. + +The (possibly empty) list of globbing PATTERNs can be followed by +the separator \"*\" plus any number of additional arguments that +are passed to \"find\" literally." + (interactive "P") + (let ((directory + (if arg + (file-name-as-directory + (read-directory-name "DefaultDirectory: ")) + default-directory))) + (helm-find-1 directory))) + +(provide 'helm-find) + +;;; helm-find.el ends here diff --git a/elpa/helm-20260424.1357/helm-font.el b/elpa/helm-20260424.1357/helm-font.el new file mode 100644 index 00000000..fe0b99c4 --- /dev/null +++ b/elpa/helm-20260424.1357/helm-font.el @@ -0,0 +1,344 @@ +;;; helm-font --- Font and ucs selection for Helm -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2026 Thierry Volpiatto + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Code: + +(require 'cl-lib) +(require 'helm) +(require 'helm-help) + +;; No warnings in Emacs built --without-x +(declare-function x-list-fonts "xfaces.c") + +(declare-function helm-generic-sort-fn "helm-utils") + +(defgroup helm-font nil + "Related applications to display fonts in Helm." + :group 'helm) + +(defcustom helm-ucs-recent-size 10 + "Number of recent chars to keep." + :type 'integer + :group 'helm-font) + +(defcustom helm-ucs-actions + '(("Insert character" . helm-ucs-insert-char) + ("Insert character name" . helm-ucs-insert-name) + ("Insert character code in hex" . helm-ucs-insert-code) + ("Kill marked characters" . helm-ucs-kill-char) + ("Kill name" . helm-ucs-kill-name) + ("Kill code" . helm-ucs-kill-code) + ("Describe char" . helm-ucs-describe-char)) + "Actions for `helm-source-ucs'." + :group 'helm-font + :type '(alist :key-type string :value-type function)) + +(defvar helm-ucs-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (define-key map (kbd "") 'helm-ucs-persistent-delete) + (define-key map (kbd "") 'helm-ucs-persistent-backward) + (define-key map (kbd "") 'helm-ucs-persistent-forward) + (define-key map (kbd "C-c SPC") 'helm-ucs-persistent-insert-space) + map) + "Keymap for `helm-ucs'.") + +(defface helm-ucs-char + `((((class color) (background dark)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :foreground "gold")) + "Face used to display ucs characters." + :group 'helm-font) + +;;; Xfont selection +;; +;; +(defvar helm-xfonts-cache nil) +(defvar helm-previous-font nil) +(defvar helm-source-xfonts + (helm-build-sync-source "X Fonts" + :init (lambda () + (unless helm-xfonts-cache + (setq helm-xfonts-cache + (x-list-fonts "*"))) + ;; Save current font so it can be restored in cleanup + (setq helm-previous-font (cdr (assq 'font (frame-parameters))))) + :candidates 'helm-xfonts-cache + :action `(("Copy font to kill ring" . ,(lambda (elm) + (kill-new elm))) + ("Set font" . ,(lambda (elm) + (kill-new elm) + (set-frame-font elm 'keep-size) + (message "Font copied to kill ring")))) + :cleanup (lambda () + ;; Restore previous font + (set-frame-font helm-previous-font 'keep-size)) + :persistent-action (lambda (new-font) + (set-frame-font new-font 'keep-size) + (kill-new new-font)) + :persistent-help "Preview font and copy to kill-ring")) + + +;;; 𝕌𝕔𝕤 𝕊𝕪𝕞𝕓𝕠𝕝 𝕔𝕠𝕞𝕡𝕝𝕖𝕥𝕚𝕠𝕟 +;; +;; +(defvar helm-ucs--max-len nil) +(defvar helm-ucs--names nil) +(defvar helm-ucs-history nil) +(defvar helm-ucs-recent nil + "Ring of recent `helm-ucs' selections.") + +(defun helm-calculate-ucs-alist-max-len (names) + "Calculate the length of the longest NAMES list candidate." + (cl-loop for (_n . v) in names + maximize (length (format "#x%x:" v)) into code + maximize (max 1 (string-width (format "%c" v))) into char + finally return (cons code char))) + +(defun helm-calculate-ucs-hash-table-max-len (names) + "Calculate the length of the longest NAMES hash table candidate." + (cl-loop for _n being the hash-keys of names + using (hash-values v) + maximize (length (format "#x%x:" v)) into code + maximize (max 1 (string-width (format "%c" v))) into char + finally return (cons code char))) + +(defun helm-calculate-ucs-max-len () + "Calculate the length of the longest `ucs-names' candidate." + (let ((ucs-struct (ucs-names))) + (if (hash-table-p ucs-struct) + (helm-calculate-ucs-hash-table-max-len ucs-struct) + (helm-calculate-ucs-alist-max-len ucs-struct)))) + +(defun helm-ucs-collect-symbols-alist (names) + "Collect ucs symbols from the NAMES list." + (cl-loop with pr = (make-progress-reporter + "collecting ucs names" + 0 (length names)) + for (n . v) in names + for count from 1 + for xcode = (format "#x%x:" v) + for len = (length xcode) + for diff = (- (car helm-ucs--max-len) len) + for code = (format "(#x%x): " v) + for char = (propertize (format "%c" v) + 'face 'helm-ucs-char) + unless (or (string= "" n) + ;; `char-displayable-p' return a font object or + ;; t for some char that are displayable but have + ;; no special font (e.g 10) so filter out char + ;; with no font. + (not (fontp (char-displayable-p (read xcode))))) + collect + (concat code (make-string diff ? ) + char " " n) + and do (progress-reporter-update pr count))) + +(defun helm-ucs-collect-symbols-hash-table (names) + "Collect ucs symbols from the NAMES hash-table." + (cl-loop with pr = (make-progress-reporter + "collecting ucs names" + 0 (hash-table-count names)) + for n being the hash-keys of names + using (hash-values v) + for count from 1 + for xcode = (format "#x%x:" v) + for len = (length xcode) + for diff = (- (car helm-ucs--max-len) len) + for code = (format "(#x%x): " v) + for char = (propertize (format "%c" v) + 'face 'helm-ucs-char) + unless (or (string= "" n) + (not (fontp (char-displayable-p (read xcode))))) + collect + (concat code (make-string diff ? ) + char " " n) + and do (progress-reporter-update pr count))) + +(defun helm-ucs-collect-symbols (ucs-struct) + "Collect ucs symbols from UCS-STRUCT. + +Depending on the Emacs version, the variable `ucs-names' can +either be an alist or a hash-table." + (if (hash-table-p ucs-struct) + (helm-ucs-collect-symbols-hash-table ucs-struct) + (helm-ucs-collect-symbols-alist ucs-struct))) + +(defun helm-ucs-init () + "Initialize a Helm buffer with ucs symbols. +Only math* symbols are collected." + (unless helm-ucs--max-len + (setq helm-ucs--max-len + (helm-calculate-ucs-max-len))) + (or helm-ucs--names + (setq helm-ucs--names + (helm-ucs-collect-symbols (ucs-names))))) + +;; Actions (insertion) + +(defun helm-ucs-match (candidate n) + "Return the N part of an ucs CANDIDATE. +Where N=1 is the ucs code, N=2 the ucs char and N=3 the ucs +name." + (when (string-match + "^(\\(#x[a-f0-9]+\\)): *\\(.\\) *\\([^:]+\\)+" + candidate) + (match-string n candidate))) + +(defun helm-ucs-save-recentest (candidate) + (let ((lst (cons candidate (delete candidate helm-ucs-recent)))) + (setq helm-ucs-recent + (if (> (length lst) helm-ucs-recent-size) + (nbutlast lst 1) + lst)))) + +(defun helm-ucs-insert (candidate n) + "Insert the N part of CANDIDATE." + (with-helm-current-buffer + (helm-ucs-save-recentest candidate) + (insert (helm-ucs-match candidate n)))) + +(defun helm-ucs-insert-char (candidate) + "Insert ucs char part of CANDIDATE at point." + (helm-ucs-insert candidate 2)) + +(defun helm-ucs-insert-code (candidate) + "Insert ucs code part of CANDIDATE at point." + (helm-ucs-insert candidate 1)) + +(defun helm-ucs-insert-name (candidate) + "Insert ucs name part of CANDIDATE at point." + (helm-ucs-insert candidate 3)) + +;; Kill actions +(defun helm-ucs-kill-char (_candidate) + "Action that concatenate ucs marked chars." + (let ((marked (helm-marked-candidates))) + (cl-loop for candidate in marked + do (helm-ucs-save-recentest candidate)) + (kill-new (mapconcat (lambda (x) + (helm-ucs-match x 2)) + marked "")))) + +(defun helm-ucs-kill-code (candidate) + (helm-ucs-save-recentest candidate) + (kill-new (helm-ucs-match candidate 1))) + +(defun helm-ucs-kill-name (candidate) + (helm-ucs-save-recentest candidate) + (kill-new (helm-ucs-match candidate 3))) + +;; Describe char +(defun helm-ucs-describe-char (candidate) + "Describe char CANDIDATE." + (with-temp-buffer + (insert (helm-ucs-match candidate 2)) + (describe-char (point-min)))) + +;; Navigation in current-buffer (persistent) + +(defun helm-ucs-forward-char (_candidate) + (with-helm-current-buffer + (forward-char 1))) + +(defun helm-ucs-backward-char (_candidate) + (with-helm-current-buffer + (forward-char -1))) + +(defun helm-ucs-delete-backward (_candidate) + (with-helm-current-buffer + (delete-char -1))) + +(defun helm-ucs-insert-space (_candidate) + (with-helm-current-buffer + (insert " "))) + +(defun helm-ucs-persistent-forward () + (interactive) + (with-helm-alive-p + (helm-set-attr 'action-forward 'helm-ucs-forward-char) + (helm-execute-persistent-action 'action-forward))) +(put 'helm-ucs-persistent-forward 'helm-only t) + +(defun helm-ucs-persistent-backward () + (interactive) + (with-helm-alive-p + (helm-set-attr 'action-back 'helm-ucs-backward-char) + (helm-execute-persistent-action 'action-back))) +(put 'helm-ucs-persistent-backward 'helm-only t) + +(defun helm-ucs-persistent-delete () + (interactive) + (with-helm-alive-p + (helm-set-attr 'action-delete 'helm-ucs-delete-backward) + (helm-execute-persistent-action 'action-delete))) +(put 'helm-ucs-persistent-delete 'helm-only t) + +(defun helm-ucs-persistent-insert-space () + (interactive) + (with-helm-alive-p + (helm-set-attr 'action-insert-space 'helm-ucs-insert-space) + (helm-execute-persistent-action 'action-insert-space))) + +(defvar helm-source-ucs-recent + (helm-build-sync-source "Recent UCS" + :action 'helm-ucs-actions + :candidates (lambda () helm-ucs-recent) + :help-message helm-ucs-help-message + :keymap helm-ucs-map + :volatile t)) + +(defvar helm-source-ucs + (helm-build-in-buffer-source "UCS names" + :data #'helm-ucs-init + :get-line #'buffer-substring + :help-message 'helm-ucs-help-message + :filtered-candidate-transformer + (lambda (candidates _source) (sort candidates #'helm-generic-sort-fn)) + :action 'helm-ucs-actions + :persistent-action (lambda (candidate) + (helm-ucs-insert-char candidate) + (helm-force-update)) + :keymap helm-ucs-map) + "Source for collecting `ucs-names' math symbols.") + +;;;###autoload +(defun helm-select-xfont () + "Preconfigured `helm' to select Xfont." + (interactive) + (helm :sources 'helm-source-xfonts + :buffer "*helm select xfont*")) + +;;;###autoload +(defun helm-ucs (arg) + "Preconfigured `helm' for `ucs-names'. + +Called with a prefix arg force reloading cache." + (interactive "P") + (when arg + (setq helm-ucs--names nil + helm-ucs--max-len nil + ucs-names nil)) + (let ((char (helm-aif (char-after) (string it)))) + (helm :sources (list helm-source-ucs-recent helm-source-ucs) + :history 'helm-ucs-history + :input (and char (multibyte-string-p char) char) + :buffer "*helm ucs*"))) + +(provide 'helm-font) + +;;; helm-font.el ends here diff --git a/elpa/helm-20260424.1357/helm-for-files.el b/elpa/helm-20260424.1357/helm-for-files.el new file mode 100644 index 00000000..9f9244e9 --- /dev/null +++ b/elpa/helm-20260424.1357/helm-for-files.el @@ -0,0 +1,359 @@ +;;; helm-for-files.el --- helm-for-files and related. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2026 Thierry Volpiatto + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Code: + +(require 'helm-files) +(require 'helm-external) +(require 'helm-bookmark) + +(defvar recentf-list) + +(defcustom helm-multi-files-toggle-locate-binding "C-c p" + "Default binding to switch back and forth locate in `helm-multi-files'." + :group 'helm-files + :type 'string) + +(defcustom helm-for-files-preferred-list + '(helm-source-buffers-list + helm-source-recentf + helm-source-bookmarks + helm-source-file-cache + helm-source-files-in-current-dir + helm-source-locate) + "Your preferred sources for `helm-for-files' and `helm-multi-files'. + +When adding a source here it is up to you to ensure the library +of this source is accessible and properly loaded." + :type '(repeat (choice symbol)) + :group 'helm-files) + +(defcustom helm-for-files-tramp-not-fancy t + "Colorize remote files when non nil. + +Be aware that a nil value will make tramp display very slow." + :group 'helm-files + :type 'boolean) + +;;; File Cache +;; +;; +(defvar file-cache-alist) + +(defclass helm-file-cache (helm-source-in-buffer helm-type-file) + ((init :initform (lambda () (require 'filecache))))) + +(defun helm-file-cache-get-candidates () + (cl-loop for item in file-cache-alist append + (cl-destructuring-bind (base &rest dirs) item + (cl-loop for dir in dirs collect + (concat dir base))))) + +(defvar helm-source-file-cache nil) + +(defcustom helm-file-cache-fuzzy-match nil + "Enable fuzzy matching in `helm-source-file-cache' when non--nil." + :group 'helm-files + :type 'boolean + :set (lambda (var val) + (set var val) + (setq helm-source-file-cache + (helm-make-source "File Cache" 'helm-file-cache + :fuzzy-match helm-file-cache-fuzzy-match + :data 'helm-file-cache-get-candidates)))) + +(cl-defun helm-file-cache-add-directory-recursively + (dir &optional match (ignore-dirs t)) + (require 'filecache) + (cl-loop for f in (helm-walk-directory + dir + :path 'full + :directories nil + :match match + :skip-subdirs ignore-dirs) + do (file-cache-add-file f))) + +(defun helm-transform-file-cache (actions _candidate) + (let ((source (helm-get-current-source))) + (if (string= (assoc-default 'name source) "File Cache") + (append actions + '(("Remove marked files from file-cache" + . helm-ff-file-cache-remove-file))) + actions))) + +;;; Recentf files +;; +;; +(defvar helm-recentf--basename-flag nil) + +(defun helm-recentf-pattern-transformer (pattern) + (let ((pattern-no-flag (replace-regexp-in-string " -b" "" pattern))) + (cond ((and (string-match " " pattern-no-flag) + (string-match " -b\\'" pattern)) + (setq helm-recentf--basename-flag t) + pattern-no-flag) + ((string-match "\\([^ ]*\\) -b\\'" pattern) + (prog1 (match-string 1 pattern) + (setq helm-recentf--basename-flag t))) + (t (setq helm-recentf--basename-flag nil) + pattern)))) + +(defclass helm-recentf-source (helm-source-sync helm-type-file) + ((init :initform (lambda () + (require 'recentf) + (when helm-turn-on-recentf (recentf-mode 1)))) + (candidates :initform 'recentf-list) + (pattern-transformer :initform 'helm-recentf-pattern-transformer) + (match-part :initform (lambda (candidate) + (if (or helm-ff-transformer-show-only-basename + helm-recentf--basename-flag) + (helm-basename candidate) candidate))) + ;; When real candidate is equal to display it gets corrupted with the text + ;; properties added by the transformer, so ensure to strip out properties + ;; before passing the candidate to action otherwise recentf will save the + ;; candidate passed to find-file with the properties and corrupt + ;; recentf-list. This happen when abbreviate-file-name is passed to a + ;; candidate with no leading "~" e.g. "/foo" bug#2709. + (coerce :initform 'substring-no-properties) + (migemo :initform t) + (persistent-action :initform 'helm-ff-kill-or-find-buffer-fname))) + +(cl-defmethod helm--setup-source :after ((source helm-recentf-source)) + (setf (slot-value source 'action) + (append (symbol-value (helm-actions-from-type-file)) + '(("Delete file(s) from recentf" . + (lambda (_candidate) + (cl-loop for file in (helm-marked-candidates) + do (setq recentf-list (delete file recentf-list))))))))) + +(defvar helm-source-recentf nil + "See (info \"(emacs)File Conveniences\"). +Set `recentf-max-saved-items' to a bigger value if default is too +small.") + +(defcustom helm-recentf-fuzzy-match nil + "Enable fuzzy matching in `helm-source-recentf' when non-nil." + :group 'helm-files + :type 'boolean + :set (lambda (var val) + (set var val) + (let ((helm-fuzzy-sort-fn 'helm-fuzzy-matching-sort-fn-preserve-ties-order)) + (setq helm-source-recentf + (helm-make-source "Recentf" 'helm-recentf-source + :fuzzy-match val))))) + + +;;; Transformer for helm-type-file +;; +;; +(defvar helm-sources-for-files-no-basename '("Recentf" "File Cache")) + +;; Function `helm-highlight-files' is used in type `helm-type-file'. Ensure that +;; the definition is available for clients, should they need it. +;; See https://github.com/bbatsov/helm-projectile/issues/184. +;;;###autoload +(defun helm-highlight-files (files source) + "A basic transformer for helm files sources. +Colorize only symlinks, directories and files." + (cl-loop with mp-fn = (or (assoc-default + 'match-part (helm-get-current-source)) + 'identity) + with sname = (helm-get-attr 'name source) + for i in files + ;; As long as we use this transformer on file lists like recentf that + ;; are printed and saved to a file we make a copy of the display + ;; string and add text props to it, this to not corrupt the elemnts + ;; of the original list (Bug#2709). + for disp = (copy-sequence + (if (or (and (not helm-ff-show-dot-file-path) + (helm-ff-dot-file-p i)) + (and helm-ff-transformer-show-only-basename + (not (member sname + helm-sources-for-files-no-basename)) + (not (helm-ff-dot-file-p i)) + (not (and helm--url-regexp + (string-match helm--url-regexp i))) + (not (string-match helm-ff-url-regexp i)))) + (helm-basename i) (abbreviate-file-name i))) + for isremote = (or (file-remote-p i) + (helm-file-on-mounted-network-p i)) + ;; file-attributes is too slow on remote files, + ;; so call it only if: + ;; - file is not remote + ;; - helm-for-files--tramp-not-fancy is nil and file is remote AND + ;; connected. (Bug#1679) + for type = (and (or (null isremote) + (and (null helm-for-files-tramp-not-fancy) + (file-remote-p i nil t))) + (car (file-attributes i))) + collect + (cond (;; No fancy display on remote files with basic predicates. + (and (null type) isremote) (cons disp i)) + (;; Symlinks + (stringp type) + (add-text-properties 0 (length disp) `(face helm-ff-symlink + match-part ,(funcall mp-fn disp) + help-echo ,(expand-file-name i)) + disp) + (cons (helm-ff-prefix-filename disp i) i)) + (;; Dotted dirs + (and (eq type t) (helm-ff-dot-file-p i)) + (add-text-properties 0 (length disp) `(face helm-ff-dotted-directory + match-part ,(funcall mp-fn disp) + help-echo ,(expand-file-name i)) + disp) + (cons (helm-ff-prefix-filename disp i) i)) + (;; Dirs + (eq type t) + (add-text-properties 0 (length disp) `(face helm-ff-directory + match-part ,(funcall mp-fn disp) + help-echo ,(expand-file-name i)) + disp) + (cons (helm-ff-prefix-filename disp i) i)) + (t ;; Files. + (add-text-properties 0 (length disp) `(face helm-ff-file + match-part ,(funcall mp-fn disp) + help-echo ,(expand-file-name i)) + disp) + (helm-aif (helm-file-name-extension disp) + (when (condition-case _err + (string-match (format "\\.\\(%s\\)\\'" it) disp) + (invalid-regexp nil)) + (add-face-text-property + (match-beginning 1) (match-end 1) + 'helm-ff-file-extension nil disp))) + (cons (helm-ff-prefix-filename disp i) i))))) + + +;;; Files in current dir +;; +;; +(defclass helm-files-in-current-dir-source (helm-source-sync helm-type-file) + ((candidates :initform (lambda () + (with-helm-current-buffer + (let ((dir (helm-current-directory))) + (when (file-accessible-directory-p dir) + (directory-files dir t)))))) + (pattern-transformer :initform 'helm-recentf-pattern-transformer) + (match-part :initform (lambda (candidate) + (if (or helm-ff-transformer-show-only-basename + helm-recentf--basename-flag) + (helm-basename candidate) candidate))) + (fuzzy-match :initform t) + (popup-info :initform (lambda (candidate) + (unless (helm-ff-dot-file-p candidate) + (helm-file-attributes + candidate + :dired t :human-size t :octal nil)))) + (migemo :initform t))) + +(cl-defmethod helm--setup-source :after ((source helm-files-in-current-dir-source)) + (helm-aif (slot-value source 'filtered-candidate-transformer) + (setf (slot-value source 'filtered-candidate-transformer) + (append '(helm-ff-sort-candidates) (helm-mklist it))))) + +(defvar helm-source-files-in-current-dir + (helm-make-source "Files from Current Directory" + 'helm-files-in-current-dir-source + :header-name (lambda (_name) + (format "Files from `%s'" + (abbreviate-file-name (helm-default-directory)))))) + +;;;###autoload +(defun helm-for-files () + "Preconfigured `helm' for opening files. +Run all sources defined in `helm-for-files-preferred-list'." + (interactive) + (require 'helm-x-files) + (unless helm-source-buffers-list + (setq helm-source-buffers-list + (helm-make-source "Buffers" 'helm-source-buffers))) + (helm :sources helm-for-files-preferred-list + :ff-transformer-show-only-basename nil + :buffer "*helm for files*" + :truncate-lines helm-buffers-truncate-lines)) + +(defun helm-multi-files-toggle-to-locate () + (interactive) + (with-helm-alive-p + (with-helm-buffer + (if (setq helm-multi-files--toggle-locate + (not helm-multi-files--toggle-locate)) + (progn + (helm-set-sources (unless (memq 'helm-source-locate + helm-sources) + (cons 'helm-source-locate helm-sources))) + (helm-set-source-filter '(helm-source-locate))) + (helm-kill-async-processes) + (helm-set-sources (remove 'helm-source-locate + helm-for-files-preferred-list)) + (helm-set-source-filter nil))))) +(put 'helm-multi-files-toggle-to-locate 'helm-only t) + +;;;###autoload +(defun helm-multi-files () + "Preconfigured helm like `helm-for-files' but running locate only on demand. + +Allow toggling back and forth from locate to others sources with +`helm-multi-files-toggle-locate-binding' key. +This avoids launching locate needlessly when what you are +searching for is already found." + (interactive) + (require 'helm-x-files) + (unless helm-source-buffers-list + (setq helm-source-buffers-list + (helm-make-source "Buffers" 'helm-source-buffers))) + (setq helm-multi-files--toggle-locate nil) + (helm-locate-set-command) + (helm-set-local-variable 'helm-async-outer-limit-hook + (list (lambda () + (when (and helm-locate-fuzzy-match + (not (string-match-p + "\\s-" helm-pattern))) + (helm-redisplay-buffer)))) + 'helm-ff-transformer-show-only-basename nil) + (let ((sources (remove 'helm-source-locate helm-for-files-preferred-list)) + (helm-locate-command + (if helm-locate-fuzzy-match + (unless (string-match-p "\\`locate -b" helm-locate-command) + (replace-regexp-in-string + "\\`locate" "locate -b" helm-locate-command)) + helm-locate-command)) + (old-key (lookup-key + helm-map + (read-kbd-macro helm-multi-files-toggle-locate-binding)))) + (with-helm-temp-hook 'helm-after-initialize-hook + (define-key helm-map (kbd helm-multi-files-toggle-locate-binding) + 'helm-multi-files-toggle-to-locate)) + (unwind-protect + (helm :sources sources + :buffer "*helm multi files*" + :truncate-lines helm-buffers-truncate-lines) + (define-key helm-map (kbd helm-multi-files-toggle-locate-binding) + old-key)))) + +;;;###autoload +(defun helm-recentf () + "Preconfigured `helm' for `recentf'." + (interactive) + (helm :sources 'helm-source-recentf + :ff-transformer-show-only-basename nil + :buffer "*helm recentf*")) + +(provide 'helm-for-files) + +;;; helm-for-files.el ends here diff --git a/elpa/helm-20260424.1357/helm-global-bindings.el b/elpa/helm-20260424.1357/helm-global-bindings.el new file mode 100644 index 00000000..abcf83ca --- /dev/null +++ b/elpa/helm-20260424.1357/helm-global-bindings.el @@ -0,0 +1,106 @@ +;;; helm-global-bindings.el --- Bind global helm commands -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2026 Thierry Volpiatto + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Code: + +(require 'helm-lib) ; For helm-aif (bug #2520). + + +;;; Command Keymap +;; +;; +(defgroup helm-global-bindings nil + "Global bindings for Helm." + :group 'helm) + +(defcustom helm-command-prefix-key + (helm-aif (car (where-is-internal 'Control-X-prefix (list global-map))) + (concat it [?c])) + "The prefix key used to call Helm commands from the `global-map'. + +Its default value is `C-x c'. +This key is bound to the function `helm-command-prefix' in the global map. +The definition of `helm-command-prefix' is the keymap `helm-command-map'. +Using `setq' to modify this variable will have no effect." + :type '(choice (string :tag "Key") (const :tag "no binding")) + :set + (lambda (var key) + (helm-aif (and (boundp var) (symbol-value var)) + (global-unset-key (read-kbd-macro it))) + (when key + (global-set-key (read-kbd-macro key) 'helm-command-prefix)) + (set var key))) + +(defvar helm-command-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "a") 'helm-apropos) + (define-key map (kbd "e") 'helm-etags-select) + (define-key map (kbd "l") 'helm-locate) + (define-key map (kbd "L") 'helm-locate-library) + (define-key map (kbd "s") 'helm-surfraw) + (define-key map (kbd "r") 'helm-regexp) + (define-key map (kbd "m") 'helm-man-woman) + (define-key map (kbd "t") 'helm-top) + (define-key map (kbd "o") 'helm-outline) + (define-key map (kbd "/") 'helm-find) + (define-key map (kbd "i") 'helm-imenu) + (define-key map (kbd "I") 'helm-imenu-in-all-buffers) + (define-key map (kbd "") 'helm-lisp-completion-at-point) + (define-key map (kbd "p") 'helm-list-emacs-process) + (define-key map (kbd "C-x r b") 'helm-filtered-bookmarks) + (define-key map (kbd "M-y") 'helm-show-kill-ring) + (define-key map (kbd "C-c ") 'helm-all-mark-rings) + (define-key map (kbd "C-x C-f") 'helm-find-files) + (define-key map (kbd "f") 'helm-multi-files) + (define-key map (kbd "C-:") 'helm-eval-expression-with-eldoc) + (define-key map (kbd "C-,") 'helm-calcul-expression) + (define-key map (kbd "M-x") 'helm-M-x) + (define-key map (kbd "M-s o") 'helm-occur) + (define-key map (kbd "M-g a") 'helm-do-grep-ag) + (define-key map (kbd "c") 'helm-colors) + (define-key map (kbd "F") 'helm-select-xfont) + (define-key map (kbd "8") 'helm-ucs) + (define-key map (kbd "C-c f") 'helm-recentf) + (define-key map (kbd "C-c g") 'helm-google-suggest) + (define-key map (kbd "h i") 'helm-info-at-point) + (define-key map (kbd "h r") 'helm-info-emacs) + (define-key map (kbd "h g") 'helm-info-gnus) + (define-key map (kbd "h h") 'helm-documentation) + (define-key map (kbd "C-x C-b") 'helm-buffers-list) + (define-key map (kbd "C-x r i") 'helm-register) + (define-key map (kbd "C-c C-x") 'helm-run-external-command) + (define-key map (kbd "b") 'helm-resume) + (define-key map (kbd "M-g i") 'helm-gid) + (define-key map (kbd "@") 'helm-packages) + (define-key map (kbd "h p") 'helm-finder) + map) + "Default keymap for \\[helm-command-prefix] commands. +The normal global definition of the character \\[helm-command-prefix] indirects to this keymap.") + +(fset 'helm-command-prefix helm-command-map) + + +;;; Menu + +(require 'helm-easymenu) + + +;;; Provide + +(provide 'helm-global-bindings) + +;;; helm-global-bindings.el ends here diff --git a/elpa/helm-20260424.1357/helm-grep.el b/elpa/helm-20260424.1357/helm-grep.el new file mode 100644 index 00000000..6abe3210 --- /dev/null +++ b/elpa/helm-20260424.1357/helm-grep.el @@ -0,0 +1,1885 @@ +;;; helm-grep.el --- Helm Incremental Grep. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2026 Thierry Volpiatto + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Code: +(require 'ansi-color) +(require 'cl-lib) +(require 'format-spec) +(require 'helm) +(require 'helm-help) +(require 'helm-regexp) +(require 'project) + +;;; load wgrep proxy if it's available +(require 'wgrep-helm nil t) + +(declare-function helm-buffer-list "helm-buffers") +(declare-function View-quit "view") +(declare-function doc-view-goto-page "doc-view" (page)) +(declare-function pdf-view-goto-page "pdf-view" (page &optional window)) +(declare-function helm-mm-split-pattern "helm-multi-match") +(declare-function helm-comp-read "helm-mode") +(declare-function helm-occur "helm-occur") + +(defvar helm--ansi-color-regexp) +(defvar helm-ff-default-directory) +(defvar helm-tramp-verbose) +(defvar helm-grep-ack-types-cache) +(defvar helm-grep-git-grep-command) +(defvar helm-source-grep-git) +(defvar tramp-verbose) +(defvar helm-current-error) + +;;; Internals vars +;; +;; +(defvar helm-rzgrep-cache (make-hash-table :test 'equal)) +(defvar helm-grep-default-function 'helm-grep-init) +(defvar helm-zgrep-recurse-flag nil) +(defvar helm-grep-history nil) +(defvar helm-grep-ag-history nil) +(defvar helm-grep-last-targets nil) +(defvar helm-grep-include-files nil) +(defvar helm-grep-in-recurse nil) +(defvar helm-grep-use-zgrep nil) +(defvar helm-grep-default-directory-fn nil + "A function that should return a directory to expand candidate to. +It is intended to use as a let-bound variable, DON'T set this globaly.") +(defvar helm-pdfgrep-targets nil) +(defvar helm-grep-last-cmd-line nil) +(defvar helm-grep-split-line-regexp "^\\([[:lower:][:upper:]]?:?.*?\\):\\([0-9]+\\):\\(.*\\)") + + +;;; Keymaps +;; +;; +(defvar helm-grep-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (define-key map (kbd "M-") 'helm-goto-next-file) + (define-key map (kbd "M-") 'helm-goto-precedent-file) + (define-key map (kbd "C-c o") 'helm-grep-run-other-window-action) + (define-key map (kbd "C-c C-o") 'helm-grep-run-other-frame-action) + (define-key map (kbd "C-x C-s") 'helm-grep-run-save-buffer) + (define-key map (kbd "DEL") 'helm-delete-backward-no-update) + map) + "Keymap used in Grep sources.") + +(defvar helm-pdfgrep-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (define-key map (kbd "M-") 'helm-goto-next-file) + (define-key map (kbd "M-") 'helm-goto-precedent-file) + (define-key map (kbd "DEL") 'helm-delete-backward-no-update) + map) + "Keymap used in pdfgrep.") + +(defvar helm-grep-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "RET") 'helm-grep-mode-jump) + (define-key map (kbd "C-o") 'helm-grep-mode-jump-other-window) + (define-key map (kbd "") 'helm-grep-mode-jump-other-window-forward) + (define-key map (kbd "") 'helm-grep-mode-jump-other-window-backward) + (define-key map (kbd "") 'helm-gm-next-file) + (define-key map (kbd "") 'helm-gm-precedent-file) + (define-key map (kbd "M-n") 'helm-grep-mode-jump-other-window-forward) + (define-key map (kbd "M-p") 'helm-grep-mode-jump-other-window-backward) + (define-key map (kbd "M-N") 'helm-gm-next-file) + (define-key map (kbd "M-P") 'helm-gm-precedent-file) + map)) + + +(defgroup helm-grep nil + "Grep related Applications and libraries for Helm." + :group 'helm) + +(defcustom helm-grep-default-command + "grep --color=always -a -d skip %e -n%cH -e %p %f" + "Default grep format command for `helm-do-grep-1'. +Where: +'%e' format spec is for --exclude or --include grep options or + ack-grep --type option. (Not mandatory) + +'%c' format spec is for case-fold-search, + whether to use the -i option of grep. (Not mandatory) + When you specify this spec, helm grep will use smartcase + that is when a upcase character is found in pattern case will + be respected and no \\='-i' option will be used, otherwise, when + no upcase character is found in pattern always use \\='-i'. + If you don't want this behavior, don't use this spec and + specify or not the \\='-i' option. + Note that with ack-grep this is not needed, just specify + the \\='--smart-case' option. + +'%p' format spec is for pattern. (Mandatory) + +'%f' format spec is for filenames. (Mandatory) + +If your grep version doesn't support the --exclude/include args +don't specify the \\='%e' format spec. + +Helm also support ack-grep and git-grep. The following is a +default command example for ack-grep: + +\(setq helm-grep-default-command + \"ack-grep -Hn --color --smart-case --no-group %e -- %p %f\" + helm-grep-default-recurse-command + \"ack-grep -H --color --smart-case --no-group %e -- %p %f\") + +You can ommit the %e spec if you don't want to be prompted for +types. + +NOTE: Helm for ack-grep support ANSI sequences, so you can remove +the \"--no-color\" option safely (recommended). +However you should specify --color to enable multi matches highlighting +because ack disable it when output is piped. + +Same for grep you can use safely the option \"--color=always\" (default). +You can customize the color of matches using GREP_COLORS env var. +e.g: (setenv \"GREP_COLORS\" + \"ms=30;43:mc=30;43:sl=01;37:cx=:fn=35:ln=32:bn=32:se=36\") + +To enable ANSI color in git-grep just add \"--color=always\". +To customize the ANSI color in git-grep, GREP_COLORS have no effect, +you will have to setup this in your .gitconfig: + + [color \"grep\"] + match = black yellow + +Where \"black\" is the foreground and \"yellow\" the background. +See the git documentation for more infos. + +`helm-grep-default-command' and +`helm-grep-default-recurse-command' are independent, so you can +enable `helm-grep-default-command' with ack-grep and +`helm-grep-default-recurse-command' with grep if you want to be +faster on recursive grep. + +NOTE: Remote grepping is not available with ack-grep, and badly + supported with grep because tramp handles badly repeated + remote processes in a short delay (< to 5s)." + :type 'string) + +(defcustom helm-grep-default-recurse-command + "grep --color=always -a -d recurse %e -n%cH -e %p %f" + "Default recursive grep format command for `helm-do-grep-1'. +See `helm-grep-default-command' for format specs and infos about +ack-grep." + :type 'string) + +(defcustom helm-default-zgrep-command + "zgrep --color=always -a -n%cH -e %p %f" + "Default command for Zgrep. +See `helm-grep-default-command' for infos on format specs. +Option --color=always is supported and can be used safely to +replace the Helm internal match highlighting. See +`helm-grep-default-command' for more infos." + :type 'string) + +(defcustom helm-pdfgrep-default-command + "pdfgrep --color always -niH %s %s" + "Default command for pdfgrep. +Option \"--color always\" is supported starting Helm version +1.7.8. When used matches will be highlighted according to +GREP_COLORS env var." + :type 'string) + +(defcustom helm-pdfgrep-default-recurse-command + "pdfgrep --color always -rniH %s %s" + "Default recurse command for pdfgrep. +Option \"--color always\" is supported starting Helm version +1.7.8. When used matches will be highlighted according to +GREP_COLORS env var." + :type 'string) + +(defcustom helm-pdfgrep-default-read-command nil + "Default command to read pdf files from pdfgrep. +Where \\='%f' format spec is filename and \\='%p' is page number. +E.g. In Ubuntu you can set it to: + + \"evince --page-label=%p \\='%f'\" + +If set to nil either `doc-view-mode' or `pdf-view-mode' will be +used instead of an external command." + :type 'string) + +(defcustom helm-grep-max-length-history 100 + "Max number of elements to save in `helm-grep-history'." + :type 'integer) + +(defcustom helm-zgrep-file-extension-regexp + ".*\\(\\.gz\\|\\.bz\\|\\.xz\\|\\.lzma\\)$" + "Default file extensions zgrep will search in." + :type 'string) + +(defcustom helm-grep-preferred-ext nil + "This file extension will be preselected for grep." + :type 'string) + +(defcustom helm-grep-save-buffer-name-no-confirm nil + "When *hgrep* already exists, auto append suffix." + :type 'boolean) + +(defcustom helm-grep-ignored-files + (cons ".#*" (delq nil (mapcar (lambda (s) + (unless (string-match-p "/\\'" s) + (concat "*" s))) + completion-ignored-extensions))) + "List of file names which `helm-grep' shall exclude." + :type '(repeat string)) + +(defcustom helm-grep-ignored-directories + helm-walk-ignore-directories + "List of names of sub-directories which `helm-grep' shall not recurse into." + :type '(repeat string)) + +(defcustom helm-grep-truncate-lines t + "When nil the grep line that appears will not be truncated." + :type 'boolean) + +(defcustom helm-grep-file-path-style 'basename + "File path display style when grep results are displayed. +Possible value are: + basename: displays only the filename, none of the directory path + absolute: displays absolute path + relative: displays relative path from root grep directory." + :type '(choice (const :tag "Basename" basename) + (const :tag "Absolute" absolute) + (const :tag "Relative" relative))) + +(defcustom helm-grep-actions + (helm-make-actions + "Find File" 'helm-grep-action + "Find file other frame" 'helm-grep-other-frame + "Save results in grep buffer" 'helm-grep-save-results + "Find file other window (C-u vertically)" 'helm-grep-other-window) + "Actions for helm grep." + :type '(alist :key-type string :value-type function)) + +(defcustom helm-grep-pipe-cmd-switches nil + "A list of additional parameters to pass to grep pipe command. +This will be used to pipe command for multiple pattern matching +for grep, zgrep ack-grep and git-grep backends. +If you add extra args for ack-grep, use ack-grep options, for +others (grep, zgrep and git-grep) use grep options. +Here are the commands where you may want to add switches: + + grep --color=always + ack-grep --smart-case --color + +You probably don't need to use this unless you know what you are +doing." + :type '(repeat string)) + +(defcustom helm-grep-ag-pipe-cmd-switches nil + "A list of additional parameters to pass to grep-ag pipe command. +Use parameters compatibles with the backend you are using +\(i.e. AG for AG, PT for PT or RG for RG) +Here are the commands where you may want to add switches: + + ag -S --color + rg -N -S --color=? + +For RG the value of --color= is computed according to the --color= +value used in `helm-grep-ag-command'. + +Note also that by default the \"--\" option is always used, you don't +need to add it here. + +You probably don't need to use this unless you know what you are +doing." + :type '(repeat string)) + +(defcustom helm-grep-input-idle-delay 0.1 + "Idle time before updating, specified in seconds. +A lower value (default) means Helm will display the results +faster. Increasing it to a higher value (e.g. 0.6) prevents the +buffer from flickering when updating." + :type 'float) + +(defcustom helm-grep-use-ioccur-style-keys t + "Use Arrow keys to jump to occurences. +Note that if you define this variable with `setq' your change +will have no effect, use customize instead." + :type 'boolean + :set (lambda (var val) + (set var val) + (if val + (progn + (define-key helm-grep-map (kbd "") 'helm-execute-persistent-action) + (define-key helm-grep-map (kbd "") 'helm-grep-run-default-action)) + (define-key helm-grep-map (kbd "") nil) + (define-key helm-grep-map (kbd "") nil)))) + +(defcustom helm-grep-ag-command + (cond ((executable-find "rg") + "rg --color=always --smart-case --search-zip --no-heading --line-number %s -- %s %s") + ((executable-find "ag") + "ag --line-numbers -S --color --nogroup %s -- %s %s")) + "The default command for RG or AG. + +Prefer RG by default if available. + +Update: PT is still mentionned in this documentation but it seems it +doesn't exists anymore, or at least it is no more maintained. + +Takes three format specs, the first for type(s), the second for +pattern and the third for directory. + +You can use safely \"--color\" (used by default) with AG RG and +PT. + +NOTE: Usage of \"--color=never\" is discouraged as it uses Elisp +to colorize matched items which is slower than using the native +colorization of backend, however it is still supported. + +For ripgrep here is the command line to use: + + rg --color=always --smart-case --no-heading --line-number %s -- %s %s + +And to customize colors (always for ripgrep) use something like this: + + rg --color=always --colors \\='match:bg:yellow' --colors \\='match:fg:black' +\--smart-case --no-heading --line-number %s -- %s %s + +This will change color for matched items from foreground red (the +default) to a yellow background with a black foreground. Note +that your color settings for RG will not work properly with +multiples pattern if you have configured colors in rg config file +instead of command line. For more enhanced settings of ansi +colors see https://github.com/emacs-helm/helm/issues/2313 + +You must use an output format that fit with helm grep, that is: + + \"filename:line-number:string\" + +The option \"--nogroup\" allow this. +The option \"--line-numbers\" is also mandatory except with +PT (not supported). +For RG the options \"--no-heading\" and \"--line-number\" are the +ones to use. + +When modifying the default colors of matches with e.g. +\"--color-match\" option of AG or \"--colors\" option of ripgrep +you may want to modify as well `helm-grep-ag-pipe-cmd-switches' +to have all matches colorized with the same color in multi +match. + +Of course you can use several other options, see the man page of the +backend you are using." + :type 'string) + +(defcustom helm-grep-git-grep-command + "git --no-pager grep -n%cH --color=always --full-name -e %p -- %f" + "The git grep default command line. +The option \"--color=always\" can be used safely. +The color of matched items can be customized in your .gitconfig +See `helm-grep-default-command' for more infos. + +The \"--exclude-standard\" and \"--no-index\" switches allow +skipping unwanted files specified in ~/.gitignore_global and +searching files not already staged (not enabled by default). + +You have also to enable this in global \".gitconfig\" with + \"git config --global core.excludesfile ~/.gitignore_global\"." + :type 'string) + + +;;; Faces +;; +;; +(defgroup helm-grep-faces nil + "Customize the appearance of helm-grep." + :prefix "helm-" + :group 'helm-grep + :group 'helm-faces) + +(defface helm-grep-match + `((((background light)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :foreground "#b00000") + (((background dark)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :foreground "gold1")) + "Face used to highlight grep matches. +Have no effect when grep backend use \"--color=\"." + :group 'helm-grep-faces) + +(defface helm-grep-file + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :foreground "BlueViolet" + :underline t)) + "Face used to highlight grep results filenames." + :group 'helm-grep-faces) + +(defface helm-grep-lineno + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :foreground "DarkOrange1")) + "Face used to highlight grep number lines." + :group 'helm-grep-faces) + +(defface helm-grep-finish + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :foreground "green")) + "Face used in mode line when grep is finish." + :group 'helm-grep-faces) + +(defface helm-grep-cmd-line + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :inherit font-lock-type-face)) + "Face used to highlight grep command line when no results." + :group 'helm-grep-faces) + + +;;; Init +;; +;; +(defun helm-grep-prepare-candidates (candidates in-directory) + "Prepare filenames and directories CANDIDATES for grep command line." + ;; If one or more candidate is a directory, search in all files + ;; of this candidate (e.g /home/user/directory/*). + ;; If r option is enabled search also in subdidrectories. + ;; We need here to expand wildcards to support crap windows filenames + ;; as grep doesn't accept quoted wildcards (e.g "dir/*.el"). + (if helm-zgrep-recurse-flag + (mapconcat 'shell-quote-argument candidates " ") + ;; When candidate is a directory, search in all its files. + ;; NOTE that `file-expand-wildcards' will return also + ;; directories, they will be ignored by grep but not + ;; by ack-grep that will grep all files of this directory + ;; without recursing in their subdirs though, see that as a one + ;; level recursion with ack-grep. + ;; So I leave it as it is, considering it is a feature. [1] + (cl-loop for i in candidates append + (cond ((string-match "^git" helm-grep-default-command) + (list i)) + ;; Candidate is a directory and we use recursion or ack. + ((and (file-directory-p i) + (or helm-grep-in-recurse + ;; ack-grep accept directory [1]. + (helm-grep-use-ack-p))) + (list (expand-file-name i))) + ;; Grep doesn't support directory only when not in recurse. + ((file-directory-p i) + (file-expand-wildcards + (concat (file-name-as-directory (expand-file-name i)) "*") t)) + ;; Candidate is a file or wildcard and we use recursion, use the + ;; current directory instead of candidate. + ((and (or (file-exists-p i) (string-match "[*]" i)) + helm-grep-in-recurse) + (list (expand-file-name + (directory-file-name ; Needed for windoze. + (file-name-directory (directory-file-name i)))))) + ;; Else should be one or more file/directory + ;; possibly marked. + ;; When real is a normal filename without wildcard + ;; file-expand-wildcards returns a list of one file. + ;; wildcards should have been already handled by + ;; helm-read-file-name or helm-find-files but do it from + ;; here too in case we are called from elsewhere. + (t (file-expand-wildcards i t))) into all-files ; [1] + finally return + (let ((files (if (file-remote-p in-directory) + ;; Grep don't understand tramp filenames + ;; use the local name. + (mapcar (lambda (x) + (file-remote-p x 'localname)) + all-files) + all-files))) + ;; When user mark files and use recursion with grep + ;; backend enabled, the loop collect on each marked + ;; candidate its `file-name-directory' and we endup with + ;; duplicates (Bug#1714). FIXME: For now as a quick fix + ;; I just remove dups here but I should handle this inside + ;; the cond above. + (setq files (helm-fast-remove-dups files :test 'equal)) + (if (string-match "^git" helm-grep-default-command) + (mapconcat 'identity files " ") + (mapconcat 'shell-quote-argument files " ")))))) + +(defun helm-grep-command (&optional recursive grep) + (let* ((com (if recursive + helm-grep-default-recurse-command + helm-grep-default-command)) + (exe (if grep + (symbol-name grep) + (and com (car (split-string com " ")))))) + (if (and exe (string= exe "git")) "git-grep" exe))) + +(cl-defun helm-grep-use-ack-p (&key where) + (let* ((rec-com (helm-grep-command t)) + (norm-com (helm-grep-command)) + (norm-com-ack-p (string-match "\\`ack" norm-com)) + (rec-com-ack-p (and rec-com (string-match "\\`ack" rec-com)))) + (cl-case where + (default (and norm-com norm-com-ack-p)) + (recursive (and rec-com rec-com-ack-p)) + (strict (and norm-com rec-com rec-com-ack-p norm-com-ack-p)) + (t (and (not (and norm-com (string= norm-com "git-grep"))) + (or (and norm-com norm-com-ack-p) + (and rec-com rec-com-ack-p))))))) + +(defun helm-grep--pipe-command-for-grep-command (smartcase pipe-switches &optional grep-cmd) + (helm-acase (or grep-cmd (helm-grep-command)) + ;; Use grep for GNU regexp based tools. + (("grep" "zgrep" "git-grep") + (format "grep --color=always%s %s" + (if smartcase " -i" "") + pipe-switches)) + ;; Use ack-grep for PCRE based tools. + ;; Sometimes ack-grep cmd is ack only so compare by matching ack. + ((guard* (string-match-p "ack" it)) + (format "%s --smart-case --color %s" it pipe-switches)))) + +(defun helm-grep--prepare-cmd-line (only-files &optional include zgrep) + (let* ((default-directory (or helm-ff-default-directory + (helm-default-directory) + default-directory)) + (fnargs (helm-grep-prepare-candidates + only-files default-directory)) + (ignored-files (unless (helm-grep-use-ack-p) + (mapconcat + (lambda (x) + (concat "--exclude=" + (shell-quote-argument x))) + helm-grep-ignored-files " "))) + (ignored-dirs (unless (helm-grep-use-ack-p) + (mapconcat + ;; Need grep version >=2.5.4 + ;; of Gnuwin32 on windoze. + (lambda (x) + (concat "--exclude-dir=" + (shell-quote-argument x))) + helm-grep-ignored-directories " "))) + (exclude (unless (helm-grep-use-ack-p) + (let ((inc (and include + (concat include " "))) + (igfiles (and ignored-files + (concat ignored-files " "))) + (igdirs (and helm-grep-in-recurse + ignored-dirs))) + (concat inc igfiles igdirs)))) + (types (and (helm-grep-use-ack-p) + ;; When %e format spec is not specified + ;; in `helm-grep-default-command' + ;; we need to pass an empty string + ;; to types to avoid error. + (or include ""))) + (smartcase (if (helm-grep-use-ack-p) + "" + (unless (let ((case-fold-search nil)) + (string-match-p + "[[:upper:]]" helm-pattern)) + "i"))) + (helm-grep-default-command + (concat helm-grep-default-command " %m")) ; `%m' like multi. + (patterns (helm-mm-split-pattern helm-pattern t)) + (pipe-switches (mapconcat 'identity helm-grep-pipe-cmd-switches " ")) + (pipes + (helm-aif (cdr patterns) + (cl-loop with pipcom = (helm-grep--pipe-command-for-grep-command + smartcase pipe-switches) + for p in it concat + (format " | %s %s" pipcom (shell-quote-argument p))) + ""))) + (format-spec + helm-grep-default-command + (delq nil + (list (unless zgrep + (if types + (cons ?e types) + (cons ?e exclude))) + (cons ?c (or smartcase "")) + (cons ?p (shell-quote-argument (car patterns))) + (cons ?f fnargs) + (cons ?m pipes)))))) + +(defun helm-grep-init (cmd-line) + "Start an asynchronous grep process with CMD-LINE using ZGREP if non-nil." + (let* ((default-directory (or helm-ff-default-directory + (helm-default-directory) + default-directory)) + (zgrep (string-match "\\`zgrep" cmd-line)) + ;; Use pipe only with grep, zgrep or git-grep. + (process-connection-type (and (not zgrep) (helm-grep-use-ack-p))) + (tramp-verbose helm-tramp-verbose) + (start-time (float-time)) + (proc-name (if helm-grep-use-zgrep + "Zgrep" + (capitalize + (if helm-grep-in-recurse + (helm-grep-command t) + (helm-grep-command))))) + non-essential) + ;; Start grep process. + (helm-log "helm-grep-init" "Starting Grep process in directory `%s'" default-directory) + (helm-log "helm-grep-init" "Command line used was:\n\n%s" + (concat ">>> " (propertize cmd-line 'face 'helm-grep-cmd-line) "\n\n")) + (prog1 ; This function should return the process first. + (start-file-process-shell-command + proc-name helm-buffer cmd-line) + ;; Init sentinel. + (set-process-sentinel + (get-buffer-process helm-buffer) + (lambda (process event) + (let* ((err (process-exit-status process)) + (noresult (= err 1))) + (unless (and err (> err 0)) + (helm-process-deferred-sentinel-hook + process event (helm-default-directory))) + (cond ((and noresult + ;; This is a workaround for zgrep + ;; that exit with code 1 + ;; after a certain amount of results. + (with-helm-buffer (helm-empty-buffer-p))) + (with-helm-buffer + (insert (concat "* Exit with code 1, no result found," + " command line was:\n\n " + (propertize helm-grep-last-cmd-line + 'face 'helm-grep-cmd-line))) + (setq mode-line-format + `(" " mode-line-buffer-identification " " + (:eval (format "L%s" (helm-candidate-number-at-point))) " " + (:eval (propertize + (format + "[%s process finished - (no results)] " + ,proc-name) + 'face 'helm-grep-finish)))))) + ((or (string= event "finished\n") + (process-get process 'reach-limit) + (and noresult + ;; This is a workaround for zgrep + ;; that exit with code 1 + ;; after a certain amount of results. + (with-helm-buffer (not (helm-empty-buffer-p))))) + (helm-log "helm-grep-init" "%s process finished with %s results in %fs" + proc-name + (helm-get-candidate-number) + (- (float-time) start-time)) + (helm-maybe-show-popup-tip-info) + (with-helm-window + (setq mode-line-format + `(" " mode-line-buffer-identification " " + (:eval (format "L%s" (helm-candidate-number-at-point))) " " + (:eval (propertize + (format + "[%s process finished in %.2fs - (%s results)] " + ,proc-name + ,(- (float-time) start-time) + (helm-get-candidate-number)) + 'face 'helm-grep-finish)))) + (force-mode-line-update) + (when (and helm-allow-mouse helm-selection-point) + (helm--bind-mouse-for-selection helm-selection-point)))) + ;; Catch error output in log. + (t (helm-log + "helm-grep-init" + "Error: %s %s" + proc-name + (replace-regexp-in-string "\n" "" event)))))))))) + +(defun helm-grep-collect-candidates () + (let ((cmd-line (helm-grep--prepare-cmd-line + helm-grep-last-targets + helm-grep-include-files + helm-grep-use-zgrep))) + (set (make-local-variable 'helm-grep-last-cmd-line) cmd-line) + (funcall helm-grep-default-function cmd-line))) + + +;;; Actions +;; +;; +(defun helm-grep-action (candidate &optional where) + "Define a default action for `helm-do-grep-1' on CANDIDATE. +WHERE can be `other-window' or `other-frame'." + (let* ((split (helm-grep-split-line candidate)) + (split-pat (helm-mm-split-pattern helm-input)) + (lineno (string-to-number (nth 1 split))) + (loc-fname (or (with-current-buffer + (if (eq major-mode 'helm-grep-mode) + (current-buffer) + helm-buffer) + (get-text-property (pos-bol) + 'helm-grep-fname)) + (car split))) + (tramp-fname (file-remote-p (or helm-ff-default-directory + default-directory))) + (fname (if tramp-fname + (concat tramp-fname loc-fname) + loc-fname))) + (helm-log "helm-grep-action" "helm-grep-action fname: %s" fname ) + (cl-case where + (other-window (helm-window-show-buffers + (list (find-file-noselect fname)) t)) + (other-frame (find-file-other-frame fname)) + (grep (helm-grep-save-results-1)) + (pdf (if helm-pdfgrep-default-read-command + (helm-pdfgrep-action-1 split lineno (car split)) + (find-file (car split)) + (if (derived-mode-p 'pdf-view-mode) + (pdf-view-goto-page lineno) + (doc-view-goto-page lineno)))) + (t (find-file fname))) + (unless (or (eq where 'grep) (eq where 'pdf)) + (helm-goto-line lineno) + ;; Move point to the nearest matching regexp from bol. + (cl-loop for reg in split-pat + when (save-excursion + (condition-case _err + (if helm-migemo-mode + (helm-mm-migemo-forward reg (pos-eol) t) + (re-search-forward reg (pos-eol) t)) + (invalid-regexp nil))) + collect (match-beginning 0) into pos-ls + finally (when pos-ls (goto-char (apply #'min pos-ls)))) + ;; Save history + (unless (or helm-in-persistent-action + (eq major-mode 'helm-grep-mode) + (string= helm-pattern "")) + (setq helm-grep-history + (cons helm-pattern + (delete helm-pattern helm-grep-history))) + (when (> (length helm-grep-history) + helm-grep-max-length-history) + (setq helm-grep-history + (delete (car (last helm-grep-history)) + helm-grep-history))))))) + +(defun helm-grep-persistent-action (candidate) + "Persistent action for `helm-do-grep-1'. +With a prefix arg record CANDIDATE in `mark-ring'." + (helm-grep-action candidate) + (helm-highlight-current-line)) + +(defun helm-grep-other-window (candidate) + "Jump to result in other window from helm grep." + (helm-grep-action candidate 'other-window)) + +(defun helm-grep-other-frame (candidate) + "Jump to result in other frame from helm grep." + (helm-grep-action candidate 'other-frame)) + +(defun helm-goto-next-or-prec-file (n) + "Go to next or precedent candidate file in helm grep/etags buffers. +If N is positive go forward otherwise go backward." + (let* ((allow-mode (or (eq major-mode 'helm-grep-mode) + (eq major-mode 'helm-moccur-mode) + (eq major-mode 'helm-occur-mode))) + (sel (if allow-mode + (buffer-substring (pos-bol) (pos-eol)) + (helm-get-selection nil t))) + (current-line-list (helm-grep-split-line sel)) + (current-fname (nth 0 current-line-list)) + (bob-or-eof (if (eq n 1) 'eobp 'bobp)) + (mark-maybe (lambda () + (if allow-mode + (ignore) + (helm-mark-current-line))))) + (catch 'break + (while (not (funcall bob-or-eof)) + (forward-line n) ; Go forward or backward depending of n value. + ;; Exit when current-fname is not matched or in `helm-grep-mode' + ;; the line is not a grep line i.e 'fname:num:tag'. + (setq sel (buffer-substring (pos-bol) (pos-eol))) + (when helm-allow-mouse + (helm--mouse-reset-selection-help-echo)) + (unless (or (string= current-fname + (car (helm-grep-split-line sel))) + (and (eq major-mode 'helm-grep-mode) + (not (get-text-property (pos-bol) 'helm-grep-fname)))) + (funcall mark-maybe) + (throw 'break nil)))) + (cond ((and (> n 0) (eobp)) + (re-search-backward ".") + (forward-line 0) + (funcall mark-maybe)) + ((and (< n 0) (bobp)) + (helm-aif (next-single-property-change (pos-bol) 'helm-grep-fname) + (goto-char it) + (forward-line 1)) + (funcall mark-maybe))) + (unless allow-mode + (helm-follow-execute-persistent-action-maybe) + (helm-log-run-hook "helm-goto-next-or-prec-file" 'helm-move-selection-after-hook)))) + +;;;###autoload +(defun helm-goto-precedent-file () + "Go to previous file in Helm grep/etags buffers." + (interactive) + (with-helm-alive-p + (with-helm-window + (helm-goto-next-or-prec-file -1)))) +(put 'helm-goto-precedent-file 'helm-only t) + +;;;###autoload +(defun helm-goto-next-file () + "Go to previous file in Helm grep/etags buffers." + (interactive) + (with-helm-window + (helm-goto-next-or-prec-file 1))) +(put 'helm-goto-next-file 'helm-only t) + +(helm-make-command-from-action helm-grep-run-default-action + "Run grep default action from `helm-do-grep-1'." + 'helm-grep-action) + +(helm-make-command-from-action helm-grep-run-other-window-action + "Run grep goto other window action from `helm-do-grep-1'." + 'helm-grep-other-window) + +(helm-make-command-from-action helm-grep-run-other-frame-action + "Run grep goto other frame action from `helm-do-grep-1'." + 'helm-grep-other-frame) + +(helm-make-command-from-action helm-grep-run-save-buffer + "Run grep save results action from `helm-do-grep-1'." + 'helm-grep-save-results) + +(defun helm-grep-quit-an-find-file-fn (source) + (let* ((sel (helm-get-selection nil nil source)) + (grep-line (and (stringp sel) + (helm-grep-split-line sel)))) + (if (and grep-line (file-exists-p (car grep-line))) + (expand-file-name (car grep-line)) + default-directory))) + +;;; helm-grep-mode +;; +;; +(defun helm-grep-save-results (candidate) + (helm-grep-action candidate 'grep)) + +(defvar helm-grep-mode-use-pcre nil) +(defun helm-grep-save-results-1 () + "Save Helm grep result in a `helm-grep-mode' buffer." + (let* ((buf "*hgrep*") + new-buf + (pattern (with-helm-buffer helm-input-local)) + (src (helm-get-current-source)) + (src-name (assoc-default 'name src))) + (when (get-buffer buf) + (if helm-grep-save-buffer-name-no-confirm + (setq new-buf (format "*hgrep|%s|-%s" pattern + (format-time-string "%H-%M-%S*"))) + (setq new-buf (helm-read-string "GrepBufferName: " buf)) + (cl-loop for b in (helm-buffer-list) + when (and (string= new-buf b) + (not (y-or-n-p + (format "Buffer `%s' already exists overwrite? " + new-buf)))) + do (setq new-buf (helm-read-string "GrepBufferName: " "*hgrep ")))) + (setq buf new-buf)) + (with-current-buffer (get-buffer-create buf) + (setq default-directory (or helm-ff-default-directory + (helm-default-directory) + default-directory)) + (setq-local helm-grep-mode-use-pcre (helm-get-attr 'pcre src)) + (setq buffer-read-only t) + (let ((inhibit-read-only t) + (map (make-sparse-keymap))) + (erase-buffer) + (insert "-*- mode: helm-grep -*-\n\n" + (format "%s Results for `%s':\n\n" src-name pattern)) + (save-excursion + (insert (with-current-buffer helm-buffer + (goto-char (point-min)) (forward-line 1) + (buffer-substring (point) (point-max))))) + (save-excursion + (while (not (eobp)) + (add-text-properties (pos-bol) (pos-eol) + `(keymap ,map + help-echo ,(concat + (get-text-property + (point) 'helm-grep-fname) + "\nmouse-1: set point\nmouse-2: jump to selection") + mouse-face highlight)) + (define-key map [mouse-1] 'mouse-set-point) + (define-key map [mouse-2] 'helm-grep-mode-mouse-jump) + (define-key map [mouse-3] 'ignore) + (forward-line 1)))) + (helm-grep-mode)) + (pop-to-buffer buf) + (setq next-error-last-buffer (get-buffer buf)) + (message "Helm %s Results saved in `%s' buffer" src-name buf))) + +(defun helm-grep-mode-mouse-jump (event) + (interactive "e") + (let* ((window (posn-window (event-end event))) + (pos (posn-point (event-end event)))) + (with-selected-window window + (when (eq major-mode 'helm-grep-mode) + (goto-char pos) + (helm-grep-mode-jump))))) +(put 'helm-grep-mode-mouse-jump 'helm-only t) + +(defun helm-grep-next-error (&optional argp reset) + "Goto ARGP position from a `helm-grep-mode' buffer. +RESET non-nil means rewind to the first match. +This is the `next-error-function' for `helm-grep-mode'." + (interactive "p") + (goto-char (cond (reset (point-min)) + ((and (< argp 0) helm-current-error) + (line-beginning-position)) + ((and (> argp 0) helm-current-error) + (line-end-position)) + ((point)))) + (let ((fun (if (> argp 0) + #'next-single-property-change + #'previous-single-property-change))) + (helm-aif (funcall fun (point) 'helm-grep-fname) + (progn + (goto-char it) + ;; `helm-current-error' is set in + ;; `helm-grep-mode-jump'. + (helm-grep-mode-jump)) + (user-error "No more matches")))) +(put 'helm-grep-next-error 'helm-only t) + +;;;###autoload +(defun helm-revert-next-error-last-buffer () + "Revert last `next-error' buffer from `current-buffer'. + +Accept to revert only `helm-grep-mode' or `helm-occur-mode' buffers. +Use this when you want to revert the `next-error' buffer after +modifications in `current-buffer'." + (interactive) + (let ((buffer (next-error-find-buffer)) + (linum (line-number-at-pos)) + (bufname (buffer-name))) + (if buffer + (with-current-buffer buffer + (helm-aif (memq major-mode '(helm-grep-mode helm-occur-mode)) + (progn (revert-buffer) + ;; helm-occur-mode revert fn is synchronous so + ;; reajust from here (it is done with + ;; helm-grep-mode in its sentinel). + (when (eq (car it) 'helm-occur-mode) + (helm-grep-goto-closest-from-linum linum bufname))) + (error "No suitable buffer to revert found"))) + (error "No suitable buffer to revert found")))) + +(define-derived-mode helm-grep-mode + special-mode "helm-grep" + "Major mode to provide actions in helm grep saved buffer. + +Special commands: +\\{helm-grep-mode-map}" + (set (make-local-variable 'helm-grep-last-cmd-line) + (with-helm-buffer helm-grep-last-cmd-line)) + (set (make-local-variable 'revert-buffer-function) + #'helm-grep-mode--revert-buffer-function) + (set (make-local-variable 'next-error-function) + #'helm-grep-next-error) + (set (make-local-variable 'helm-current-error) nil)) +(put 'helm-grep-mode 'helm-only t) + +(defun helm-grep-mode--revert-buffer-function (&optional _ignore-auto _noconfirm) + (goto-char (point-min)) + (when (re-search-forward helm-grep-split-line-regexp nil t) (forward-line 0)) + (let ((inhibit-read-only t)) + (delete-region (point) (point-max))) + (message "Reverting buffer...") + (let ((process-connection-type + ;; Git needs a nil value otherwise it tries to use a pager. + (null (string-match-p "\\`git" helm-grep-last-cmd-line)))) + (set-process-sentinel + (start-file-process-shell-command + "hgrep" (generate-new-buffer "*hgrep revert*") helm-grep-last-cmd-line) + 'helm-grep-mode--sentinel))) + +(defun helm-grep-mode--sentinel (process event) + (when (string= event "finished\n") + (with-current-buffer (if (eq major-mode 'helm-grep-mode) + (current-buffer) + (next-error-find-buffer)) + (let ((inhibit-read-only t)) + (save-excursion + (cl-loop for l in (with-current-buffer (process-buffer process) + (prog1 (split-string (buffer-string) "\n") + (kill-buffer))) + for line = (if (string-match-p helm--ansi-color-regexp l) + (ansi-color-apply l) l) + when (string-match helm-grep-split-line-regexp line) + do (insert (propertize + (car (helm-grep-filter-one-by-one + line helm-grep-mode-use-pcre)) + ;; needed for wgrep. + 'helm-realvalue line) + "\n")))) + (when (fboundp 'wgrep-cleanup-overlays) + (wgrep-cleanup-overlays (point-min) (point-max)))) + (unless (eq major-mode 'helm-grep-mode) + (let ((bufname (buffer-name)) + (linum (line-number-at-pos))) + (with-current-buffer (next-error-find-buffer) + (helm-grep-goto-closest-from-linum linum bufname)))) + (message "Reverting buffer done") + (when executing-kbd-macro (sit-for 1)))) + +(defun helm-grep-goto-closest-from-linum (linum bufname) + (goto-char (point-min)) + (catch 'break + (while (re-search-forward (format "^%s:\\([0-9]+\\):" (regexp-quote bufname)) nil t) + (let ((numline (string-to-number (match-string 1)))) + (when (< (- linum numline) 0) + (forward-line -1) + (throw 'break nil)))))) + +(defun helm-gm-next-file () + (interactive) + (helm-goto-next-or-prec-file 1)) +(put 'helm-gm-next-file 'helm-only t) + +(defun helm-gm-precedent-file () + (interactive) + (helm-goto-next-or-prec-file -1)) +(put 'helm-gm-precedent-file 'helm-only t) + +(defun helm-grep-mode-jump () + (interactive) + (setq next-error-last-buffer (current-buffer)) + (setq-local helm-current-error (point-marker)) + (helm-grep-action + (buffer-substring (pos-bol) (pos-eol))) + (helm-match-line-cleanup-pulse)) + +(defun helm-grep-mode-jump-other-window-1 (arg) + (condition-case nil + (progn + (when (or (eq last-command 'helm-grep-mode-jump-other-window-forward) + (eq last-command 'helm-grep-mode-jump-other-window-backward)) + (forward-line arg)) + (save-selected-window + (helm-grep-action (buffer-substring (pos-bol) (pos-eol)) + 'other-window) + (helm-match-line-cleanup-pulse) + (recenter))) + (error nil))) + +(defun helm-grep-mode-jump-other-window-forward (arg) + (interactive "p") + (helm-grep-mode-jump-other-window-1 arg)) + +(defun helm-grep-mode-jump-other-window-backward (arg) + (interactive "p") + (helm-grep-mode-jump-other-window-1 (- arg))) + +(defun helm-grep-mode-jump-other-window () + (interactive) + (setq next-error-last-buffer (current-buffer)) + (setq-local helm-current-error (point-marker)) + (let ((candidate (buffer-substring (pos-bol) (pos-eol)))) + (condition-case nil + (progn (helm-grep-action candidate 'other-window) + (helm-match-line-cleanup-pulse)) + (error nil)))) + + +;;; ack-grep types +;; +;; +(defun helm-grep-hack-types () + "Return a list of known ack-grep types." + (with-temp-buffer + ;; "--help-types" works with both 1.96 and 2.1+, while + ;; "--help types" works only with 1.96 Bug#422. + ;; `helm-grep-command' should return the ack executable + ;; when this function is used in the right context + ;; i.e After checking is we are using ack-grep with + ;; `helm-grep-use-ack-p'. + (call-process (helm-grep-command t) nil t nil "--help-types") + (goto-char (point-min)) + (cl-loop while (re-search-forward "^ +\\([^. ]+\\) +\\(.*\\)" nil t) + collect (cons (concat (match-string 1) + " [" (match-string 2) "]") + (match-string 1)) + collect (cons (concat "no" (match-string 1) + " [" (match-string 2) "]") + (concat "no" (match-string 1)))))) + +(defun helm-grep-ack-types-transformer (candidates _source) + (cl-loop for i in candidates + if (stringp i) + collect (rassoc i helm-grep-ack-types-cache) + else + collect i)) + +(defvar helm-grep-ack-types-cache nil) +(defun helm-grep-read-ack-type () + "Select types for the \\='--type' argument of ack-grep." + (require 'helm-mode) + (require 'helm-adaptive) + (setq helm-grep-ack-types-cache (helm-grep-hack-types)) + (let ((types (helm-comp-read + "Types: " helm-grep-ack-types-cache + :name "*Ack-grep types*" + :marked-candidates t + :must-match t + :fc-transformer '(helm-adaptive-sort + helm-grep-ack-types-transformer) + :buffer "*helm ack-types*"))) + (mapconcat (lambda (type) (concat "--type=" type)) types " "))) + + +;;; grep extensions +;; +;; +(defun helm-grep-guess-extensions (files) + "Try to guess file extensions in FILES list when using grep recurse. +These extensions will be added to command line with --include arg +of grep." + (cl-loop with ext-list = (list helm-grep-preferred-ext "*") + with lst = (if (file-directory-p (car files)) + (directory-files + (car files) nil + directory-files-no-dot-files-regexp) + files) + for i in lst + for ext = (file-name-extension i 'dot) + for glob = (and ext (not (string= ext "")) + (concat "*" ext)) + unless (or (not glob) + (and glob-list (member glob glob-list)) + (and glob-list (member glob ext-list)) + (and glob-list (member glob helm-grep-ignored-files))) + collect glob into glob-list + finally return (delq nil (append ext-list glob-list)))) + +(defun helm-grep-get-file-extensions (files) + "Try to return a list of file extensions to pass to \\='--include' arg of grep." + (require 'helm-adaptive) + (let* ((all-exts (helm-grep-guess-extensions + (mapcar 'expand-file-name files))) + (extensions (helm-comp-read "Search Only in: " all-exts + :marked-candidates t + :fc-transformer 'helm-adaptive-sort + :buffer "*helm grep exts*" + :name "*helm grep extensions*"))) + (when (listp extensions) ; Otherwise it is empty string returned by C-RET. + ;; If extensions is a list of one string containing spaces, + ;; assume user entered more than one glob separated by space(s) and + ;; split this string to pass it later to mapconcat. + ;; e.g '("*.el *.py") + (cl-loop for i in extensions + append (split-string-and-unquote i " "))))) + + +;;; Set up source +;; +;; +(defvar helm-grep-before-init-hook nil + "Hook that runs before initialization of the Helm buffer.") + +(defvar helm-grep-after-init-hook nil + "Hook that runs after initialization of the Helm buffer.") + +(defclass helm-grep-class (helm-source-async) + ((candidates-process :initform 'helm-grep-collect-candidates) + (filtered-candidate-transformer :initform #'helm-grep-fc-transformer) + (popup-info :initform #'helm-grep-popup-info-fn) + (keymap :initform 'helm-grep-map) + (pcre :initarg :pcre :initform nil + :documentation + " Backend is using pcre regexp engine when non-nil.") + (nohighlight :initform t) + (nomark :initform t) + (backend :initarg :backend + :initform nil + :documentation + " The grep backend that will be used. + It is currently used only as an internal flag + and doesn't set the backend by itself. + You probably don't want to modify this.") + (help-message :initform 'helm-grep-help-message) + (history :initform 'helm-grep-history) + (action :initform 'helm-grep-actions) + (persistent-action :initform 'helm-grep-persistent-action) + (persistent-help :initform "Jump to line (`C-u' Record in mark ring)") + (requires-pattern :initform 2) + (before-init-hook :initform 'helm-grep-before-init-hook) + (after-init-hook :initform 'helm-grep-after-init-hook) + (find-file-target :initform #'helm-grep-quit-an-find-file-fn) + (group :initform 'helm-grep))) + +(defvar helm-source-grep nil) + +(defun helm-do-grep-1 (targets &optional recurse backend exts + default-input input source) + "Launch helm using backend BACKEND on a list of TARGETS files. + +When RECURSE is given and BACKEND is \\='grep' use -r option of +BACKEND and prompt user for EXTS to set the --include args of +BACKEND. +Interactively you can give more than one arg separated by space +at prompt. +E.g.: + $Pattern: *.el *.py *.tex + +From Lisp use the EXTS argument as a list of extensions as above. +If you are using ack-grep, you will be prompted for --type +instead and EXTS will be ignored. If prompt is empty +`helm-grep-ignored-files' are added to --exclude. + +Argument DEFAULT-INPUT is use as `default' arg of `helm' and +INPUT is used as `input' arg of `helm'. See `helm' docstring. + +Arg BACKEND when non-nil specifies which backend to use. +It is used currently to specify \\='zgrep' or \\='git'. +When BACKEND \\='zgrep' is used don't prompt for a choice in +recurse, and ignore EXTS, search being made recursively on files +matching `helm-zgrep-file-extension-regexp' only." + (unless source (setq source 'helm-source-grep)) + (let* (non-essential + (ack-rec-p (helm-grep-use-ack-p :where 'recursive)) + (exts (and recurse + ;; [FIXME] I could handle this from helm-walk-directory. + (not (eq backend 'zgrep)) ; zgrep doesn't handle -r opt. + (not ack-rec-p) + (or exts (helm-grep-get-file-extensions targets)))) + (include-files + (and exts + (mapconcat (lambda (x) + (concat "--include=" + (shell-quote-argument x))) + (if (> (length exts) 1) + (remove "*" exts) + exts) " "))) + (types (and (not include-files) + (not (eq backend 'zgrep)) + recurse + ack-rec-p + ;; When %e format spec is not specified + ;; ignore types and do not prompt for choice. + (string-match "%e" helm-grep-default-command) + (helm-grep-read-ack-type))) + (src-name (capitalize (helm-grep-command recurse backend))) + (com (cond ((eq backend 'zgrep) helm-default-zgrep-command) + ((eq backend 'git) helm-grep-git-grep-command) + (recurse helm-grep-default-recurse-command) + ;; When resuming, the local value of + ;; `helm-grep-default-command' is used, only git-grep + ;; should need this. + (t helm-grep-default-command)))) + ;; When called as action from an other source e.g *-find-files + ;; we have to kill action buffer. + (when (get-buffer helm-action-buffer) + (kill-buffer helm-action-buffer)) + ;; If `helm-find-files' haven't already started, + ;; give a default value to `helm-ff-default-directory' + ;; and set locally `default-directory' to this value . See below [1]. + (unless helm-ff-default-directory + (setq helm-ff-default-directory default-directory)) + ;; We need to store these vars locally + ;; to pass infos later to `helm-resume'. + (helm-set-local-variable + 'helm-zgrep-recurse-flag (and recurse (eq backend 'zgrep)) + 'helm-grep-last-targets targets + 'helm-grep-include-files (or include-files types) + 'helm-grep-in-recurse recurse + 'helm-grep-use-zgrep (eq backend 'zgrep) + 'helm-grep-default-command com + 'helm-input-idle-delay helm-grep-input-idle-delay + 'default-directory helm-ff-default-directory) ;; [1] + ;; Setup the source. + (set source (helm-make-source src-name 'helm-grep-class + :header-name (and (eq backend 'git) + (lambda (name) + (format "%s [%s]" + name + (abbreviate-file-name + helm-ff-default-directory)))) + :backend backend + :pcre (string-match-p "\\`ack" com))) + (helm + :sources source + :buffer (format "*helm %s*" (helm-grep-command recurse backend)) + :default default-input + :input input + :keymap helm-grep-map + :history 'helm-grep-history + :truncate-lines helm-grep-truncate-lines))) + + +;;; zgrep +;; +;; +(defun helm-ff-zgrep-1 (flist recursive) + (unwind-protect + (let* ((def-dir (or helm-ff-default-directory + default-directory)) + (only (if recursive + (or (gethash def-dir helm-rzgrep-cache) + (puthash + def-dir + (helm-walk-directory + def-dir + :directories nil + :path 'full + :match helm-zgrep-file-extension-regexp) + helm-rzgrep-cache)) + flist))) + (helm-do-grep-1 only recursive 'zgrep)) + (setq helm-zgrep-recurse-flag nil))) + + +;;; transformers +;; +;; +(defun helm-grep-split-line (line) + "Split a grep output line." + ;; The output of grep may send a truncated line in this chunk, + ;; so don't split until grep line is valid, that is + ;; once the second part of the line comes with next chunk + ;; send by process. + (when (string-match helm-grep-split-line-regexp line) + ;; Don't use split-string because buffer/file name or string + ;; may contain a ":". + (cl-loop for n from 1 to 3 collect (match-string n line)))) + +(defun helm-grep--filter-candidate-1 (candidate &optional dir pcre) + (let* ((root (or dir (and helm-grep-default-directory-fn + (funcall helm-grep-default-directory-fn)))) + (ansi-p (string-match-p helm--ansi-color-regexp candidate)) + (line (if ansi-p (ansi-color-apply candidate) candidate)) + (split (helm-grep-split-line line)) + (fname (if (and root split) + ;; Filename should always be provided as a local + ;; path, if the root directory is remote, the + ;; tramp prefix will be added before executing + ;; action, see `helm-grep-action' and Bug#2032. + (expand-file-name (car split) + (or (file-remote-p root 'localname) + root)) + (car-safe split))) + (lineno (nth 1 split)) + (str (nth 2 split)) + (display-fname (cl-ecase helm-grep-file-path-style + (basename (and fname (file-name-nondirectory fname))) + (absolute fname) + (relative (and fname root + (file-relative-name fname root)))))) + (if (and display-fname lineno str) + (cons (concat (propertize display-fname + 'face 'helm-grep-file + 'help-echo (abbreviate-file-name fname) + 'helm-grep-fname fname) + ":" + (propertize lineno 'face 'helm-grep-lineno) + ":" + (if ansi-p str (helm-grep-highlight-match str pcre))) + line) + ""))) + +(defun helm-grep-filter-one-by-one (candidate &optional pcre) + "`filter-one-by-one' transformer function for `helm-do-grep-1'." + (let ((helm-grep-default-directory-fn + (or helm-grep-default-directory-fn + (lambda () (or helm-ff-default-directory + (and helm-alive-p + (helm-default-directory)) + default-directory))))) + (if (consp candidate) + ;; Already computed do nothing (default as input). + candidate + (and (stringp candidate) + (helm-grep--filter-candidate-1 candidate nil pcre))))) + +(defun helm-grep-popup-info-fn (_candidate) + (helm-aif (get-text-property (pos-bol) 'helm-grep-fname) + (abbreviate-file-name it))) + +(defun helm-grep-fc-transformer (candidates source) + (let ((helm-grep-default-directory-fn + (or helm-grep-default-directory-fn + (lambda () (or helm-ff-default-directory + (and (null (eq major-mode 'helm-grep-mode)) + (helm-default-directory)) + default-directory)))) + (pcre (helm-get-attr 'pcre source))) + (cl-loop for c in candidates + collect (helm-grep--filter-candidate-1 c nil pcre)))) + +(defun helm-grep-highlight-match (str &optional pcre) + "Highlight in string STR all occurences matching `helm-pattern'." + (let (beg end) + (condition-case-unless-debug nil + (with-temp-buffer + (insert (propertize str 'read-only nil)) ; Fix bug#1176 + (goto-char (point-min)) + (cl-loop for reg in + (cl-loop for r in (helm-mm-split-pattern + helm-input) + unless (string-match "\\`!" r) + collect + (helm-aif (and helm-migemo-mode + (assoc r helm-mm--previous-migemo-info)) + (cdr it) r)) + do + (while (and (re-search-forward + (if pcre + (helm--translate-pcre-to-elisp reg) + reg) + nil t) + (> (- (setq end (match-end 0)) + (setq beg (match-beginning 0))) + 0)) + (helm-add-face-text-properties beg end 'helm-grep-match)) + do (goto-char (point-min))) + (buffer-string)) + (error nil)))) + + +;;; Grep from buffer list +;; +;; +(defun helm-grep-buffers-1 (candidate &optional zgrep) + "Run grep on all file buffers or CANDIDATE if it is a file buffer. +If one of selected buffers is not a file buffer, it is ignored +and grep will run on all others file-buffers. +If only one candidate is selected and it is not a file buffer, +switch to this buffer and run `helm-occur'. +If a prefix arg is given run grep on all buffers ignoring +non-file buffers." + (let* ((prefarg (or current-prefix-arg helm-current-prefix-arg)) + (helm-ff-default-directory + (if (and helm-ff-default-directory + (file-remote-p helm-ff-default-directory)) + default-directory + helm-ff-default-directory)) + (cands (if prefarg + (buffer-list) + (helm-marked-candidates))) + (win-conf (current-window-configuration)) + ;; Non--fname and remote buffers are ignored. + (bufs (cl-loop for buf in cands + for fname = (buffer-file-name (get-buffer buf)) + when (and fname (not (file-remote-p fname))) + collect (expand-file-name fname)))) + (if bufs + (if zgrep + (helm-do-grep-1 bufs nil 'zgrep) + (helm-do-grep-1 bufs)) + ;; bufs is empty, thats mean we have only CANDIDATE + ;; and it is not a buffer-filename, fallback to occur. + (switch-to-buffer candidate) + (when (get-buffer helm-action-buffer) + (kill-buffer helm-action-buffer)) + (helm-occur) + (when (eq helm-exit-status 1) + (set-window-configuration win-conf))))) + +(defun helm-grep-buffers (candidate) + "Action to grep buffers." + (helm-grep-buffers-1 candidate)) + +(defun helm-zgrep-buffers (candidate) + "Action to zgrep buffers." + (helm-grep-buffers-1 candidate 'zgrep)) + + +;;; Helm interface for pdfgrep +;; pdfgrep program +;; and a pdf-reader (e.g xpdf) are needed. +;; +(defvar helm-pdfgrep-default-function 'helm-pdfgrep-init) +(defun helm-pdfgrep-init (only-files &optional recurse) + "Start an asynchronous pdfgrep process in ONLY-FILES list." + (let* ((default-directory (or helm-ff-default-directory + default-directory)) + (fnargs (helm-grep-prepare-candidates + (if (file-remote-p default-directory) + (mapcar (lambda (x) + (file-remote-p x 'localname)) + only-files) + only-files) + default-directory)) + (cmd-line (format (if recurse + helm-pdfgrep-default-recurse-command + helm-pdfgrep-default-command) + helm-pattern + fnargs)) + process-connection-type) + ;; Start pdf grep process. + (helm-log "helm-pdfgrep-init" "Starting Pdf Grep process in directory `%s'" default-directory) + (helm-log "helm-pdfgrep-init" "Command line used was:\n\n%s" + (concat ">>> " (propertize cmd-line 'face 'helm-grep-cmd-line) "\n\n")) + (prog1 + (start-file-process-shell-command + "pdfgrep" helm-buffer cmd-line) + (message nil) + (set-process-sentinel + (get-buffer-process helm-buffer) + (lambda (process event) + (if (or (string= event "finished\n") + (process-get process 'reach-limit)) + (with-helm-window + (setq mode-line-format + '(" " mode-line-buffer-identification " " + (:eval (format "L%s" (helm-candidate-number-at-point))) " " + (:eval (propertize + (format "[Pdfgrep Process Finish - %s result(s)] " + (max (1- (count-lines + (point-min) (point-max))) 0)) + 'face 'helm-grep-finish)))) + (force-mode-line-update) + (when helm-allow-mouse + (helm--bind-mouse-for-selection helm-selection-point))) + (helm-log "helm-pdfgrep-init" "Error: Pdf grep %s" + (replace-regexp-in-string "\n" "" event)))))))) + +(defun helm-do-pdfgrep-1 (only &optional recurse) + "Launch pdfgrep with a list of ONLY files." + (unless (executable-find "pdfgrep") + (error "Error: No such program `pdfgrep'.")) + (let (helm-grep-in-recurse) ; recursion is implemented differently in *pdfgrep. + ;; When called as action from an other source e.g *-find-files + ;; we have to kill action buffer. + (when (get-buffer helm-action-buffer) + (kill-buffer helm-action-buffer)) + (setq helm-pdfgrep-targets only) + (helm + :sources (helm-build-async-source "PdfGrep" + :init (lambda () + ;; If `helm-find-files' haven't already started, + ;; give a default value to `helm-ff-default-directory'. + (setq helm-ff-default-directory (or helm-ff-default-directory + default-directory))) + :candidates-process (lambda () + (funcall helm-pdfgrep-default-function + helm-pdfgrep-targets recurse)) + :nohighlight t + :nomark t + :filter-one-by-one #'helm-grep-filter-one-by-one + :history 'helm-grep-history + :keymap helm-pdfgrep-map + :help-message 'helm-pdfgrep-help-message + :action #'helm-pdfgrep-action + :persistent-help "Jump to PDF Page" + :requires-pattern 2) + :buffer "*helm pdfgrep*" + :history 'helm-grep-history))) + +(defun helm-pdfgrep-action (candidate) + (helm-grep-action candidate 'pdf)) + +(defun helm-pdfgrep-action-1 (_split pageno fname) + (save-selected-window + (start-file-process-shell-command + "pdf-reader" nil + (format-spec helm-pdfgrep-default-read-command + (list (cons ?f fname) (cons ?p pageno)))))) + +;;; AG - PT - RG +;; +;; https://github.com/ggreer/the_silver_searcher +;; https://github.com/monochromegane/the_platinum_searcher +;; https://github.com/BurntSushi/ripgrep + +(defun helm-grep--ag-command () + (and helm-grep-ag-command + (car (helm-remove-if-match + ;; Probably an env var added at beginning of command line. + "\\`[A-Z]*=" (split-string helm-grep-ag-command))))) + +(defun helm-grep-ag-get-types () + "Returns a list of AG types if available with AG version. +See AG option \"--list-file-types\" +Ripgrep (rg) types are also supported if this backend is used." + (with-temp-buffer + (let* ((com (helm-grep--ag-command)) + (ripgrep (string= com "rg")) + (regex (if ripgrep "^\\(.*\\):" "^ *\\(--[a-z]*\\)")) + (prefix (if ripgrep "-t " ""))) + (when (zerop (call-process com nil t nil + (if ripgrep + "--type-list" + "--list-file-types"))) + (goto-char (point-min)) + (cl-loop while (re-search-forward regex nil t) + for type = (match-string 1) + collect (cons type (concat prefix type))))))) + +(defun helm-grep-ag-prepare-cmd-line (pattern directory &optional type) + "Prepare AG command line to search PATTERN in DIRECTORY. +When TYPE is specified it is one of what `helm-grep-ag-get-types' +returns if available with current AG version." + (let* ((patterns (helm-mm-split-pattern pattern t)) + (pipe-switches (mapconcat 'identity helm-grep-ag-pipe-cmd-switches " ")) + (pipe-cmd (helm-acase (helm-grep--ag-command) + (("ag" "pt") + (format "%s -S --color%s" it (concat " " pipe-switches))) + ("rg" (format "rg -N -S --color=%s%s" + (when (string-match "--color=\\([a-z]+\\) " + helm-grep-ag-command) + (match-string 1 helm-grep-ag-command)) + (concat " " pipe-switches))))) + (cmd (format helm-grep-ag-command + (mapconcat 'identity type " ") + (shell-quote-argument (car patterns)) + (shell-quote-argument directory)))) + (helm-aif (cdr patterns) + (concat cmd (cl-loop for p in it concat + (format " | %s -- %s" + pipe-cmd (shell-quote-argument p)))) + cmd))) + +(defun helm-grep-ag-init (directory &optional type) + "Start AG process in DIRECTORY maybe searching only files of type TYPE." + (let* ((default-directory (or helm-ff-default-directory + (helm-default-directory) + default-directory)) + (cmd-line (helm-grep-ag-prepare-cmd-line + ;; NOTE Encode directory name and pattern, + ;; or it may not work with Chinese and maybe other non-utf8 + ;; characters on MSWindows systems issue#2677 and issue#2678. + (encode-coding-string helm-pattern locale-coding-system) + (or (file-remote-p directory 'localname) + (encode-coding-string directory locale-coding-system)) + type)) + (start-time (float-time)) + (proc-name (helm-grep--ag-command)) + ;; Fix error in MacOS with process-buffer deleted resulting in a nil + ;; helm-window (with-helm-window) in sentinel see issue#2741. + (process-connection-type (string= proc-name "ag"))) + (set (make-local-variable 'helm-grep-last-cmd-line) cmd-line) + (helm-log "helm-grep-ag-init" "Starting %s process in directory `%s'" + proc-name directory) + (helm-log "helm-grep-ag-init" "Command line used was:\n\n%s" + (concat ">>> " cmd-line "\n\n")) + (prog1 + (start-file-process-shell-command + proc-name helm-buffer cmd-line) + (set-process-sentinel + (get-buffer-process helm-buffer) + (lambda (process event) + (let* ((err (process-exit-status process)) + (noresult (= err 1))) + (cond (noresult + (with-helm-buffer + (insert (concat "* Exit with code 1, no result found," + " command line was:\n\n " + (propertize helm-grep-last-cmd-line + 'face 'helm-grep-cmd-line))) + (setq mode-line-format + `(" " mode-line-buffer-identification " " + (:eval (format "L%s" (helm-candidate-number-at-point))) " " + (:eval (propertize + (format + "[%s process finished - (no results)] " + ,(upcase proc-name)) + 'face 'helm-grep-finish)))))) + ((or (string= event "finished\n") + (process-get process 'reach-limit)) + (helm-log "helm-grep-ag-init" "%s process finished with %s results in %fs" + proc-name + (helm-get-candidate-number) + (- (float-time) start-time)) + (helm-maybe-show-popup-tip-info) + (with-helm-window + (setq mode-line-format + `(" " mode-line-buffer-identification " " + (:eval (format "L%s" (helm-candidate-number-at-point))) " " + (:eval (propertize + (format + "[%s process finished in %.2fs - (%s results)] " + ,(upcase proc-name) + ,(- (float-time) start-time) + (helm-get-candidate-number)) + 'face 'helm-grep-finish)))) + (force-mode-line-update) + (when helm-allow-mouse + (helm--bind-mouse-for-selection helm-selection-point)))) + (t (helm-log + "helm-grep-ag-init" + "Error: %s %s" + proc-name + (replace-regexp-in-string "\n" "" event)))))))))) + +(defun helm-grep-ag-search-results (_candidate) + "Launch a new helm session on the current results. +Allow narrowing the grep ag results to a specific file or pattern without +continuing calling grep ag, i.e. once called, what you type in minibuffer will be +searched with helm match functions in all the candidates found previously by +grep ag." + (with-helm-buffer + (let* ((src (helm-get-current-source)) + (candidates (nthcdr 1 (split-string + (buffer-substring-no-properties + (point-min) (point-max)) + "\n"))) + (transfo (helm-get-attr 'filtered-candidate-transformer src)) + (actions helm-grep-actions) + (name (helm-get-attr 'name src)) + (directory (helm-get-attr 'directory src))) + (helm :sources (helm-build-sync-source (format "Search in %s" name) + :candidates candidates + :keymap 'helm-grep-map + :candidate-transformer + (lambda (candidates) + (let ((helm-grep-default-directory-fn + (lambda () directory))) + (funcall transfo candidates nil))) + :action actions) + :buffer "*helm search ag*")))) + +(helm-make-command-from-action helm-grep-ag-run-search-results + "Run `helm-grep-ag-search-results' action." 'helm-grep-ag-search-results) + +(defvar helm-grep-ag-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-grep-map) + (define-key map (kbd "C-s") 'helm-grep-run-ag-grep-parent-directory) + (define-key map (kbd "C-c s") 'helm-grep-ag-run-search-results) + map)) + +(defclass helm-grep-ag-class (helm-source-async) + ((nohighlight :initform t) + (pcre :initarg :pcre :initform t + :documentation + " Backend is using pcre regexp engine when non--nil.") + (keymap :initform 'helm-grep-ag-map) + (history :initform 'helm-grep-ag-history) + (help-message :initform 'helm-grep-help-message) + (filtered-candidate-transformer :initform #'helm-grep-fc-transformer) + (popup-info :initform #'helm-grep-popup-info-fn) + (persistent-action :initform 'helm-grep-persistent-action) + (persistent-help :initform "Jump to line (`C-u' Record in mark ring)") + (directory :initarg :directory :initform nil + :documentation + " Directory currently searched.") + (requires-pattern :initform 2) + (nomark :initform t) + (action :initform 'helm-grep-actions) + (find-file-target :initform #'helm-grep-quit-an-find-file-fn) + (group :initform 'helm-grep))) + +(defvar helm-source-grep-ag nil) + +(defun helm-grep-ag-1 (directory &optional type input default) + "Start helm ag in DIRECTORY maybe searching in files of type TYPE. +Arg DEFAULT is what you will have with `next-history-element', +arg INPUT is what you will have by default at prompt on startup." + (setq helm-source-grep-ag + (helm-make-source (upcase (helm-grep--ag-command)) 'helm-grep-ag-class + :header-name (lambda (name) + (format "%s [%s]" + name (abbreviate-file-name directory))) + :directory directory + :action (append helm-grep-actions + `((,(format "%s grep parent directory" + (upcase (helm-grep--ag-command))) + . helm-grep-ag-grep-parent-directory) + (,(format "Search results in grep %s buffer" + (upcase (helm-grep--ag-command))) + . helm-grep-ag-search-results))) + :candidates-process + (lambda () (helm-grep-ag-init directory type)))) + (helm-set-local-variable 'helm-input-idle-delay helm-grep-input-idle-delay) + (helm :sources 'helm-source-grep-ag + :history 'helm-grep-ag-history + :input input + :default default + :truncate-lines helm-grep-truncate-lines + :buffer (format "*helm %s*" (helm-grep--ag-command)))) + +(defun helm-grep-ag-grep-parent-directory (_candidate) + "Restart helm-grep-ag in the parent of the currently searched directory." + (let* ((src (with-helm-buffer (car helm-sources))) + (directory (helm-basedir (helm-get-attr 'directory src) t)) + (input helm-pattern)) + (helm-grep-ag-1 directory nil input))) + +(helm-make-command-from-action helm-grep-run-ag-grep-parent-directory + "Ag grep parent directory." 'helm-grep-ag-grep-parent-directory) + +(defun helm-grep-ag (directory with-types) + "Start grep AG in DIRECTORY. +When WITH-TYPES is non-nil provide completion on AG types." + (require 'helm-adaptive) + (let ((com (capitalize (helm-grep--ag-command)))) + (helm-grep-ag-1 directory + (helm-aif (and with-types + (helm-grep-ag-get-types)) + (helm-comp-read + (format "%s type: " com) it + :must-match t + :marked-candidates t + :fc-transformer 'helm-adaptive-sort + :buffer (format "*helm %s types*" com)))))) + +;;; Git grep +;; +;; +(defvar helm-source-grep-git nil) + +(defun helm-grep-git-1 (directory &optional all default input) + "Run git-grep on DIRECTORY. +If DIRECTORY is not inside or part of a git repo exit with error. +If optional arg ALL is non-nil grep the whole repo otherwise +start at DIRECTORY. +Arg DEFAULT is what you will have with `next-history-element', +arg INPUT is what you will have by default at prompt on startup." + (require 'vc) + (let* (helm-grep-default-recurse-command + ;; Expand filename of each candidate with the git root dir. + ;; The filename will be in the helm-grep-fname prop. + (helm-grep-default-directory-fn (lambda () + (vc-find-root directory ".git"))) + (helm-ff-default-directory (funcall helm-grep-default-directory-fn))) + (cl-assert helm-ff-default-directory nil "Not inside a Git repository") + (helm-do-grep-1 (if all '("") `(,(expand-file-name directory))) + nil 'git nil default input 'helm-source-grep-git))) + + +;;;###autoload +(defun helm-do-grep-ag (arg) + "Preconfigured `helm' for grepping with AG in `default-directory'. +With prefix arg prompt for type if available with your AG +version." + (interactive "P") + (require 'helm-files) + (helm-grep-ag (expand-file-name default-directory) arg)) + +;;;###autoload +(defun helm-do-grep-ag-project (arg) + "Preconfigured `helm' for grepping with AG from the current project root. +If no project found use `default-directory'. +With prefix arg prompt for type if available with your AG version." + (interactive "P") + (require 'helm-files) + (require 'project) + (let ((project-root (helm-acase (project-current) + ;; vc returns (type backend path). + ((dst* (_type _backend path)) path) + ;; projectile returns (type . path). + ((dst* (_type . path)) path) + (t default-directory)))) + (helm-grep-ag (expand-file-name project-root) arg))) + +;;;###autoload +(defun helm-grep-do-git-grep (arg) + "Preconfigured `helm' for git-grepping `default-directory'. +With a prefix arg ARG git-grep the whole repository." + (interactive "P") + (require 'helm-files) + (helm-grep-git-1 default-directory arg)) + + +(provide 'helm-grep) + +;;; helm-grep.el ends here diff --git a/elpa/helm-20260424.1357/helm-help.el b/elpa/helm-20260424.1357/helm-help.el new file mode 100644 index 00000000..205cb5bd --- /dev/null +++ b/elpa/helm-20260424.1357/helm-help.el @@ -0,0 +1,2656 @@ +;;; helm-help.el --- Help messages for Helm. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2026 Thierry Volpiatto + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Code: +(require 'helm) + + +(defgroup helm-help nil + "Embedded help for `helm'." + :group 'helm) + +(defface helm-helper + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :inherit helm-header)) + "Face for Helm help string in minibuffer." + :group 'helm-help) + +(defvar helm-help--string-list '(helm-help-message + helm-buffer-help-message + helm-ff-help-message + helm-read-file-name-help-message + helm-generic-file-help-message + helm-fd-help-message + helm-grep-help-message + helm-pdfgrep-help-message + helm-etags-help-message + helm-ucs-help-message + helm-bookmark-help-message + helm-esh-help-message + helm-buffers-ido-virtual-help-message + helm-moccur-help-message + helm-top-help-message + helm-M-x-help-message + helm-imenu-help-message + helm-colors-help-message + helm-semantic-help-message + helm-kmacro-help-message + helm-kill-ring-help-message) + "A list of help messages (strings) used by `helm-documentation'.") + +(defvar helm-documentation-buffer-name "*helm documentation*") + +;;;###autoload +(defun helm-documentation () + "Preconfigured `helm' for Helm documentation. +With a prefix arg refresh the documentation. + +Find here the documentation of all documented sources." + (interactive) + (let ((buf (get-buffer-create helm-documentation-buffer-name))) + (switch-to-buffer buf) + (set-buffer buf) + (let ((inhibit-read-only t)) + (erase-buffer) + (save-excursion + (cl-loop for elm in helm-help--string-list + for str = (helm-interpret-value elm) + do (insert (substitute-command-keys str) "\n\n"))) + (org-mode)) + (setq buffer-read-only t) + (view-mode))) + + +;;; Local help messages. + +;;; `helm-buffer-list' help +;; +;; +(defvar helm-buffer-help-message + "* Helm Buffer + +** Tips + +*** Completion + +**** Major-mode + +You can enter a partial major-mode name (e.g. lisp, sh) to narrow down buffers. +To specify the major-mode, prefix it with \"*\" e.g. \"*lisp\". + +If you want to match all buffers but the ones with a specific major-mode +\(negation), prefix the major-mode with \"!\" e.g. \"*!lisp\". + +If you want to specify more than one major-mode, separate them with \",\", +e.g. \"*!lisp,!sh,!fun\" lists all buffers but the ones in lisp-mode, sh-mode +and fundamental-mode. + +Then enter a space followed by a pattern to narrow down to buffers matching this +pattern. + +**** Search inside buffers + +If you enter a space and a pattern prefixed by \"@\", Helm searches for text +matching this pattern *inside* the buffer (i.e. not in the name of the buffer). + +Negation are supported i.e. \"!\". + +When you specify more than one of such patterns, it will match +buffers with contents matching each of these patterns i.e. AND, +not OR. That means that if you specify \"@foo @bar\" the contents +of buffer will have to be matched by foo AND bar. If you specify +\"@foo @!bar\" it means the contents of the buffer have to be +matched by foo but NOT bar. + +If you enter a pattern prefixed with an escaped \"@\", Helm searches for a +buffer matching \"@pattern\" but does not search inside the buffer. + +**** Search by directory name + +If you prefix the pattern with \"/\", Helm matches over the directory names +of the buffers. + +This feature can be used to narrow down the search to one directory while +subsequent strings entered after a space match over the buffer name only. + +Note that negation is not supported for matching on buffer filename. + +Starting from Helm v1.6.8, you can specify more than one directory. + +**** Fuzzy matching + +`helm-buffers-fuzzy-matching' turns on fuzzy matching on buffer +names, but not on directory names or major modes. A pattern +starting with \"^\" disables fuzzy matching and matching is done +litteraly IOW do not use regexps (\"^\" or whatever special +regexp character) when you want to fuzzy match. + +**** Examples + +With the following pattern + + \"*lisp ^helm @moc\" + +Helm narrows down the list by selecting only the buffers that are in lisp mode, +start with \"helm\" and which content matches \"moc\". + +Without the \"@\" + + \"*lisp ^helm moc\" + +Helm looks for lisp mode buffers starting with \"helm\" and containing \"moc\" +in their name. + +With this other pattern + + \"*!lisp !helm\" + +Helm narrows down to buffers that are not in \"lisp\" mode and that do not match +\"helm\". + +With this last pattern + + /helm/ w3 + +Helm narrows down to buffers that are in any \"helm\" subdirectory and +matching \"w3\". + +*** Creating buffers + +When creating a new buffer, use `\\[universal-argument]' to choose a mode from a +list. This list is customizable, see `helm-buffers-favorite-modes'. + +*** Killing buffers + +You can kill buffers either one by one or all the marked buffers at once. + +One kill-buffer command leaves Helm while the other is persistent. Run the +persistent kill-buffer command either with the regular +`helm-execute-persistent-action' called with a prefix argument (`\\[universal-argument] \\\\[helm-execute-persistent-action]') +or with its specific command `helm-buffer-run-kill-persistent'. See the +bindings below. + +*** Switching to buffers + +To switch to a buffer, press RET, to switch to a buffer in another window, select this buffer +and press \\\\[helm-buffer-switch-other-window], when called with a prefix arg +the buffer will be displayed vertically in other window. +If you mark more than one buffer, the marked buffers will be displayed in different windows. + +*** Saving buffers + +If buffer is associated to a file and is modified, it is by default colorized in orange, +see [[Meaning of colors and prefixes for buffers][Meaning of colors and prefixes for buffers]]. +You can save these buffers with \\\\[helm-buffer-save-persistent]. +If you want to save all these buffers, you can mark them with \\[helm-buffers-mark-similar-buffers] +and save them with \\[helm-buffer-save-persistent]. You can also do this in one step with +\\[helm-buffer-run-save-some-buffers]. Note that you will not be asked for confirmation. + +*** Meaning of colors and prefixes for buffers + +Remote buffers are prefixed with '@'. +Red => Buffer's file was modified on disk by an external process. +Indianred2 => Buffer exists but its file has been deleted. +Orange => Buffer is modified and not saved to disk. +Italic => A non-file buffer. +Yellow => Tramp archive buffer. +DimGray => Indirect buffer. + +** Commands +\\ +|Keys|Description| +|-------------+----------| +|\\[helm-buffer-run-zgrep]|Grep Buffer(s) works as zgrep too (`\\[universal-argument]' to grep all buffers but non-file buffers). +|\\[helm-buffers-run-occur]|Multi-Occur buffer or marked buffers (`\\[universal-argument]' to toggle force-searching current-buffer). +|\\[helm-buffer-switch-other-window]|Switch to other window. +|\\[helm-buffer-switch-other-frame]|Switch to other frame. +|\\[helm-buffers-run-browse-project]|Browse project from buffer. +|\\[helm-buffer-run-query-replace-regexp]|Query-replace-regexp in marked buffers. +|\\[helm-buffer-run-query-replace]|Query-replace in marked buffers. +|\\[helm-buffer-run-ediff]|Ediff current buffer with candidate. With two marked buffers, ediff those buffers. +|\\[helm-buffer-run-ediff-merge]|Ediff-merge current buffer with candidate. With two marked buffers, ediff-merge those buffers. +|\\[helm-buffer-diff-persistent]|Toggle Diff-buffer with saved file without leaving Helm. +|\\[helm-buffer-revert-persistent]|Revert buffer without leaving Helm. +|\\[helm-buffer-save-persistent]|Save buffer without leaving Helm. +|\\[helm-buffer-run-save-some-buffers]|Save all unsaved buffers. +|\\[helm-buffer-run-kill-buffers]|Delete marked buffers and leave Helm. +|\\[helm-buffer-run-kill-persistent]|Delete buffer without leaving Helm. +|\\[helm-buffer-run-rename-buffer]|Rename buffer. +|\\[helm-toggle-all-marks]|Toggle all marks. +|\\[helm-mark-all]|Mark all. +|\\[helm-toggle-buffers-details]|Toggle details. +|\\[helm-buffers-toggle-show-hidden-buffers]|Show hidden buffers. +|\\[helm-buffers-mark-similar-buffers]|Mark all buffers of the same type (color) as current buffer.") + +;;; Find files help (`helm-find-files') +;; +;; +(defvar helm-ff-help-message + "* Helm Find Files + +** Tips + +*** Navigation summary + +For a better experience you can enable auto completion by setting +`helm-ff-auto-update-initial-value' to non-nil in your init file. It is not +enabled by default to not confuse new users. + +**** Navigate with arrow keys + +You can use and arrows to go down or up one level, to disable +this customize `helm-ff-lynx-style-map'. +Note that using `setq' will NOT work. + +**** Use `\\\\[helm-execute-persistent-action]' (persistent action) on a directory to go down one level + +On a symlinked directory a prefix argument expands to its true name. + +**** Use `\\\\[helm-find-files-up-one-level]' or `DEL' on a directory to go up one level + +***** `DEL' behavior + +`DEL' by default deletes char backward. + +But when `helm-ff-DEL-up-one-level-maybe' is non nil `DEL' behaves +differently depending on the contents of helm-pattern. It goes up one +level if the pattern is a directory ending with \"/\" or disables HFF +auto update and delete char backward if the pattern is a filename or +refers to a non existing path. Going up one level can be disabled +if necessary by deleting \"/\" at the end of the pattern using +\\\\[backward-char] and \\[helm-delete-minibuffer-contents]. + +Note that when deleting char backward, Helm takes care of +disabling update giving you the opportunity to edit your pattern for +e.g. renaming a file or creating a new file or directory. +When `helm-ff-auto-update-initial-value' is non nil you may want to +disable it temporarily, see [[Toggle auto-completion][Toggle auto-completion]] for this. + +**** Use `\\\\[helm-find-files-down-last-level]' to walk back the resulting tree of all the `\\\\[helm-find-files-up-one-level]' or DEL you did + +The tree is reinitialized each time you browse a new tree with +`\\\\[helm-execute-persistent-action]' or by entering some pattern in the prompt. + +**** `RET' behavior + +It behaves differently depending on `helm-selection' (current candidate in helm-buffer): + +- candidate basename is \".\" => Open it in dired. +- candidate is a directory => Expand it. +- candidate is a file => Open it. + +If you have marked candidates and you press RET on a directory, +Helm will navigate to this directory. If you want to exit with +RET with default action with these marked candidates, press RET a +second time while you are on the root of this directory e.g. +\"/home/you/dir/.\" or press RET on any file which is not a +directory. You can also exit with default action at any moment +with `f1'. + +Note that when copying, renaming, etc. from `helm-find-files' the +destination file is selected with `helm-read-file-name'. + +**** `TAB' behavior + +Normally `TAB' is bound to `helm-select-action' in helm-map which +display the action menu. + +You can change this behavior by setting in `helm-find-files-map' +a new command for `TAB': + + (define-key helm-find-files-map (kbd \"C-i\") 'helm-ff-TAB) + +It will then behave slighly differently depending of +`helm-selection': + +- candidate basename is \".\" => open the action menu. +- candidate is a directory => expand it (behave as \\\\[helm-execute-persistent-action]). +- candidate is a file => open action menu. + +Called with a prefix arg open menu unconditionally. + +*** Show information on files (permissions etc...) + +Turn on `helm-popup-tip-mode'. + +*** Filter out files or directories + +You can show files or directories only with respectively +\\\\[helm-ff-toggle-dirs-only] and \\\\[helm-ff-toggle-files-only]. +These are toggle commands i.e. filter/show_all. +Changing directory disable filtering. + +*** Sort directory contents + +When listing a directory without narrowing its contents, i.e. when pattern ends with \"/\", +you can sort alphabetically, by newest or by size by using respectively +\\\\[helm-ff-sort-alpha], \\[helm-ff-sort-by-newest] or \\[helm-ff-sort-by-size]. +NOTE: +When starting back narrowing i.e. entering something in minibuffer after \"/\" sorting is done +again with fuzzy sorting and no more with sorting methods previously selected. + +You can use these sort functions only on files or directory, +see [[Filter out files or directories][Filter out files or directories]]. + +*** Find file at point + +Helm uses `ffap' partially or completely to find file at point depending on the +value of `helm-ff-guess-ffap-filenames': if non-nil, support is complete +\(annoying), if nil, support is partial. + +Note that when the variable +`helm-ff-allow-non-existing-file-at-point' is non nil Helm will +insert the filename at point even if file with this name doesn't +exists. If non existing file at point ends with numbers prefixed +with \":\" the \":\" and numbers are stripped. + +**** Find file at line number + +When text at point is in the form of + + ~/elisp/helm/helm.el:1234 + +Helm finds this file at the indicated line number, here 1234. + +**** Find URL at point + +When a URL is found at point, Helm expands to that URL only. +Pressing `RET' opens that URL using `browse-url-browser-function'. + +**** Find e-mail address at point + +When an e-mail address is found at point, Helm expands to this e-mail address +prefixed with \"mailto:\". Pressing `RET' opens a message buffer with that +e-mail address. + +*** Quick pattern expansion + +**** Enter `~/' at end of pattern to quickly reach home directory + +**** Enter `/' at end of pattern to quickly reach the file system root + +**** Enter `./' at end of pattern to quickly reach `default-directory' + +\(As per its value at the beginning of the session.) + +If you already are in the `default-directory' this will move the cursor to the top. + +**** Enter `../' at end of pattern will reach upper directory, moving cursor to the top + +This is different from using `\\\\[helm-find-files-up-one-level]' in that it moves +the cursor to the top instead of remaining on the previous subdir name. + +**** Enter `..name/' at end of pattern to start a recursive search + +It searches directories matching \"name\" under the current directory, +see the [[Recursive completion on subdirectories][Recursive completion on subdirectories]] section below for more details. + +**** Any environment variable (e.g. `$HOME') at end of pattern gets expanded + +**** Any valid filename yanked after pattern gets expanded + +**** Special case: URL at point + +The quick expansions do not take effect after end a URL, you must kill the +pattern first (`\\[helm-delete-minibuffer-contents]'). + +*** Helm-find-files supports fuzzy matching + +It starts from the third character of the pattern. + +For instance \"fob\" or \"fbr\" will complete \"foobar\" but \"fb\" needs a +third character in order to complete it. + +*** Watch briefly files contents while navigating + +You can use `\\[helm-execute-persistent-action]' on a filename for this, then: + +- First hit expands to that filename in the Helm buffer. +- Second hit displays the buffer filename. +- Third hit kills the buffer filename. + +Note: `\\[universal-argument] \\[helm-execute-persistent-action]' displays the buffer directly. + +*** Browse images directories with `helm-follow-mode' and navigate up/down + +Before Emacs-27 Helm was using image-dired that works with +external ImageMagick tools. From Emacs-27 Helm use native +display of images with image-mode by default for Emacs-27 (see `helm-ff-display-image-native'), +this allows automatic resize when changing window size, zooming with `\\[helm-ff-increase-image-size-persistent]' and `\\[helm-ff-decrease-image-size-persistent]' +and rotate images as before. + +You can also use `helm-follow-action-forward' and `helm-follow-action-backward' with +`\\[helm-follow-action-forward]' and `\\[helm-follow-action-backward]' respectively. +Note that these commands have different behavior when `helm-follow-mode' +is enabled (go to next/previous line only). + +Use `\\[universal-argument] \\[helm-execute-persistent-action]' to display an image or kill its buffer. + +TIP: Use `\\\\[helm-toggle-resplit-and-swap-windows]' and `\\[helm-enlarge-window]' to display Helm window vertically +and to enlarge it while viewing images. +Note this may not work with exotic Helm windows settings such as the ones in Spacemacs. + +**** Show thumbnails + +Helm use image-dired to show thumbnails on image files, you can +toggle the thumbnail view with \\`\\[helm-ff-toggle-thumbnails]'. + +**** Launch a slideshow from marked files + +Helm provides an action from `helm-find-files' that allows +running a slideshow on marked files. Just mark image files and +launch slideshow from action menu, bindings are self documented +in mode-line. NOTE: When hitting any other keys than the ones +mentionned in mode-line, slideshow will come in pause, to restart +it you will have to press twice SPACE. + +*** Open files externally + +- Open file with external program (`\\\\[helm-ff-run-open-file-externally]',`C-u' to choose). + +Helm is looking what is used by default to open file +externally (mailcap files) but have its own variable +`helm-external-programs-associations' to store external +applications. If you call the action or its binding without +prefix arg Helm will see if there is an application suitable in +`helm-external-programs-associations', otherwise it will look in +mailcap files. If you want to specify which external application +to use (and its options) use a prefix arg. + +If you have to pass arguments after filename use `%s' in your command e.g. \"foo %s -a -b\" +If you want to detach your program from Emacs, you can use e.g. \"(foo %s &)\" (only supported on Linux/Unix). +When using `%s' do not quote it (i.e. \"%s\"), helm is already quoting filename argument. + +Note: What you configure for Helm in `helm-external-programs-associations' +will take precedence on mailcap files. + +- Preview file with external program (`\\[helm-ff-run-preview-file-externally]'). + +Same as above but doesn't quit Helm session, it is apersistent action. + +- Open file externally with default tool (`\\[helm-ff-run-open-file-with-default-tool]'). + +Use `xdg-open' to open files. + +*** Toggle auto-completion + +Normally auto-completion in helm-find-files is disabled by +default but you can toggle it with `\\[helm-ff-run-toggle-auto-update]'. To enable it on startup by +default, customize `helm-ff-auto-update-initial-value'. + +It is useful when trying to create a new file or directory and you don't want +Helm to complete what you are writing. + +Note: On a terminal, the default binding `C-' may not work. +In this case use `C-c '. + +*** Show infos of files + +To have infos on files like size, permissions etc... hit `\\[helm-ff-properties-persistent]'. +To have automatically brief infos on selected file, turn on `helm-popup-tip-mode'. + +*** You can create a new directory and a new file at the same time + +Simply write the path in the prompt and press `RET', e.g. +\"~/new/newnew/newnewnew/my_newfile.txt\". + +*** To create a new directory, append a \"/\" to the new name and press `RET' + +*** To create a new file, enter a filename not ending with \"/\" + +Note that when you enter a new name, this one is prefixed with [+]. + +*** Recursive search from Helm-find-files + +**** You can use Helm-browse-project (see binding below) + +- With no prefix argument: +If the current directory is under version control with either git or hg and +helm-ls-git and/or helm-ls-hg are installed, it lists all the files under +version control. Otherwise it falls back to Helm-find-files. See +https://github.com/emacs-helm/helm-ls-git and +https://github.com/emacs-helm/helm-ls-hg. + +- With one prefix argument: +List all the files under this directory and other subdirectories +\(recursion) and this list of files will be cached. + +- With two prefix arguments: +Same but the cache is refreshed. + +**** You can start a recursive search with \"locate\", \"find\" or [[https://github.com/sharkdp/fd][Fd]] + +See \"NOTE\" in the [[Recursive completion on subdirectories][section on subdirectories]]. + +Using \"locate\", you can enable the local database with a prefix argument. If the +local database doesn't already exists, you will be prompted for its creation. +If it exists and you want to refresh it, give it two prefix args. + +When using locate the Helm buffer remains empty until you type something. +Regardless Helm uses the basename of the pattern entered in the helm-find-files +session by default. Hitting `\\[next-history-element]' should just kick in the +locate search with this pattern. If you want Helm to automatically do this, add +`helm-source-locate' to `helm-sources-using-default-as-input'. + +NOTE: On Windows use Everything with its command line ~es~ as a replacement of locate. +See [[https://github.com/emacs-helm/helm/wiki/Locate#windows][Locate on Windows]] + +If your system use plocate as backend and you have no results when searching, +see [[Recursive completion on subdirectories][section on subdirectories]]. + +**** Recursive completion on subdirectories + +Starting from the directory you are currently browsing, it is +possible to have completion of all directories underneath. Say +you are at \"/home/you/foo/\" and you want to go to +\"/home/you/foo/bar/baz/somewhere/else\", simply type +\"/home/you/foo/..else\" and enter the final \"/\". Helm will +then list all possible directories under \"foo\" matching +\"else\". + +You can use either find, locate or fdfind as backend, see the variable +`helm-locate-recursive-dirs-command', the default is to use find as backend. + +NOTE: When using `locate' as backend which uses an index, the +directory tree displayed may be out-of-date and not reflect the +latest change until you update the index (using \"updatedb\" for +\"locate\"). + +On recent systems plocate is used instead of mlocate and the +corresponding updatedb command doesn't index anymore user +directories, see the option PRUNE_BIND_MOUNTS in the updatedb man +page. + +If a locale db file is found under current directory it will be +used instead of the global updatedb index. + +To create a locale db file under current directory, use `C-u C-u +C-x C-f' from helm-find-files. + +*** Insert filename at point or complete filename at point + +On insertion (i.e. there is nothing at point): + +- `\\[helm-ff-run-complete-fn-at-point]': insert absolute file name. +- `\\[universal-argument] \\[helm-ff-run-complete-fn-at-point]': insert abbreviated file name. +- `\\[universal-argument] \\[universal-argument] \\[helm-ff-run-complete-fn-at-point]': insert relative file name. +- `\\[universal-argument] \\[universal-argument] \\[universal-argument] \\[helm-ff-run-complete-fn-at-point]': insert basename. + +On completion (\\[helm-ff-run-complete-fn-at-point]): + +- Target starts with \"~/\": insert abbreviate file name. +- target starts with \"/\" or \"[a-z]:/\": insert full path. +- Otherwise: insert relative file name. + +*** Use the wildcard to select multiple files + +Use of wildcard is supported to run an action over a set of files. + +Example: You can copy all the files with \".el\" extension by using \"​*.el\" and +then run copy action. + +Similarly, \"​*​*.el\" (note the two stars) will recursively select all \".el\" +files under the current directory. + +Note that when recursively copying files, you may have files with same name +dispatched across different subdirectories, so when copying them in the same +directory they will get overwritten. To avoid this Helm has a special action +called \"backup files\" that has the same behavior as the command line \"cp -f +--backup=numbered\": it allows you to copy many files with the same name from +different subdirectories into one directory. Files with same name are renamed +as follows: \"foo.txt.~1~\". Like with the --force option of cp, it is possible +to backup files in current directory. + +This command is available only when `dired-async-mode' is active. + +When using an action that involves an external backend (e.g. grep), using \"**\" +is not recommended (even though it works fine) because it will be slower to +select all the files. You are better off leaving the backend to do it, it will +be faster. However, if you know you have not many files it is reasonable to use +this, also using not recursive wildcard (e.g. \"*.el\") is perfectly fine for +this. + +The \"**\" feature is active by default in the option `helm-file-globstar'. It +is different from the Bash \"shopt globstar\" feature in that to list files with +a named extension recursively you would write \"​*​*.el\" whereas in Bash it would +be \"​*​*/​*.el\". Directory selection with \"​*​*/\" like Bash \"shopt globstar\" +option is not supported yet. + +Helm supports different styles of wildcards: + +- `sh' style, the ones supported by `file-expand-wildcards'. +e.g. \"​*.el\", \"​*.[ch]\" which match respectively all \".el\" +files or all \".c\" and \".h\" files. + +- `bash' style (partially) In addition to what allowed in `sh' +style you can specify file extensions that have more than one +character like this: \"*.{sh,py}\" which match \".sh\" and +\".py\" files. + +Of course in both styles you can specify one or two \"*\". + +*** Query replace regexp on filenames + +Replace different parts of a file basename with something else. + +When calling this action you will be prompted twice as with +`query-replace', first for the matching expression of the text to +replace and second for the replacement text. Several facilities, +however, are provided to make the two prompts more powerfull. + +**** Syntax of the first prompt + +In addition to simple regexps, these shortcuts are available: + +- Basename without extension => \"%.\" +- Only extension => \".%\" +- Substring => \"%::\" +- Whole basename => \"%\" + +**** Syntax of the second prompt + +In addition to a simple string to use as replacement, here is what you can use: + +- A placeholder refering to what you have selected in the first prompt: \"\\@\". + +After this placeholder you can use a search-and-replace syntax à-la sed: + + \"\\@/// + +You can select a substring from the string represented by the placeholder: + + \"\\@::\" + +- A special character representing a number which is incremented: \"\\#\". + +- Shortcuts for `upcase', `downcase' and `capitalize' +are available as`%u', `%d' and `%c' respectively. + +**** Examples + +***** Recursively rename all files with \".JPG\" extension to \".jpg\" + +Use the `helm-file-globstar' feature described in [[Use the wildcard to select multiple files][recursive globbing]] +by entering \"**.JPG\" at the end of the Helm-find-files pattern, then hit +\\\\[helm-ff-run-query-replace-fnames-on-marked] and enter \"JPG\" on first prompt, then \"jpg\" on second prompt and hit `RET'. + +Alternatively you can enter \".%\" at the first prompt, then \"jpg\" and hit +`RET'. Note that when using this instead of using \"JPG\" at the first prompt, +all extensions will be renamed to \"jpg\" even if the extension of one of the +files is, say, \"png\". If you want to keep the original extension you can use +\"%d\" at the second prompt (downcase). + +***** Batch-rename files from number 001 to 00x + +Use \"\\#\" inside the second prompt. + +Example 1: To rename the files + + foo.jpg + bar.jpg + baz.jpg + +to + + foo-001.jpg + foo-002.jpg + foo-003.jpg + +use \"%.\" as matching regexp and \"foo-\\#\" as replacement string. + +Example 2: To rename the files + + foo.jpg + bar.jpg + baz.jpg + +to + + foo-001.jpg + bar-002.jpg + baz-003.jpg + +use as matching regexp \"%.\" and as replacement string \"\\@-\\#\". + +***** Replace a substring + +Use \"%::\". + +Example: To rename files + + foo.jpg + bar.jpg + baz.jpg + +to + + fOo.jpg + bAr.jpg + bAz.jpg + +use as matching regexp \"%:1:2\" and as replacement string \"%u\" (upcase). + +Note that you \*cannot* use \"%.\" and \".%\" along with substring replacement. + +***** Modify the string from the placeholder (\\@) + +- By substring, i.e. only using the substring of the placeholder: \"\\@::\". +The length of placeholder is used for when unspecified. + +Example 1: \"\\@:0:2\" replaces from the beginning to the second char of the placeholder. + +Example 2: \\@:2: replaces from the second char of the placeholder to the end. + +- By search-and-replace: \"\\@///\". + +Incremental replacement is also handled in . + +Example 3: \"\\@/foo/bar/\" replaces \"foo\" by \"bar\" in the placeholder. + +Example 4: \"\\@/foo/-\\#/\" replaces \"foo\" in the placeholder by 001, 002, etc. + +***** Clash in replacements (avoid overwriting files) + +When performing any of these replacement operations you may end up with same +names as replacement. In such cases Helm numbers the file that would otherwise +overwritten. For instance, should you remove the \"-m\" part from the files +\"emacs-m1.txt\", \"emacs-m2.txt\" and \"emacs-m3.txt\" you would end up with +three files named \"emacs.txt\", the second renaming overwriting first file, and +the third renaming overwriting second file and so on. Instead Helm will +automatically rename the second and third files as \"emacs(1).txt\" and +\"emacs(2).txt\" respectively. + +***** Query-replace on filenames vs. serial-rename action + +Unlike the [[Serial renaming][serial rename]] actions, the files renamed with +the query-replace action stay in their initial directory and are not moved to +the current directory. As such, using \"\\#\" to serial-rename files only makes +sense for files inside the same directory. It even keeps renaming files +with an incremental number in the next directories. + +*** Serial renaming + +You can use the serial-rename actions to rename, copy or symlink marked files to +a specific directory or in the current directory with all the files numbered +incrementally. + +- Serial-rename by renaming: +Rename all marked files with incremental numbering to a specific directory. + +- Serial-rename by copying: +Copy all marked files with incremental numbering to a specific directory. + +- Serial-rename by symlinking: +Symlink all marked files with incremental numbering to a specific directory. + +*** Edit marked files in a dired buffer + +You can edit marked files with `\\\\[helm-ff-run-edit-marked-files]'. According +to the user variable `helm-ff-edit-marked-files-fn' you can use either +wdired or wfnames. The default is to use wfnames wich works properly in +all emacs versions. Wildcards are supported as well, so you can use +e.g. \"*.txt\" to select all \".txt\" files in the current directory or +\"**.txt\" to select all files recursively from the current directory. +See [[Use the wildcard to select multiple files]] section above. + +*** Defining default target directory for copying, renaming, etc + +You can customize `helm-dwim-target' to behave differently depending on the +windows open in the current frame. Default is to provide completion on all +directories associated to each window. + +*** Copying/Renaming from or to remote directories + +Never use ssh tramp method to copy/rename large files, use +instead its scp method if you want to avoid out of memory +problems and crash Emacs or the whole system. Moreover when using +scp method, you will hit a bug when copying more than 3 files at +the time, see [[https://github.com/emacs-helm/helm/issues/1945][bug#1945]]. +The best way currently is using Rsync to copy files from or to +remote, see [[Use Rsync to copy files][Use Rsync to copy files]]. +Also if you often work on remote you may consider using SSHFS +instead of relying on tramp. + +*** Copying and renaming asynchronously + +If you have the async library installed (if you got Helm from MELPA you do), you +can use it for copying/renaming files by enabling `dired-async-mode'. + +Note that even when async is enabled, running a copy/rename action with a prefix +argument will execute action synchronously. Moreover it will follow the first +file of the marked files in its destination directory. + +When `dired-async-mode' is enabled, an additional action named \"Backup files\" +will be available. (Such command is not natively available in Emacs). +See [[Use the wildcard to select multiple files]] for details. + +*** Multiple copies of a file + +The command \\\\[helm-ff-run-mcp] allows +copying a single file to multiple directories. To use it, mark +the file you want to copy first and then mark the directories +where you want to copy file. For example if you run +\\[helm-ff-run-mcp] on the marked candidates '(\"foo.txt\" \"bar/\" \"baz\"), +\"foo.txt\" will be copied to directories \"bar/\" and \"baz/\". + +*** Use Rsync to copy files + +If Rsync is available, you can use it to copy/sync files or directories +with some restrictions though: + +- Copying from/to tramp sudo method may not work (permissions). +- Copying from remote to remote is not supported (rsync restriction) +however you can mount a remote with sshfs and copy to it (best), otherwise you have to modify +the command line with a prefix arg, see [[https://unix.stackexchange.com/questions/183504/how-to-rsync-files-between-two-remotes][how-to-rsync-files-between-two-remotes]] +for the command line to use. + +This command is mostly useful when copying large files as it is +fast, asynchronous and provide a progress bar in mode-line. Each +rsync process have its own progress bar, so you can run several +rsync jobs, they are independents. If rsync fails you can +consult the \"*helm-rsync*\" buffer to see rsync errors. An +help-echo (move mouse over progress bar) is provided to see which +file is in transfer. Note that when copying directories, no +trailing slashes are added to directory names, which mean that +directory is created on destination if it doesn't already exists, +see rsync documentation for more infos on rsync behavior. To +synchronize a directory, mark all in the directory and rsync all +marked to the destination directory or rsync the directory itself +to its parent, e.g. remote:/home/you/music => /home/you. + +The options are configurable through `helm-rsync-switches', but +you can modify them on the fly when needed by using a prefix arg, +in this case you will be prompted for modifications. + +NOTE: When selecting a remote file, if you use the tramp syntax +for specifying a port, i.e. host#2222, helm will add +automatically \"-e 'ssh -p 2222'\" to the rsync command line +unless you have specified yourself the \"-e\" option by editing +rsync command line with a prefix arg (see above). + +*** Drag and drop files from Helm + +When mouse support is enabled in Helm (which is the default, see +`helm-allow-mouse') you can drag and drop files to `default-directory' +of the buffer you drag-and-drop in or in an external application. + +By default Helm copy files when using drag-and-drop, you can customize +`helm-ff-drag-mouse-1-default-action' to modify this, however note that +other actions than `copy' are not supported when dropping in dired buffers +as of now, it works when dropping in external apps like Thunar though. + +Also drag-and-drop is not working when trying to drop in a window that +is in another desktop, in this case use the following solution. + +To drag-and-drop to external applications you can also use the +external application [[https://github.com/mwh/dragon][Dragon]] and use it as follow: + +#+begin_src elisp + (defun helm-ff-dragon (files) + \"Create a small window with FILES ready to drag and drop. +Use this to drop files on externals applications or desktop. +Dropping on emacs buffers with this is not supported. + +Needs `dragon' executable: https://github.com/mwh/dragon.\" + (interactive (list (helm-marked-candidates))) + (cl-assert (executable-find \"dragon\") nil \"Dragon executable not found\") + (apply #'call-process \"dragon\" nil nil nil \"--all\" \"--and-exit\" files)) + (define-key helm-find-files-map (kbd \"C-c m\") 'helm-ff-dragon) +#+end_src + +Tip: From the Dragon window, you can move your mouse to an other desktop +where the external application you want to drag-and-drop is. + +NOTE: Drag-and-dropping from elsewhere to Helm is forbidden. + +*** Access files on Android phones from Helm + +Since Android doesn't provide anymore mass storage for USB, it is +not simple to access files on Android, the best way to do this +currently seems to use Adb, here some hints to set this up, read +in addition the Tramp documentation. + +1) Install Adb, most distribution provide it. +2) Enable on your phone USB debug in System/dvlpmnt settings. +3) From helm-find-files use adb tramp method: + /adb::/ +From there you can navigate as usual, mark and copy files etc... + +*** Bookmark the `helm-find-files' session + +You can bookmark the `helm-find-files' session with `\\[helm-ff-bookmark-set]'. +You can later retrieve these bookmarks by calling `helm-filtered-bookmarks' +or, from the current `helm-find-files' session, by hitting `\\[helm-find-files-switch-to-bookmark]'. + +*** Grep files from `helm-find-files' + +You can grep individual files from `helm-find-files' by using +\`\\\\[helm-ff-run-grep]'. This same command can also +recursively grep files from the current directory when called with a prefix +argument. In this case you will be prompted for the file extensions to use +\(grep backend) or the types of files to use (ack-grep backend). See the +`helm-grep-default-command' documentation to set this up. For compressed files +or archives, use zgrep with \`\\\\[helm-ff-run-zgrep]'. + +Otherwise you can use recursive commands like \`\\\\[helm-ff-run-grep-ag]' or `\\\\[helm-ff-run-git-grep]' +that are much faster than using `\\\\[helm-ff-run-grep]' with a prefix argument. +See `helm-grep-ag-command' and `helm-grep-git-grep-command' to set this up. + +You can also use \"id-utils\"' GID with \`\\\\[helm-ff-run-gid]' +by creating an ID index file with the \"mkid\" shell command. + +All those grep commands use the symbol at point as the default pattern. +Note that default is different from input (nothing is added to the prompt until +you hit `\\[next-history-element]'). + +**** Grepping on remote files + +On remote files grep is not well supported by TRAMP unless you suspend updates before +entering the pattern and re-enable it once your pattern is ready. +To toggle suspend-update, use `\\\\[helm-toggle-suspend-update]'. + +*** Compressing or uncompressing files from helm-find-files + +**** Compressing/uncompressing using Helm commands + +Helm provide commands like dired (reusing dired code) +to (un)compress files from `helm-find-files', however these +commands are asynchronous. + +You can use `\\\\[helm-ff-run-compress-marked-files]' to compress marked files. +To compress file(s) to an archive use `\\\\[helm-ff-run-compress-to]'. + +To quickly compress/uncompress small files without quitting Helm use `\\\\[helm-ff-persistent-compress]'. +NOTE: This persistent action is NOT asynchronous, IOW it will block Helm +for a while until compression/uncompression finish. + +**** Compressing/uncompressing using external commands in Eshell + +You can use Eshell aliases to uncompress files, +see [[Execute Eshell commands on files][Execute Eshell commands on files]] for more infos. + +Here some aliases using commands from the excellent =atools= package: + +alias pack2zip apack -e -F .zip $* & +alias pack2gz apack -e -F .tar.gz $* & +alias pack2bz apack -e -F .tar.bz $* & +alias pack2xz apack -e -F .tar.xz $* & +alias unpack aunpack $1 & + +Note the \"&\" at end of commands that make eshell aliases asynchronous. +NOTE: Using the ampersand at end of command to make it asynchronous is broken +in all emacs versions before emacs-28 (see emacs bug#50209). + +Of course you can use any other commands of your choice as aliases. + +*** Execute Eshell commands on files + +Setting up aliases in Eshell allows you to set up powerful customized commands. + +Your aliases for using eshell command on file should allow +specifying one or more files, use e.g. \"alias foo $1\" or +\"alias foo $*\", if you want your command to be asynchronous add +at end \"&\", e.g. \"alias foo $* &\". + +Adding Eshell aliases to your `eshell-aliases-file' or using the +`alias' command from Eshell allows you to create personalized +commands not available in `helm-find-files' actions and use them +from `\\\\[helm-ff-run-eshell-command-on-file]'. + +Example: You want a command to uncompress some \"*.tar.gz\" files from `helm-find-files': + +1) Create an Eshell alias named, say, \"untargz\" with the command +\"alias untargz tar zxvf $*\". + +2) Now from `helm-find-files' select the \"*.tar.gz\" file (you can also +mark files if needed) and hit `\\\\[helm-ff-run-eshell-command-on-file]'. + +Note: When using marked files with this, the meaning of the prefix argument is +quite subtle. Say you have \"foo\", \"bar\" and \"baz\" marked; when you run +the alias command `example' on these files with no prefix argument it will run +`example' sequentially on each file: + +$ example foo +$ example bar +$ example baz + +With a prefix argument however it will apply `example' on all files at once: + +$ example foo bar baz + +Of course the alias command should support this. + +NOTE: Helm assume that any alias command ending with '$*' or +'$*&' supports many files as arguments, so no need to give a +prefix arg for such alias, however if your command is not an +alias you have to specify a prefix arg if you want your command +to apply all files at once. + +If you add %s to the command line %s will be replaced with the candidate, this mean you can +add extra argument to your command e.g. command -extra-arg %s or command %s -extra-arg. +If you want to pass many files inside %s, don't forget to use a prefix arg. + +You can also use special placeholders in extra-args, +see the specific info page once you hit `\\\\[helm-ff-run-eshell-command-on-file]'. + +*** Using TRAMP with `helm-find-files' to read remote directories + +`helm-find-files' works fine with TRAMP despite some limitations. + +- Grepping files is not very well supported when used incrementally. +See [[Grepping on remote files]]. + +- Locate does not work on remote directories. + +**** A TRAMP syntax crash course + +Please refer to TRAMP's documentation for more details. + +- Connect to host 192.168.0.4 as user \"foo\": + +/scp:192.168.0.4@foo: + +- Connect to host 192.168.0.4 as user \"foo\" on port 2222: + +/scp:192.168.0.4@foo#2222: + +- Connect to host 192.168.0.4 as root using multihops syntax: + +/ssh:192.168.0.4@foo|sudo:192.168.0.4: + +Note: You can also use `tramp-default-proxies-alist' when connecting often to +the same hosts. + +As a rule of thumb, prefer the scp method unless using multihops (which only +works with the ssh method), especially when copying large files. + +IMPORTANT: +You need to hit `C-j' once on top of a directory on the first connection +to complete the pattern in the minibuffer. + +**** Display color for directories, symlinks etc... with tramp + +Starting at helm version 2.9.7 it is somewhat possible to +colorize fnames by listing files without loosing performances with +external commands (ls and awk) if your system is compatible. +For this you can use `helm-list-dir-external' as value +for `helm-list-remote-directory-fn'. + +See `helm-list-remote-directory-fn' documentation for more infos. + +**** Completing host + +As soon as you enter the first \":\" after method e.g =/scp:= you will +have some completion about previously used hosts or from your =~/.ssh/config= +file, hitting `\\[helm-execute-persistent-action]' or `right' on a candidate will insert this host in minibuffer +without addind the ending \":\", second hit insert the last \":\". +As soon the last \":\" is entered TRAMP will kick in and you should see the list +of candidates soon after. + +**** Completion on tramp methods + +If you enter \":\" directly after \"/\" or \"|\" you will have completion on tramp methods, +hitting `\\[helm-execute-persistent-action]' or `right' on a method will insert it in minibuffer. + +When connection fails, be sure to delete your TRAMP connection with M-x +`helm-delete-tramp-connection' before retrying. + +**** Editing local files as root + +Use the sudo method: + +\"/sudo:host:\" or simply \"/sudo::\". + +*** Attach files to a mail buffer (message-mode) + +If you are in a `message-mode' or `mail-mode' buffer, that action will appear +in action menu, otherwise it is available at any time with \\\\[helm-ff-run-mail-attach-files]. +It behaves as follows: + +- If you are in a (mail or message) buffer, files are attached there. + +- If you are not in a mail buffer but one or more mail buffers exist, you are +prompted to attach files to one of these mail buffers. + +- If you are not in a mail buffer and no mail buffer exists, +a new mail buffer is created with the attached files in it. + +*** Open files in separate windows + +When [[Marked candidates][marking]] multiple files or using [[Use the wildcard to select multiple files][wildcard]], helm allow opening all +this files in separate windows using an horizontal layout or a +vertical layout if you used a prefix arg, when no more windows can be +displayed in frame, next files are opened in background without being +displayed. When using \\\\[helm-ff-run-switch-other-window] the current +buffer is kept and files are displayed next to it with same behavior as above. +When using two prefix args, files are opened in background without beeing displayed. + +*** Expand archives as directories in a avfs directory + +If you have mounted your filesystem with 'mountavfs' command, +you can expand archives in the \"~/.avfs\" directory with \\\\[helm-execute-persistent-action]. + +To umount Avfs, use ~fusermount -u ~/.avfs~ + +NOTE: You need the package 'avfs', on debian like distros use ~apt-get install avfs~. + +*** Tramp archive support (emacs-27+ only) + +As Tramp archive often crash Helm and Emacs, Helm does its best +to disable it, however it is hard to do so as Tramp Archive is +enabled inconditionally in Emacs. Here I build my Emacs +without-dbus to ensure Tramp archive wont kickin unexpectedly. + +If you want to browse archives please use [[Expand archives as +directories in a avfs directory][Avfs]] which is much better and +stable. + +*** Touch files + +In the completion buffer, you can choose the default which is the current-time, it is +the first candidate or the timestamp of one of the selected files. +If you need to use something else, use \\\\[next-history-element] and edit +the date in minibuffer. +It is also a way to quickly create a new file without opening a buffer, saving it +and killing it. +To touch more than one new file, separate you filenames with a comma (\",\"). +If one wants to create (touch) a new file with comma inside the name use a prefix arg, +this will prevent splitting the name and create multiple files. + +*** Change mode on files (chmod) + +When running `\\\\[helm-ff-run-chmod]' on marked +files, you can enter the new mode in prompt but you can also use the +first marked file as model to use it as default. For example you can +mark a file with mode 777 and mark other files with mode 664, press +'RET' and answer 'y', all marked files will be changed to 777. To see +the default mode and eventually edit it use 'M-n'. You can use numeric +mode or letters, see 'chmod' man page for more infos. + +NOTE: Another way to change modes on files in helm-find-files is +running `\\\\[helm-ff-run-switch-to-shell]' and use 'chmod' directly. + +*** Change owner and/or group on files + +Change owner of marked files with `\\\\[helm-ff-run-chown]' and group with `\\\\[helm-ff-run-chgrp]'. +To change both at the same time use e.g. \"user:user\" at prompt. +If you have not the rights to do this, you may have an error (see dired-log), in this case +open the directory as root with tramp methods sudo or su to operate. + +*** Delete files + +You can delete files without quitting helm with +`\\\\[helm-ff-persistent-delete]' or delete files and quit helm with `\\[helm-ff-run-delete-file]'. + +In the second method you can choose to +make this command asynchronous by customizing +\`helm-ff-delete-files-function'. + +_WARNING_: When deleting files asynchronously you will NOT be +WARNED if directories are not empty, that's mean non empty directories will +be deleted recursively in background without asking. + +A good compromise is to trash your files +when using asynchronous method (see [[Trashing files][Trashing files]]). + +When choosing synchronous delete, you can allow recursive +deletion of directories with `helm-ff-allow-recursive-deletes'. +Note that when trashing (synchronous) you are not asked for recursive deletion. + +Note that `helm-ff-allow-recursive-deletes' have no effect when +deleting asynchronously. + +First method (persistent delete) is always synchronous. + +Note that when a prefix arg is given, trashing behavior is inversed. +See [[Trashing files][Trashing files]]. + +**** Trashing files + +If you want to trash your files instead of deleting them you can +set `delete-by-moving-to-trash' to non nil, like this your files +will be moved to trash instead of beeing deleted. + +You can reverse at any time the behavior of `delete-by-moving-to-trash' by using +a prefix arg with any of the delete files command. + +On GNULinux distributions, when navigating to a Trash directory you +can restore any file in ..Trash/files directory with the 'Restore +from trash' action you will find in action menu (needs the +trash-cli package installed for remote files, see [[Trashing remote files with tramp][Here]]). +You can as well delete files from Trash directories with the 'delete files from trash' +action. +If you want to know where a file will be restored, hit `M-i', you will find a trash info. + +Tip: Navigate to your Trash/files directories with `helm-find-files' and set a bookmark +there with \\\\[helm-ff-bookmark-set] for fast access to Trash. + +NOTE: Restoring files from trash is working only on system using +the +[[http://freedesktop.org/wiki/Specifications/trash-spec][freedesktop trash specifications]]. + +***** Trashing remote files with tramp + +Trashing remote files (or local files with sudo method) is disabled by default +because tramp is requiring the 'trash' command to be installed, if you want to +trash your remote files, customize `helm-trash-remote-files'. +The package on most GNU/Linux based distributions is trash-cli, it is available [[https://github.com/andreafrancia/trash-cli][here]]. + +NOTE: +When deleting your files with sudo method, your trashed files will not be listed +with trash-list command line until you log in as root. + +*** Checksum file + +Checksum is calculated with the md5sum, sha1sum, sha224sum, +sha256sum, sha384sum and sha512sum commands when available, otherwise the +Emacs function `secure-hash' is used but it is slow and may crash +Emacs and even the whole system as it eats all memory. So if +your system doesn't have the md5sum and sha*sum command line tools be +careful when checking sum of larges files e.g. isos. + +*** Ignored or boring files + +Helm-find-files can ignore files matching +`helm-boring-file-regexp-list' or files that are git ignored, you +can set this with `helm-ff-skip-boring-files' or +`helm-ff-skip-git-ignored-files'. +NOTE: This will slow down helm, be warned. + +*** Helm-find-files is using a cache + +Helm is caching each directory files list in a hash table for +faster search, when a directory is modified it is removed from cache +so that further visit in this directory refresh cache. +You may have in some rare cases to refresh directory manually with `\\\\[helm-refresh]' +for example when helm-find-files session is running and a file is modified/deleted +in current visited directory by an external command from outside Emacs. + +NOTE: Helm is using file-notify to watch visited directories, +nowaday most systems come with a notify package but if your +system doesn't support this, you can turn off file notifications +by customizing the variable `helm-ff-use-notify'. In this case +you will have to refresh manually directories when needed with `\\\\[helm-refresh]'. + +*** Prefix file candidates with icons + +If `all-the-icons' package is installed, turning on +`helm-ff-icon-mode' will show icons before files and directories. + +** Commands +\\ +|Keys|Description +|-----------+----------| +|\\[helm-ff-run-locate]|Run `locate' (`\\[universal-argument]' to specify locate database, `M-n' to insert basename of candidate). +|\\[helm-ff-run-browse-project]|Browse project (`\\[universal-argument]' to recurse, `\\[universal-argument] \\[universal-argument]' to recurse and refresh database). +|\\[helm-ff-run-find-sh-command]|Run `find' shell command from this directory. +|\\[helm-ff-run-grep]|Run Grep (`\\[universal-argument]' to recurse). +|\\[helm-ff-run-pdfgrep]|Run Pdfgrep on marked files. +|\\[helm-ff-run-zgrep]|Run zgrep (`\\[universal-argument]' to recurse). +|\\[helm-ff-run-grep-ag]|Run AG grep on current directory. +|\\[helm-ff-run-git-grep]|Run git-grep on current directory. +|\\[helm-ff-run-gid]|Run gid (id-utils). +|\\[helm-ff-run-etags]|Run Etags (`\\[universal-argument]' to use thing-at-point, `\\[universal-argument] \\[universal-argument]' to reload cache). +|\\[helm-ff-run-rename-file]|Rename Files (`\\[universal-argument]' to follow). +|\\[helm-ff-run-query-replace-fnames-on-marked]|Query replace on marked files. +|\\[helm-ff-run-copy-file]|Copy Files (`\\[universal-argument]' to follow). +|\\[helm-ff-run-mcp]|Copy car of marked to remaining directories. +|\\[helm-ff-run-rsync-file]|Rsync Files (`\\[universal-argument]' to edit command). +|\\[helm-ff-run-byte-compile-file]|Byte Compile Files (`\\[universal-argument]' to load). +|\\[helm-ff-run-load-file]|Load Files. +|\\[helm-ff-run-symlink-file]|Symlink Files. +|\\[helm-ff-run-hardlink-file]|Hardlink files. +|\\[helm-ff-run-relsymlink-file]|Relative symlink Files. +|\\[helm-ff-run-chmod]|Change mode on Files. +|\\[helm-ff-run-chown]|Change owner on Files. +|\\[helm-ff-run-chgrp]|Change group on Files. +|\\[helm-ff-run-delete-file]|Delete Files. +|\\[helm-ff-run-touch-files]|Touch files. +|\\[helm-ff-run-kill-buffer-persistent]|Kill buffer candidate without leaving Helm. +|\\[helm-ff-persistent-delete]|Delete file without leaving Helm. +|\\[helm-ff-run-switch-to-shell]|Switch to prefered shell. +|\\[helm-ff-run-eshell-command-on-file]|Eshell command on file (`\\[universal-argument]' to apply on marked files, otherwise treat them sequentially). +|\\[helm-ff-run-ediff-file]|Ediff file. +|\\[helm-ff-run-ediff-merge-file]|Ediff merge file. +|\\[helm-ff-run-complete-fn-at-point]|Complete file name at point. +|\\[helm-ff-run-switch-other-window]|Switch to other window. +|\\[helm-ff-run-switch-other-frame]|Switch to other frame. +|\\[helm-ff-run-open-file-externally]|Open file with external program (`\\[universal-argument]' to choose). +|\\[helm-ff-run-preview-file-externally]|Preview file with external program. +|\\[helm-ff-run-open-file-with-default-tool]|Open file externally with default tool. +|\\[helm-ff-rotate-left-persistent]|Rotate image left. +|\\[helm-ff-rotate-right-persistent]|Rotate image right. +|\\[helm-ff-increase-image-size-persistent]|Zoom in image. +|\\[helm-ff-decrease-image-size-persistent]|Zoom out image. +|\\[helm-ff-toggle-thumbnails]|Show thumbnails on image files. +|\\[helm-find-files-up-one-level]|Go to parent directory. +|\\[helm-find-files-history]|Switch to the visited-directory history. +|\\[helm-ff-file-name-history]|Switch to file name history. +|\\[helm-ff-properties-persistent]|Show file properties in a tooltip. +|\\[helm-mark-all]|Mark all visible candidates. +|\\[helm-ff-run-toggle-auto-update]|Toggle auto-expansion of directories. +|\\[helm-unmark-all]|Unmark all candidates, visible and invisible ones. +|\\[helm-ff-run-mail-attach-files]|Attach files to message buffer. +|\\[helm-ff-run-print-file]|Print file, (`\\[universal-argument]' to refresh printer list). +|\\[helm-enlarge-window]|Enlarge Helm window. +|\\[helm-narrow-window]|Narrow Helm window. +|\\[helm-ff-run-toggle-basename]|Toggle basename/fullpath. +|\\[helm-ff-run-find-file-as-root]|Find file as root. +|\\[helm-ff-run-find-alternate-file]|Find alternate file. +|\\[helm-ff-run-insert-org-link]|Insert org link. +|\\[helm-ff-bookmark-set]|Set bookmark to current directory. +|\\[helm-find-files-switch-to-bookmark]|Jump to bookmark list. +|\\[helm-ff-sort-alpha]|Sort alphabetically. +|\\[helm-ff-sort-by-newest]|Sort by newest. +|\\[helm-ff-sort-by-size]|Sort by size. +|\\[helm-ff-toggle-dirs-only]|Show only directories. +|\\[helm-ff-toggle-files-only]|Show only files. +|\\[helm-ff-sort-by-ext]|Sort by extensions. +|\\[helm-ff-run-compress-to]|Compress file(s) to archive. +|\\[helm-ff-run-compress-marked-files]|Compress file(s). +|\\[helm-ff-persistent-compress]|Compress file(s) without quitting.") + +;;; Help for file-name-history +;; +;; +(defvar helm-file-name-history-help-message + "* Helm file name history + +** Tips + +Helm is turning on `recentf-mode' for you only when calling this command +and if `helm-turn-on-recentf' is non nil. That's mean that the files +opened prior calling this command would not be saved if you didn't +enable `recentf-mode' yourself in your init file or manually. + +** Commands +\\ +\\[helm-ff-file-name-history-run-ff]|Preselect file in helm-find-files.") + +;;; Help for `helm-read-file-name' +;; +;; +(defun helm-read-file-name-help-message () + (let ((name (if helm-alive-p + (assoc-default 'name (helm-get-current-source)) + "generic"))) + (format + "* Helm `%s' read file name completion + +This is `%s' read file name completion that have been \"helmized\" +because you have enabled [[Helm mode][helm-mode]]. +Don't confuse this with `helm-find-files' which is a native helm command, +see [[Helm functions vs helmized Emacs functions]]. + +** Tips + +*** Navigation + +**** Enter `~/' at end of pattern to quickly reach home directory + +**** Enter `/' at end of pattern to quickly reach the file system root + +**** Enter `./' at end of pattern to quickly reach `default-directory' + +\(As per its value at the beginning of the session.) + +If you already are in the `default-directory' this will move the cursor to the top. + +**** Enter `../' at end of pattern will reach upper directory, moving cursor on top + +This is different from using `\\[helm-find-files-up-one-level]' in that it moves +the cursor to the top instead of remaining on the previous subdir name. + +**** You can complete with partial basename + +It starts from the third character of the pattern. + +For instance \"fob\" or \"fbr\" will complete \"foobar\" but \"fb\" needs a +third character in order to complete it. + +*** Persistent actions + +By default `helm-read-file-name' uses the persistent actions of `helm-find-files'. + +**** Use `\\[universal-argument] \\\\[helm-execute-persistent-action]' to display an image + +**** `\\\\[helm-execute-persistent-action]' on a filename will expand to this filename in Helm-buffer + +Second hit displays the buffer filename. +Third hit kills the buffer filename. +Note: `\\[universal-argument] \\\\[helm-execute-persistent-action]' displays the buffer directly. + +**** Browse images directories with `helm-follow-mode' and navigate up/down + +*** Delete characters backward + +When you want to delete characters backward, e.g. to create a new file or directory, +auto-update may come in the way when it keeps updating to an existent directory. +In that case, type `C-' and then `'. +This should not be needed when copying/renaming files because autoupdate is disabled +by default in that case. + +Note: On a terminal, the default binding `C-' may not work. +In this case use `C-c '. + +*** Create new directories and files + +**** You can create a new directory and a new file at the same time + +Simply write the path in prompt and press `RET', e.g. +\"~/new/newnew/newnewnew/my_newfile.txt\". + +**** To create a new directory, append a \"/\" at to the new name and press `RET' + +**** To create a new file, enter a filename not ending with \"/\" + +File and directory creation works only with some commands (e.g. `find-file') +and it will not work with others where it is not intended to return a file or +a directory \(e.g `list-directory'). + +*** Exiting minibuffer with empty string + +You can exit minibuffer with empty string with \\\\[helm-cr-empty-string]. +It is useful when some commands are prompting continuously until you enter an empty prompt. + +** Commands +\\ +|Keys|Description +|-----------+----------| +|\\[helm-find-files-up-one-level]|Go to parent directory. +|\\[helm-ff-run-toggle-auto-update]|Toggle auto-expansion of directories. +|\\[helm-ff-run-toggle-basename]|Toggle basename. +|\\[helm-ff-file-name-history]|File name history. +|C/\\[helm-cr-empty-string]|Return empty string unless `must-match' is non-nil. +|\\[helm-next-source]|Go to next source. +|\\[helm-previous-source]|Go to previous source." + name name))) + +;;; FD help +;; +;; +(defvar helm-fd-help-message + "* Helm fd + +** Tips + +\[[https://github.com/sharkdp/fd][The Fd command line tool]] is very fast to search files recursively. +You may have to wait several seconds at first usage when your +hard drive cache is \"cold\", then once the cache is initialized +searchs are very fast. You can pass any [[https://github.com/sharkdp/fd#command-line-options][Fd options]] before pattern, e.g. \"-e py foo\". + +The [[https://github.com/sharkdp/fd][Fd]] command line can be customized with `helm-fd-switches' user variable. +Always use =--color always= as option otherwise you will have no colors. +To customize colors see [[https://github.com/sharkdp/fd#colorized-output][Fd colorized output]]. + +NOTE: +Starting from fd version 8.2.1, you have to provide the env var +LS_COLORS to Emacs to have a colorized output, the easiest way is +to add to your =~/.profile= file =eval $(dircolors)=. +Another way is using =setenv= in your init file. +This is not needed when running Emacs from a terminal either with =emacs -nw= +or =emacs= because emacs inherit the env vars of this terminal. +See [[https://github.com/sharkdp/fd/issues/725][fd bugref#725]] + +Search is (pcre) regexp based (see [[https://docs.rs/regex/1.0.0/regex/#syntax][Regexp syntax]]), multi patterns are _not_ supported. + +** Man page + +NAME + fd - find entries in the filesystem + +SYNOPSIS + fd [-HIEsiaLp0hV] [-d depth] [-t filetype] [-e ext] [-E exclude] [-c + when] [-j num] [-x cmd] [pattern] [path...] + +DESCRIPTION + fd is a simple, fast and user-friendly alternative to find(1). + +OPTIONS + -H, --hidden + Include hidden files and directories in the search results + (default: hidden files and directories are skipped). + + -I, --no-ignore + Show search results from files and directories that would other‐ + wise be ignored by .gitignore, .ignore, .fdignore, or the global + ignore file. + + -u, --unrestricted + Alias for '--no-ignore'. Can be repeated; '-uu' is an alias for + '--no-ignore --hidden'. + + --no-ignore-vcs + Show search results from files and directories that would other‐ + wise be ignored by .gitignore files. + + -s, --case-sensitive + Perform a case-sensitive search. By default, fd uses case-insen‐ + sitive searches, unless the pattern contains an uppercase char‐ + acter (smart case). + + -i, --ignore-case + Perform a case-insensitive search. By default, fd uses case- + insensitive searches, unless the pattern contains an uppercase + character (smart case). + + -g, --glob + Perform a glob-based search instead of a regular expression + search. + + --regex + Perform a regular-expression based seach (default). This can be + used to override --glob. + + -F, --fixed-strings + Treat the pattern as a literal string instead of a regular + expression. + + -a, --absolute-path + Shows the full path starting from the root as opposed to rela‐ + tive paths. + + -l, --list-details + Use a detailed listing format like 'ls -l'. This is basically an + alias for '--exec-batch ls -l' with some additional 'ls' + options. This can be used to see more metadata, to show symlink + targets and to achieve a deterministic sort order. + + -L, --follow + By default, fd does not descend into symlinked directories. + Using this flag, symbolic links are also traversed. + + -p, --full-path + By default, the search pattern is only matched against the file‐ + name (or directory name). Using this flag, the pattern is + matched against the full path. + + -0, --print0 + Separate search results by the null character (instead of new‐ + lines). Useful for piping results to xargs. + + --max-results count + Limit the number of search results to 'count' and quit immedi‐ + ately. + + -1 Limit the search to a single result and quit immediately. This + is an alias for '--max-results=1'. + + --show-errors + Enable the display of filesystem errors for situations such as + insufficient permissions or dead symlinks. + + --one-file-system, --mount, --xdev + By default, fd will traverse the file system tree as far as + other options dictate. With this flag, fd ensures that it does + not descend into a different file system than the one it started + in. Comparable to the -mount or -xdev filters of find(1). + + -h, --help + Print help information. + + -V, --version + Print version information. + + -d, --max-depth d + Limit directory traversal to at most d levels of depth. By + default, there is no limit on the search depth. + + --min-depth d + Only show search results starting at the given depth. See also: + '--max-depth' and '--exact-depth'. + + --exact-depth d + Only show search results at the exact given depth. This is an + alias for '--min-depth --max-depth '. + + -t, --type filetype + Filter search by type: + + f, file + regular files + + d, directory + directories + + l, symlink + symbolic links + + x, executable + executable (files) + + e, empty + empty files or directories + + s, socket + sockets + + p, pipe + named pipes (FIFOs) + + This option can be used repeatedly to allow for multiple file + types. + + -e, --extension ext + Filter search results by file extension ext. This option can be + used repeatedly to allow for multiple possible file extensions. + + -E, --exclude pattern + Exclude files/directories that match the given glob pattern. + This overrides any other ignore logic. Multiple exclude pat‐ + terns can be specified. + + --ignore-file path + Add a custom ignore-file in '.gitignore' format. These files + have a low precedence. + + -c, --color when + Declare when to colorize search results: + + auto Colorize output when standard output is connected to terminal (default). + + never Do not colorize output. + + always Always colorize output. + + -j, --threads num + Set number of threads to use for searching & executing (default: + number of available CPU cores). + + -S, --size size + Limit results based on the size of files using the format + <+-> + + '+' file size must be greater than or equal to this + + '-' file size must be less than or equal to this + + 'NUM' The numeric size (e.g. 500) + + 'UNIT' The units for NUM. They are not case-sensitive. Allowed + unit values: + + 'b' bytes + + 'k' kilobytes (base ten, 10^3 = 1000 bytes) + + 'm' megabytes + + 'g' gigabytes + + 't' terabytes + + 'ki' kibibytes (base two, 2^10 = 1024 bytes) + + 'mi' mebibytes + + 'gi' gibibytes + + 'ti' tebibytes + + --changed-within date|duration + Filter results based on the file modification time. The argument + can be provided as a specific point in time (YYYY-MM-DD + HH:MM:SS) or as a duration (10h, 1d, 35min). --change-newer- + than can be used as an alias. + + Examples: + --changed-within 2weeks + --change-newer-than \"2018-10-27 10:00:00\" + + --changed-before date|duration + Filter results based on the file modification time. The argument + can be provided as a specific point in time (YYYY-MM-DD + HH:MM:SS) or as a duration (10h, 1d, 35min). --change-older- + than can be used as an alias. + + Examples: + --changed-before \"2018-10-27 10:00:00\" + --change-older-than 2weeks + + -o, --owner [user][:group] + Filter files by their user and/or group. Format: + [(user|uid)][:(group|gid)]. Either side is optional. Precede + either side with a '!' to exclude files instead. + + Examples: + --owner john + --owner :students + --owner \"!john:students\" + + -x, --exec command + Execute command for each search result. The following placehold‐ + ers are substituted by a path derived from the current search + result: + + {} path + + {/} basename + + {//} parent directory + + {.} path without file extension + + {/.} basename without file extension + + -X, --exec-batch command + Execute command with all search results at once. A single + occurence of the following placeholders is authorized and + sub stituted by the paths derived from the search results before the + command is executed: + + {} path + + {/} basename + + {//} parent directory + + {.} path without file extension + + {/.} basename without file extension + +** Commands +\\ +|Keys|Description +|-----------+----------| +|\\[helm-ff-run-grep]|Run grep (`\\[universal-argument]' to recurse). +|\\[helm-ff-run-zgrep]|Run zgrep. +|\\[helm-ff-run-pdfgrep]|Run PDFgrep on marked files. +|\\[helm-ff-run-copy-file]|Copy file(s) +|\\[helm-ff-run-rename-file]|Rename file(s). +|\\[helm-ff-run-symlink-file]|Symlink file(s). +|\\[helm-ff-run-hardlink-file]|Hardlink file(s). +|\\[helm-ff-run-delete-file]|Delete file(s). +|\\[helm-ff-run-byte-compile-file]|Byte compile Elisp file(s) (`\\[universal-argument]' to load). +|\\[helm-ff-run-load-file]|Load Elisp file(s). +|\\[helm-ff-run-ediff-file]|Ediff file. +|\\[helm-ff-run-ediff-merge-file]|Ediff-merge file. +|\\[helm-ff-run-switch-other-window]|Switch to other window. +|\\[helm-ff-properties-persistent]|Show file properties. +|\\[helm-ff-run-open-file-externally]|Open file with external program (`\\[universal-argument]' to choose). +|\\[helm-ff-run-open-file-with-default-tool]|Open file externally with default tool. +|\\[helm-ff-run-insert-org-link]|Insert org link. +|\\[helm-fd-previous-directory]|Move to previous directory. +|\\[helm-fd-next-directory]|Move to next directory.") + +;;; Generic file help - Used by locate. +;; +;; +(defvar helm-generic-file-help-message + "* Helm Generic files + +** Tips + +*** Locate + +You can append to the search pattern any of the locate command line options, +e.g. -b, -e, -n , etc. See the locate(1) man page for more details. + +Some other sources (at the moment \"recentf\" and \"file in current directory\") +support the -b flag for compatibility with locate when they are used with it. + +When you enable fuzzy matching on locate with `helm-locate-fuzzy-match', the +search will be performed on basename only for efficiency (so don't add \"-b\" at +prompt). As soon as you separate the patterns with spaces, fuzzy matching will +be disabled and search will be done on the full filename. Note that in +multi-match, fuzzy is completely disabled, which means that each pattern is a +match regexp (i.e. \"helm\" will match \"helm\" but \"hlm\" will *not* match +\"helm\"). + +NOTE: On Windows use Everything with its command line ~es~ as a replacement of locate. +See [[https://github.com/emacs-helm/helm/wiki/Locate#windows][Locate on Windows]] + +On recent systems, the updatedb command doesn't +index anymore user directories, see the option PRUNE_BIND_MOUNTS +in the updatedb man page. + +*** Browse project + +When the current directory is not under version control, don't forget to refresh +the cache when files have been added/removed in the directory. + +*** Find command + +Recursively search files using the \"find\" shell command. + +Candidates are all filenames that match all given globbing patterns. This +respects the options `helm-case-fold-search' and +`helm-findutils-search-full-path'. + +You can pass arbitrary \"find\" options directly after a \"*\" separator. +For example, this would find all files matching \"book\" that are larger +than 1 megabyte: + + book * -size +1M + +** Commands +\\ +|Keys|Description +|-----------+----------| +|\\[helm-ff-run-toggle-basename]|Toggle basename. +|\\[helm-ff-run-grep]|Run grep (`\\[universal-argument]' to recurse). +|\\[helm-ff-run-zgrep]|Run zgrep. +|\\[helm-ff-run-pdfgrep]|Run PDFgrep on marked files. +|\\[helm-ff-run-copy-file]|Copy file(s) +|\\[helm-ff-run-rename-file]|Rename file(s). +|\\[helm-ff-run-symlink-file]|Symlink file(s). +|\\[helm-ff-run-hardlink-file]|Hardlink file(s). +|\\[helm-ff-run-delete-file]|Delete file(s). +|\\[helm-ff-run-byte-compile-file]|Byte compile Elisp file(s) (`\\[universal-argument]' to load). +|\\[helm-ff-run-load-file]|Load Elisp file(s). +|\\[helm-ff-run-ediff-file]|Ediff file. +|\\[helm-ff-run-ediff-merge-file]|Ediff-merge file. +|\\[helm-ff-run-switch-other-window]|Switch to other window. +|\\[helm-ff-properties-persistent]|Show file properties. +|\\[helm-ff-run-open-file-externally]|Open file with external program (`\\[universal-argument]' to choose). +|\\[helm-ff-run-open-file-with-default-tool]|Open file externally with default tool. +|\\[helm-ff-run-insert-org-link]|Insert org link.") + +;;; Grep help +;; +;; +(defvar helm-grep-help-message + "* Helm Grep + +** Tips + +With Helm supporting Git-grep and AG/RG, you are better off using +one of them for recursive searches, keeping grep or ack-grep to +grep individual or marked files. See [[Helm AG][Helm AG]]. + +*** Meaning of the prefix argument +**** With grep or ack-grep + +Grep recursively, in this case you are +prompted for types (ack-grep) or for wild cards (grep). + +**** With AG or RG + +the prefix arg allows you to specify a type of file to search in. + +*** You can use wild cards when selecting files (e.g. \"*.el\") + +Note that a way to grep specific files recursively is to use +e.g. \"**.el\" to select files, the variable `helm-file-globstar' +controls this (it is non nil by default), however it is much +slower than using grep recusively (see helm-find-files +documentation about this feature). + +*** Grep hidden files + +You may want to customize your command line for grepping hidden +files, for AG/RG use \"--hidden\", see man page +of your backend for more infos. + +*** You can grep in different directories by marking files or using wild cards + +*** You can save the result in a `helm-grep-mode' buffer + +See [[Commands][commands]] below. + +Once in that buffer you can use [[https://github.com/mhayashi1120/Emacs-wgrep][emacs-wgrep]] (external package not bundled with Helm) +to edit your changes, for Helm the package name is `wgrep-helm', it is hightly recommended. + +Type `g' to update (revert) the buffer (after saving your buffer's changes to file). + +NOTE: `next-error' is available from this `helm-grep-mode' buffer. + +When you are running `next-error' from elsewhere, you can update +the buffer with `helm-revert-next-error-last-buffer' (up to you +to bind it to a convenient key). + +*** Helm-grep supports multi-matching + +\(Starting from version 1.9.4.) + +Simply add a space between each pattern as for most Helm commands. + +NOTE: Depending the regexp you use it may match as well the +filename, this because we pipe the first grep command which send +the filename in output. + +*** See full path of selected candidate + +Add (helm-popup-tip-mode 1) in your init file or enable it +interactively with M-x helm-popup-tip-mode, however it is +generally enough to just put your mouse cursor over candidate. + +*** Stop grepping with AG or RG and search in the current results + +Once you have found your results with helm grep ag you can search +in these results (helm search, no grep). This allows narrowing +the results to a specific file for example or to a specific +pattern without launching grep ag/rg. The command is \\\\[helm-grep-ag-run-search-results]. +If you want to continue grepping, switch to the previous helm session +which is helm-grep-ag session with \\\\[helm-resume-previous-session-after-quit]. + +_NOTE_: This is available only in AG/RG, not grep. + +*** Grep AG/RG on parent directory + +The command +\\\\[helm-grep-run-ag-grep-parent-directory] allow to grep the parent directory +of the currently searched directory. + +*** Open file in other window + +The command \\\\[helm-grep-run-other-window-action] allow you to open file +in other window horizontally or vertically if a prefix arg is supplied. + +*** Performance over TRAMP + +Grepping works but it is badly supported as TRAMP doesn't support multiple +processes running in a short delay (less than 5s) among other things. + +Helm uses a special hook to suspend the process automatically while you are +typing. Even if Helm handles this automatically by delaying each process by 5s, +you are adviced to this manually by hitting `\\\\[helm-toggle-suspend-update]' (suspend process) before +typing, and hit again `\\\\[helm-toggle-suspend-update]' when the regexp is ready to send to the remote +process. For simple regexps, there should be no need for this. + +Another solution is to not use TRAMP at all and mount your remote file system via +SSHFS. + +* Helm GID + +Still supported, but mostly deprecated, using AG/RG or Git-grep +is much more efficient, also `id-utils' seems no more maintained. + +** Tips + +Helm-GID reads the database created with the `mkid' command from id-utils. +The name of the database file can be customized with `helm-gid-db-file-name', it +is usually \"ID\". + +Helm-GID use the symbol at point as default-input. This command is also +accessible from `helm-find-files' which allow you to navigate to another +directory to consult its database. + +Note: Helm-GID supports multi-matches but only the last pattern entered will be +highlighted since there is no ~--color~-like option in GID itself. + +* Helm AG + +** Tips + +Helm-AG is different from grep or ack-grep in that it works on a +directory recursively and not on a list of files. It is called +helm-AG but it support several backend, namely AG, RG and PT. +Nowaday the best backend is Ripgrep aka RG, it is the fastest and +is actively maintained, see `helm-grep-ag-command' and +`helm-grep-ag-pipe-cmd-switches' to configure it. + +You can ignore files and directories with a \".agignore\" or +\".rgignore\" file, local to a directory or global when placed in +the home directory. (See the AG/RG man pages for more details.) +Note that `helm-grep-ignored-files'and +`helm-grep-ignored-directories' have no effect in helm-AG/RG. + +As always you can access Helm AG from `helm-find-files'. + +Starting with version 0.30, AG accepts one or more TYPE arguments on its command +line. Helm provides completion on these TYPE arguments when available with your +AG version. Use a prefix argument when starting a Helm-AG session to enable this +completion. See RG and AG man pages on how to add new types. + + +Note: You can mark several types to match in the AG query. The first AG +versions providing this feature allowed only one type, so in this case only the +last mark will be used. + +* Helm git-grep + +Helm-git-grep searches the current directory, i.e. the default directory or the +directory in Helm-find-files. If this current directory is a subdirectory of a +project and you want to also match parent directories (i.e the whole project), +use a prefix argument. + +** Commands +\\ +|Keys|Description +|-----------+----------| +|\\[helm-goto-next-file]|Next File. +|\\[helm-goto-precedent-file]|Previous File. +|\\[helm-yank-text-at-point]|Yank text at point in minibuffer. +|\\[helm-grep-run-other-window-action]|Jump to other window. +|\\[helm-grep-run-other-frame-action]|Jump to other frame. +|\\[helm-grep-run-default-action]|Run default action (same as `RET'). +|\\[helm-grep-run-save-buffer]|Save to a `helm-grep-mode' enabled buffer.") + +;;; PDF grep help +;; +;; +(defvar helm-pdfgrep-help-message + "* Helm PDFgrep Map + +** Commands +\\ +|Keys|Description +|-----------+----------| +|\\[helm-goto-next-file]|Next file. +|\\[helm-goto-precedent-file]|Previous file. +|\\[helm-yank-text-at-point]|Yank text at point in minibuffer.") + +;;; Etags help +;; +;; +(defvar helm-etags-help-message + "* Helm Etags Map + +** Commands +\\ +|Keys|Description +|-----------+----------| +|\\[helm-goto-next-file]|Next file. +|\\[helm-goto-precedent-file]|Previous file. +|\\[helm-yank-text-at-point]|Yank text at point in minibuffer.") + +;;; UCS help +;; +;; +(defvar helm-ucs-help-message + "* Helm UCS + +** Tips + +Use commands below to insert unicode characters in current buffer without +leaving Helm. + +** Commands +\\ +|Keys|Description +|-----------+----------| +|\\[helm-ucs-persistent-insert]|Insert character. +|\\[helm-ucs-persistent-forward]|Forward character. +|\\[helm-ucs-persistent-backward]|Backward character. +|\\[helm-ucs-persistent-delete]|Delete character backward. +|\\[helm-ucs-persistent-insert-space]|Insert space.") + +;;; Bookmark help +;; +;; +(defvar helm-bookmark-help-message + "* Helm bookmark name + +** Tips + +*** Display bookmarks with Icons + +When `helm-bookmark-use-icon' is non nil and you have a +`helm-x-icons-provider' either `all-the-icons' or `nerd-icons' package +is installed icons before candidates will be displayed. + +*** Reset bookmark position + +When using `helm-filtered-bookmarks' you can modify your bookmark +position by resetting it, to do this, jump to your bookmark, move point +to the new location, then call again `helm-filtered-bookmarks' and find +your current bookmark, yank its name in minibuffer with `\\\\[helm-yank-selection]' +switch to the \"Set bookmark\" source and hit RET. + +** Commands +\\ +|Keys|Description +|-----------+----------| +|\\[helm-bookmark-run-jump-other-window]|Jump other window. +|\\[helm-bookmark-run-delete]|Delete bookmark. +|\\[helm-bookmark-run-edit]|Edit bookmark. +|\\[helm-bookmark-toggle-filename]|Toggle bookmark location visibility.") + +;;; Eshell command on file help +;; +;; +(defvar helm-esh-help-message + "* Helm Eshell on file + +** Tips + +*** Pass extra arguments after filename + +Normally the command or alias will be called with file as argument. For instance + + candidate_file + +But you can also pass an argument or more after \"candidate_file\" like this: + + %s [extra_args] + +\"candidate_file\" will be added at \"%s\" and the command will look at this: + + candidate_file [extra_args] + +**** Use placeholders in extra arguments + +placeholder for file without extension: \\@ +placeholder for incremental number: \\# + +\"candidate_file\" will be added at \"%s\" and \\@ but without extension. + + + +\"candidate_file\" will be added at \"%s\" and \\# will be replaced by an incremental number. + + %s \\# + +Here examples: + +Say you want to use the =convert= command to convert all your .png files in a directory to .jpg. + +This will convert all your files to jpg keeping the same basename. + + convert %s \\@.jpg + +This will convert all your files to foo-001.jpg, foo-002.jpg etc... + + convert %s foo-\\#.jpg + +You can of course combine both placeholders if needed. + + convert %s \\@-\\#.jpg + +*** Specify marked files as arguments + +When you have marked files and your command support only one file +as arg, helm will execute command sequencially on each file like +this: + +Example: + + file1 + file2 + ...etc + +When you have marked files and your command accept many files at +once helm will run your command with all files at once like this: + +Example: + + file1 file2 etc... + +The two use case above are applied automatically by Helm +depending if your command is an eshell alias which value ends by +'$1' or '$*'. If your command is not an alias, i.e. you entered +an arbitrary command on prompt with '%s' to specify filenames, +you will have to pass one prefix argument from the command +selection buffer. + +Note: This does not work on remote files. + +With two prefix-args the output is printed to the +`current-buffer', the command being executed in the same +conditions as described above. +NOTE: If your command is not an alias, you can't pass all files at once and print in current buffer at the same time. +Also note that running multiple files at once is not supported with remote files. + +*** Run eshell commands asynchronously + +You can run your commands asynchronously by adding \"&\" at end +of any commands, e.g. \"foo %s &\". You can also directly setup +your alias in the eshell alias file with e.g. \"alias foo $1 &\". + +** Commands +\\") + +;;; Ido virtual buffer help +;; +;; +(defvar helm-buffers-ido-virtual-help-message + "* Helm Ido virtual buffers + +** Commands +\\ +|Keys|Description +|-----------+----------| +|\\[helm-ff-run-switch-other-window]|Switch to other window. +|\\[helm-ff-run-switch-other-frame]|Switch to other frame. +|\\[helm-ff-run-grep]|Grep file. +|\\[helm-ff-run-zgrep]|Zgrep file. +|\\[helm-ff-run-delete-file]|Delete file. +|\\[helm-ff-run-open-file-externally]|Open file externally.") + +;;; helm-occur help +;; +;; +(defvar helm-moccur-help-message + "* Helm Moccur + +** Tips + +*** Searching in many buffers + +Start from `helm-buffers-list' or `helm-mini', mark some buffers and hit \\\\[helm-execute-persistent-action]' (persistent-action), to do it repeatedly +you can use `\\\\[helm-follow-action-forward]' and `\\\\[helm-follow-action-backward]' or enable `helm-follow-mode' with `\\\\[helm-follow-mode]'. +Follow mode is enabled by default in helm-occur. + +*** Switch to buffer in other window + +The command \\\\[helm-moccur-run-goto-line-ow] allow you to switch to buffer +in other window horizontally or vertically if a prefix arg is supplied. + +*** Save the results + +Similarly to Helm-grep, you can save the results with `\\\\[helm-occur-run-save-buffer]'. +Once in the saved buffer, you can edit it, see [[Edit a saved buffer][below]]. + +Of course if you don't save the results, you can resume the Helm session with +`helm-resume'. + +*** Refresh the resumed session + +When the buffer(s) where you ran helm-(m)occur get(s) modified, the Helm buffer +will flash red as a warning. You can refresh the buffer by running `\\\\[helm-refresh]'. +This can be done automatically by customizing `helm-moccur-auto-update-on-resume'. + +*** Refresh a saved buffer + +Type `g' to update (revert) the buffer. + +When you are running `next-error' from elsewhere, you can update +the buffer with `helm-revert-next-error-last-buffer' (up to you +to bind it to a convenient key). + +*** Edit a saved buffer + +First, install wgrep (https://github.com/mhayashi1120/Emacs-wgrep) and then: + +1) `C-c C-p' (`wgrep-change-to-wgrep-mode') to edit the buffer(s). +2) `C-x C-s' to save your changes. + +Tip: Use the excellent iedit (https://github.com/victorhge/iedit) to modify all +occurences at once in the buffer. + +NOTE: `next-error' is available from this `helm-occur-mode' buffer. + +*** Search in region + +When searching in current-buffer with `helm-occur', if a region +is found helm will search in this region only. If you marked +this region with `mark-defun' the symbol that was at point before +marking defun will be used when `helm-source-occur' is member of +`helm-sources-using-default-as-input'. + +*** Switch to next or previous source + +See [[Moving in `helm-buffer'][Moving in `helm-buffer']]. + +** Commands +\\ +|Keys|Description +|-----------+----------| +|\\[helm-occur-run-goto-line-ow]|Go to line in other window. +|\\[helm-occur-run-goto-line-of]|Go to line in new frame. +|\\[helm-occur-run-save-buffer]|Save results in new buffer.") +;;; Helm Top +;; +;; +(defvar helm-top-help-message + "* Helm Top + +** Tips + +*** Auto update + +You can enable auto updating in `helm-top' by turning on +`helm-top-poll-mode' either interactively or in your init file +with (helm-top-poll-mode 1). +Calling `helm-top' with a prefix arg also toggle auto updating. + +** Commands +\\ +|Keys|Description +|-----------+----------| +|\\[helm-top-run-sort-by-com]|Sort by commands. +|\\[helm-top-run-sort-by-cpu]|Sort by CPU usage. +|\\[helm-top-run-sort-by-user]|Sort alphabetically by user. +|\\[helm-top-run-sort-by-mem]|Sort by memory.") + +;;; Helm M-x +;; +;; +(defvar helm-M-x-help-message + "* Helm M-x + +** Tips + +*** Display docstring without quitting session (persistent action) + +You can get help on any command with persistent action (\\\\[helm-execute-persistent-action]) + +*** Display short docstring in helm buffer + +You can toggle short docstring description with \\\\[helm-M-x-toggle-short-doc]. +if you want this at startup you can configure `helm-M-x-show-short-doc'. + +NOTE: helm-M-x will be slower with this enabled. + +*** History source + +Helm-M-x is displaying two sources, one for the commands +themselves and one for the command history, more exactly +`extended-command-history', by default the history source is +displayed in first position, however you can put it in second +position if you don't like that by customizing +`helm-M-x-reverse-history'. + +**** Duplicate entries in helm-M-x history + +helm-M-x history obey to history variables, if you have +duplicates in your helm-M-x history set `history-delete-duplicates' to non nil. + +**** Number of entries in history + +The number of entries saved is controlled by `history-length' +global value, however if you want a different value for +`extended-command-history' e.g. 50 you can add to your config: + + (put 'extended-command-history 'history-length 50) + +*** Enabled modes are highlighted in helm-M-x + +*** Prefix arguments + +You can pass prefix arguments *after* starting `helm-M-x'. A mode-line +counter will display the number of given prefix arguments. + +If you pass prefix arguments before running `helm-M-x', it will +be displayed in the prompt. +The first `\\\\[universal-argument]' after `helm-M-x' clears those prefix arguments. + +NOTE: When you specify prefix arguments once `helm-M-x' is +started, the prefix argument apply on the next command, so if you +hit RET, it will apply on the selected command, but if you type a +new character at prompt to narrow down further candidates, the +prefix arg will apply to `self-insert-command' (e.g. if you type +`C-u e' \"eeee\" will be inserted in prompt) so select the +command you want to execute before specifying prefix arg. + +** Commands +\\ +|Keys|Description +|-----------+------------| +|\\[helm-M-x-universal-argument]|Universal argument for selected command +|\\[helm-M-x-toggle-short-doc]|Toggle details on commands") + + +;;; Helm imenu +;; +;; +(defvar helm-imenu-help-message + "* Helm Imenu + +** Commands +\\ +|Keys|Description +|-----------+----------| +|\\[helm-imenu-next-section]|Go to next section. +|\\[helm-imenu-previous-section]|Go to previous section.") + +;;; Helm colors +;; +;; +(defvar helm-colors-help-message + "* Helm colors + +** Commands +\\ +|Keys|Description +|-----------+----------| +|\\[helm-color-run-insert-name]|Insert the entry name. +|\\[helm-color-run-kill-name]|Kill the entry name. +|\\[helm-color-run-insert-rgb]|Insert entry in RGB format. +|\\[helm-color-run-kill-rgb]|Kill entry in RGB format.") + +;;; Helm Semantic +;; +;; +(defvar helm-semantic-help-message + "* Helm Semantic + +** Commands +\\") + +;;; Helm kmacro +;; +;; +(defvar helm-kmacro-help-message + "* Helm kmacro + +** Tips + +- Start recording a kmacro with `f3'. +- End the kmacro recording with `f4'. +- Run `helm-execute-kmacro' to list all your kmacros. + +When you press RET, your macro goes on top of ring and become the +current macro, hit `f4' for further executions. +Use `helm-execute-kmacro' again to change eventually your macro to execute. + +Note: You can't record keys running Helm commands except `helm-M-x', under the +condition that you don't choose a command using Helm completion. + +See [[info:emacs#Keyboard Macros][Keyboard Macros]] for further infos on macros. + +** Commands +\\") + +;;; Kill ring +;; +;; +(defvar helm-kill-ring-help-message + "* Helm kill ring + +** Tips + +Every Helm session lets you save a candidate to the kill-ring / clipboard / +primary-selection with `\\\\[helm-kill-selection-and-quit]'. + +To save space, Helm-kill-ring truncates the candidates longer than +`helm-kill-ring-max-offset'. +`\\\\[helm-kill-ring-kill-selection]' then saves the whole +text and not the truncated value. The view of truncated candidates can be +toggled; see the command list below. + +As opposed to `yank', numeric prefix arguments are ignored with +`helm-show-kill-ring': there is no need for them since selection happens within +Helm. Moreover Helm has [[Shortcuts for executing the default action on the n-th candidate][Shortcuts for executing the default action on the n-th candidate]]. + +It is recommended to globally bind `M-y' to `helm-show-kill-ring'. Once in the +Helm-kill-ring session you can navigate to next/previous line with `M-y' and +`M-u' for convenience. Of course `\\[helm-next-line]' and `\\[helm-previous-line]' are still available. + +It is possible to delete candidates from the kill ring with `\\\\[helm-kill-ring-delete]' +but also persistently with `\\\\[helm-kill-ring-run-persistent-delete]'. + +You can concatenate marked candidates and yank them in the current +buffer, thus creating a new entry in the kill ring. Candidates are +concatenated with `helm-kill-ring-separator' as default but you can +change interactively the separator while yanking by using two prefix +args. When you have something else than \"\\n\" as default value for +`helm-kill-ring-separator' and you want to use \"\\n\" from prompt, use +`C-q C-j' to enter a newline in prompt. + +To not push a new entry in the kill ring, use `\\\\[helm-copy-to-buffer]' instead of RET +\(note that you can't change separator with this). + +When inserting candidates with the default action (`RET'), `point' is placed at +the end of the candidate and `mark' at the beginning. You can revert this behavior +by using a prefix argument, i.e. `C-u RET', like the regular `yank' command does. + +** Commands +\\ +|Keys|Description +|-----------+----------| +|\\[helm-next-line]|Next line. +|\\[helm-previous-line]|Previous line. +|\\[helm-kill-ring-delete]|Delete entry. +|\\[helm-kill-ring-toggle-truncated]|Toggle truncated view of candidate. +|\\[helm-kill-ring-kill-selection]|Kill non-truncated of selection.") + +;;; Completing-read +;; +(defun helm-comp-read-help-message () + (let ((com (assoc-default 'name (helm-get-current-source)))) + (format + "* Helm completing-read completion for `%s' + +Command `%s' is using a `completing-read' for completion on your input, +this completion have been \"helmized\" because you have enabled [[Helm mode][helm-mode]]'. + +** Tips + +*** Disabling or use something else than helm for completion of some commands + +You can disable helm completion or use something else for specific commands of your choice, +for this customize variable `helm-completing-read-handlers-alist'. + +*** Exiting minibuffer with empty string + +You can exit minibuffer with empty string with \\\\[helm-cr-empty-string]. +It is useful when some commands are prompting continuously until you enter an empty prompt. + +** Commands +\\ +|Keys|Description +|-----------+----------| +|\\[helm-cr-empty-string]|Exit minibuffer with empty string." + com com))) + + +;;; Mode line strings +;; +;; +;;;###autoload +(defvar helm-comp-read-mode-line "\ +\\\ +C/\\[helm-cr-empty-string]:Empty \ +\\\ +\\[helm-help]:Help \ +\\[helm-select-action]:Act \ +\\[helm-maybe-exit-minibuffer]/\ +f1/f2/f-n:NthAct \ +\\[helm-toggle-suspend-update]:Tog.suspend \ +\\[helm-customize-group]:Conf") + +;;;###autoload +(defvar helm-read-file-name-mode-line-string "\ +\\\ +\\[helm-help]:Help \ +C/\\[helm-cr-empty-string]:Empty \ +\\\ +\\[helm-select-action]:Act \ +\\[helm-maybe-exit-minibuffer]/\ +f1/f2/f-n:NthAct \ +\\[helm-toggle-suspend-update]:Tog.suspend \ +\\[helm-customize-group]:Conf" + "String displayed in mode-line in `helm-source-find-files'.") + +;;;###autoload +(defvar helm-top-mode-line "\ +\\\ +\\[helm-help]:Help \ +\\\ +\\[helm-select-action]:Act \ +\\[helm-maybe-exit-minibuffer]/\ +f1/f2/f-n:NthAct \ +\\[helm-toggle-suspend-update]:Tog.suspend \ +\\[helm-customize-group]:Conf") + + +(provide 'helm-help) + +;;; helm-help.el ends here diff --git a/elpa/helm-20260424.1357/helm-id-utils.el b/elpa/helm-20260424.1357/helm-id-utils.el new file mode 100644 index 00000000..96159aaa --- /dev/null +++ b/elpa/helm-20260424.1357/helm-id-utils.el @@ -0,0 +1,127 @@ +;;; helm-id-utils.el --- Helm interface for id-utils. -*- lexical-binding: t -*- + +;; Copyright (C) 2015 ~ 2026 Thierry Volpiatto + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Code: + +(require 'helm-grep) +(require 'helm-help) + +(defgroup helm-id-utils nil + "ID-Utils related Applications and libraries for Helm." + :group 'helm) + +(defcustom helm-gid-program "gid" + "Name of gid command (usually `gid'). +For Mac OS X users, if you install GNU coreutils, the name `gid' +might be occupied by `id' from GNU coreutils, and you should set +it to correct name (or absolute path). For example, if using +MacPorts to install id-utils, it should be `gid32'." + :group 'helm-id-utils + :type 'file) + +(defcustom helm-gid-db-file-name "ID" + "Name of a database file created by `mkid' command from `ID-utils'." + :group 'helm-id-utils + :type 'string) + +(defun helm-gid-candidates-process () + (let* ((patterns (helm-mm-split-pattern helm-pattern)) + (default-com (format "%s -r %s" helm-gid-program + (shell-quote-argument (car patterns)))) + (cmd (helm-aif (cdr patterns) + (concat default-com + (cl-loop for p in it + concat (format " | grep --color=always %s" + (shell-quote-argument p)))) + default-com)) + (start-time (float-time)) + (proc (start-process-shell-command + "gid" helm-buffer cmd))) + (set (make-local-variable 'helm-grep-last-cmd-line) cmd) + (prog1 proc + (set-process-sentinel + proc (lambda (process event) + (when (or (string= event "finished\n") + (process-get process 'reach-limit)) + (helm-maybe-show-popup-tip-info) + (with-helm-window + (setq mode-line-format + `(" " mode-line-buffer-identification " " + (:eval (format "L%s" (helm-candidate-number-at-point))) " " + (:eval (propertize + (format "[%s process finished in %.2fs - (%s results)] " + ,(upcase (process-name process)) + ,(- (float-time) start-time) + (helm-get-candidate-number)) + 'face 'helm-locate-finish)))) + (force-mode-line-update)) + (helm-log "helm-gid-candidates-process" "Error: Gid %s" + (replace-regexp-in-string "\n" "" event)))))))) + +(defun helm-gid-filtered-candidate-transformer (candidates _source) + ;; "gid -r" may add dups in some rare cases. + (cl-loop for c in (helm-fast-remove-dups candidates :test 'equal) + collect (helm-grep--filter-candidate-1 c))) + +(defclass helm-gid-source (helm-source-async) + ((header-name + :initform + (lambda (name) + (concat name " [" (helm-get-attr 'db-dir) "]"))) + (db-dir :initarg :db-dir + :initform nil + :custom string + :documentation " Location of ID file.") + (candidates-process :initform #'helm-gid-candidates-process) + (filtered-candidate-transformer + :initform #'helm-gid-filtered-candidate-transformer) + (popup-info :initform #'helm-grep-popup-info-fn) + (action :initform (helm-make-actions + "Find File" 'helm-grep-action + "Find file other frame" 'helm-grep-other-frame + "Save results in grep buffer" 'helm-grep-save-results + "Find file other window" 'helm-grep-other-window)) + (persistent-action :initform 'helm-grep-persistent-action) + (history :initform 'helm-grep-history) + (nohighlight :initform t) + (help-message :initform 'helm-grep-help-message) + (requires-pattern :initform 2))) + +;;;###autoload +(defun helm-gid () + "Preconfigured `helm' for `gid' command line of `ID-Utils'. +Need A database created with the command `mkid' above +`default-directory'. +Need id-utils as dependency which provide `mkid', `gid' etc.. +See ." + (interactive) + (let* ((db (locate-dominating-file + default-directory + helm-gid-db-file-name)) + (helm-grep-default-directory-fn + (lambda () default-directory)) + (helm-maybe-use-default-as-input t)) + (cl-assert db nil "No DataBase found, create one with `mkid'") + (helm :sources (helm-make-source "Gid" 'helm-gid-source + :db-dir db) + :buffer "*helm gid*" + :keymap helm-grep-map + :truncate-lines helm-grep-truncate-lines))) + +(provide 'helm-id-utils) + +;;; helm-id-utils ends here diff --git a/elpa/helm-20260424.1357/helm-imenu.el b/elpa/helm-20260424.1357/helm-imenu.el new file mode 100644 index 00000000..e9d481ce --- /dev/null +++ b/elpa/helm-20260424.1357/helm-imenu.el @@ -0,0 +1,541 @@ +;;; helm-imenu.el --- Helm interface for Imenu -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2026 Thierry Volpiatto + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Code: + +(require 'cl-lib) +(require 'helm) +(require 'helm-lib) +(require 'imenu) +(require 'helm-utils) +(require 'helm-help) +(require 'helm-x-icons) + +(defvar all-the-icons-default-adjust) +(defvar all-the-icons-scale-factor) +(defvar nerd-icons-default-adjust) +(defvar nerd-icons-scale-factor) + +(declare-function which-function "which-func") + + +(defgroup helm-imenu nil + "Imenu related libraries and applications for Helm." + :group 'helm) + +(defcustom helm-imenu-delimiter " / " + "Delimit types of candidates and their value in `helm-buffer'." + :group 'helm-imenu + :type 'string) + +(defcustom helm-imenu-execute-action-at-once-if-one + #'helm-imenu--execute-action-at-once-p + "Goto the candidate when only one is remaining." + :group 'helm-imenu + :type 'function) + +(defcustom helm-imenu-all-buffer-assoc nil + "Major mode association alist for `helm-imenu-in-all-buffers'. +Allow `helm-imenu-in-all-buffers' searching in these associated +buffers even if they are not derived from each other. The alist +is bidirectional, i.e. no need to add \\='((foo . bar) (bar . foo)), +only \\='((foo . bar)) is needed." + :type '(alist :key-type symbol :value-type symbol) + :group 'helm-imenu) + +(defcustom helm-imenu-in-all-buffers-separate-sources t + "Display imenu index of each buffer in its own source when non-nil. + +When nil all candidates are displayed in a single source. + +NOTE: Each source will have as name \"Imenu \". +`helm-source-imenu-all' will not be set, however it will continue +to be used as a flag for using default as input. If you do not +want this behavior, remove it from +`helm-sources-using-default-as-input' even if not using a single +source to display imenu in all buffers." + :type 'boolean + :group 'helm-imenu) + +(defcustom helm-imenu-type-faces + '(("^Variables$" . font-lock-variable-name-face) + ("^\\(Function\\|Functions\\|Defuns\\)$" . font-lock-function-name-face) + ("^\\(Types\\|Provides\\|Requires\\|Classes\\|Class\\|Includes\\|Imports\\|Misc\\|Code\\)$" . font-lock-type-face)) + "Faces for showing type in helm-imenu. +This is a list of cons cells. The cdr of each cell is a face to +be used, and it can also just be like \\='(:foreground +\"yellow\"). Each car is a regexp match pattern of the imenu type +string." + :group 'helm-faces + :type '(repeat + (cons + (regexp :tag "Imenu type regexp pattern") + (sexp :tag "Face")))) + +(defcustom helm-imenu-extra-modes nil + "Extra modes where `helm-imenu-in-all-buffers' should look into." + :group 'helm-imenu + :type '(repeat symbol)) + +(defcustom helm-imenu-hide-item-type-name nil + "Hide display name of imenu item type along with the icon when non nil. + +This value can be toggled with \\\\[helm-imenu-toggle-type-view]. +Don't use `setq' to set this." + :group 'helm-imenu + :type 'boolean + :set (lambda (var val) + (if (require helm-x-icons-provider nil t) + (set var val) + (set var nil)))) + +(defcustom helm-imenu-use-icon nil + "Display an icon from `helm-x-icons-provider' package when non nil. + +Don't use `setq' to set this." + :group 'helm-imenu + :type 'boolean + :set (lambda (var val) + (set var (and (require helm-x-icons-provider nil t) val)))) + +(defcustom helm-imenu-icon-type-alist + '(("Array" . (helm-x-icons-generic "crop" :face font-lock-builtin-face)) + ("Arrays" . (helm-x-icons-generic "crop" :face font-lock-builtin-face)) + ("Boolean" . (helm-x-icons-generic "crop" :face font-lock-builtin-face)) + ("Booleans" . (helm-x-icons-generic "crop" :face font-lock-builtin-face)) + ("Class" . (helm-x-icons-generic "package" :face font-lock-type-face)) + ("Classes" . (helm-x-icons-generic "package" :face font-lock-type-face)) + ("Color" . (helm-x-icons-generic "color_lens" :face font-lock-builtin-face)) + ("Colors" . (helm-x-icons-generic "color_lens" :face font-lock-builtin-face)) + ("Constant" . (helm-x-icons-generic "crop" :face font-lock-builtin-face)) + ("Constants" . (helm-x-icons-generic "crop" :face font-lock-builtin-face)) + ("Constructor" . (helm-x-icons-generic "cube" :face font-lock-function-name-face)) + ("Constructors" . (helm-x-icons-generic "cube" :face font-lock-function-name-face)) + ("Enum Member" . (helm-x-icons-generic "three-bars" :face font-lock-type-face)) + ("Enum Members" . (helm-x-icons-generic "three-bars" :face font-lock-type-face)) + ("Enum" . (helm-x-icons-generic "cog" :face font-lock-type-face)) + ("Enums" . (helm-x-icons-generic "cog" :face font-lock-type-face)) + ("Event" . (helm-x-icons-generic "lightning" :face font-lock-builtin-face)) + ("Events" . (helm-x-icons-generic "lightning" :face font-lock-builtin-face)) + ("Field" . (helm-x-icons-generic "three-bars" :face font-lock-type-face)) + ("Fields" . (helm-x-icons-generic "three-bars" :face font-lock-type-face)) + ("File" . (helm-x-icons-generic "file" :face font-lock-variable-name-face)) + ("Files" . (helm-x-icons-generic "file" :face font-lock-variable-name-face)) + ("Folder" . (helm-x-icons-generic "folder" :face font-lock-variable-name-face)) + ("Folders" . (helm-x-icons-generic "folder" :face font-lock-variable-name-face)) + ("Interface" . (helm-x-icons-generic "package" :face font-lock-builtin-face)) + ("Interfaces" . (helm-x-icons-generic "package" :face font-lock-builtin-face)) + ("Keyword" . (helm-x-icons-generic "key" :face font-lock-builtin-face)) + ("Keywords" . (helm-x-icons-generic "key" :face font-lock-builtin-face)) + ("Method" . (helm-x-icons-generic "cube" :face font-lock-function-name-face)) + ("Methods" . (helm-x-icons-generic "cube" :face font-lock-function-name-face)) + ("Defun" . (helm-x-icons-generic "cube" :face font-lock-function-name-face)) + ("Defuns" . (helm-x-icons-generic "cube" :face font-lock-function-name-face)) + ("Fn" . (helm-x-icons-generic "cube" :face font-lock-function-name-face)) + ("Fns" . (helm-x-icons-generic "cube" :face font-lock-function-name-face)) + ("Function" . (helm-x-icons-generic "cube" :face font-lock-function-name-face)) + ("Functions" . (helm-x-icons-generic "cube" :face font-lock-function-name-face)) + ("Misc" . (helm-x-icons-generic "globe" :face font-lock-function-name-face)) + ("Miscs" . (helm-x-icons-generic "globe" :face font-lock-function-name-face)) + ("Module" . (helm-x-icons-generic "angle-double-right" :face font-lock-builtin-face)) + ("Modules" . (helm-x-icons-generic "angle-double-right" :face font-lock-builtin-face)) + ("Numeric" . (helm-x-icons-generic "crop" :face font-lock-builtin-face)) + ("Numerics" . (helm-x-icons-generic "crop" :face font-lock-builtin-face)) + ("Object" . (helm-x-icons-generic "angle-double-right" :face font-lock-builtin-face)) + ("Objects" . (helm-x-icons-generic "angle-double-right" :face font-lock-builtin-face)) + ("Operator" . (helm-x-icons-generic "calculator" :face font-lock-builtin-face)) + ("Operators" . (helm-x-icons-generic "calculator" :face font-lock-builtin-face)) + ("Property" . (helm-x-icons-generic "book" :face font-lock-variable-name-face)) + ("Properties" . (helm-x-icons-generic "book" :face font-lock-variable-name-face)) + ("Reference" . (helm-x-icons-generic "book" :face font-lock-variable-name-face)) + ("References" . (helm-x-icons-generic "book" :face font-lock-variable-name-face)) + ("Snippet" . (helm-x-icons-generic "border_style" :face font-lock-variable-name-face)) + ("Snippets" . (helm-x-icons-generic "border_style" :face font-lock-variable-name-face)) + ("String" . (helm-x-icons-generic "text_fields" :face font-lock-variable-name-face)) + ("Strings" . (helm-x-icons-generic "text_fields" :face font-lock-variable-name-face)) + ("Struct" . (helm-x-icons-generic "cog" :face font-lock-type-face)) + ("Structs" . (helm-x-icons-generic "cog" :face font-lock-type-face)) + ("Text" . (helm-x-icons-generic "text_fields" :face font-lock-variable-name-face)) + ("Texts" . (helm-x-icons-generic "text_fields" :face font-lock-variable-name-face)) + ("Top level" . (helm-x-icons-generic "globe" :face font-lock-function-name-face)) + ("Trait" . (helm-x-icons-generic "package" :face font-lock-builtin-face)) + ("Traits" . (helm-x-icons-generic "package" :face font-lock-builtin-face)) + ("Type" . (helm-x-icons-generic "cog" :face font-lock-type-face)) + ("Types" . (helm-x-icons-generic "cog" :face font-lock-type-face)) + ("Type Parameter" . (helm-x-icons-generic "code" :face font-lock-type-face)) + ("Type Parameters" . (helm-x-icons-generic "code" :face font-lock-type-face)) + ("Unit" . (helm-x-icons-generic "bar-chart" :face font-lock-builtin-face)) + ("Units" . (helm-x-icons-generic "bar-chart" :face font-lock-builtin-face)) + ("Value" . (helm-x-icons-generic "cog" :face font-lock-type-face)) + ("Values" . (helm-x-icons-generic "cog" :face font-lock-type-face)) + ("Variable" . (helm-x-icons-generic "book" :face font-lock-variable-name-face)) + ("Variables" . (helm-x-icons-generic "book":face font-lock-variable-name-face))) + "An alist of types associated with a sexp returning an icon. +The sexp should be an `all-the-icons' function with its args." + :type '(alist :key-type string :value-type sexp) + :group 'helm-imenu) + +(defcustom helm-imenu-default-type-sexp + '(helm-x-icons-generic "globe" :face font-lock-function-name-face) + "Default sexp to use when no type for an object is found." + :type 'sexp + :group 'helm-imenu) + +;;; keymap +(defvar helm-imenu-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (define-key map (kbd "M-") 'helm-imenu-next-section) + (define-key map (kbd "M-") 'helm-imenu-previous-section) + (define-key map (kbd "C-]") 'helm-imenu-toggle-type-view) + map)) + +(defun helm-imenu-toggle-type-view () + "Toggle candidate type view." + (interactive) + (with-helm-window + (setq helm-imenu-hide-item-type-name (not helm-imenu-hide-item-type-name)) + (let* ((sel (substring (helm-get-selection nil 'withprop) + (if helm-imenu-use-icon 2 0))) + (type (get-text-property 1 'type-name sel))) + (setq sel (substring-no-properties sel)) + (helm-force-update (if helm-imenu-hide-item-type-name + (format "^[ ]*%s$" + (car (last (split-string + sel helm-imenu-delimiter t)))) + (format "^[ ]*%s / %s$" + type sel)))))) +(put 'helm-imenu-toggle-type-view 'no-helm-mx t) + +(defcustom helm-imenu-lynx-style-map nil + "Use Arrow keys to jump to occurences." + :group 'helm-imenu + :type 'boolean + :set (lambda (var val) + (set var val) + (if val + (progn + (define-key helm-imenu-map (kbd "") 'helm-execute-persistent-action) + (define-key helm-imenu-map (kbd "") 'helm-maybe-exit-minibuffer)) + (define-key helm-imenu-map (kbd "") nil) + (define-key helm-imenu-map (kbd "") nil)))) + +(defun helm-imenu-next-or-previous-section (n) + (with-helm-window + (let* ((fn (lambda () + (let ((str (buffer-substring + (pos-bol) (pos-eol)))) + (if helm-imenu-hide-item-type-name + (get-text-property 1 'type-name str) + (car (split-string str helm-imenu-delimiter)))))) + (curtype (funcall fn)) + (stop-fn (if (> n 0) + #'helm-end-of-source-p + #'helm-beginning-of-source-p))) + (while (and (not (funcall stop-fn)) + (string= curtype (funcall fn))) + (forward-line n)) + (helm-mark-current-line) + (helm-follow-execute-persistent-action-maybe)))) + +(defun helm-imenu-next-section () + (interactive) + (helm-imenu-next-or-previous-section 1)) + +(defun helm-imenu-previous-section () + (interactive) + (helm-imenu-next-or-previous-section -1)) + + +;;; Internals +(defvar helm-cached-imenu-alist nil) +(make-variable-buffer-local 'helm-cached-imenu-alist) + +(defvar helm-cached-imenu-candidates nil) +(make-variable-buffer-local 'helm-cached-imenu-candidates) + +(defvar helm-cached-imenu-tick nil) +(make-variable-buffer-local 'helm-cached-imenu-tick) + +(defvar helm-imenu--in-all-buffers-cache nil) + + +(defvar helm-source-imenu nil "See (info \"(emacs)Imenu\")") +(defvar helm-source-imenu-all nil) + +(defclass helm-imenu-source (helm-source-sync) + ((candidates :initform 'helm-imenu-candidates) + (candidate-transformer :initform 'helm-imenu-transformer) + (persistent-action :initform 'helm-imenu-persistent-action) + (persistent-help :initform "Show this entry") + (nomark :initform t) + (keymap :initform 'helm-imenu-map) + (help-message :initform 'helm-imenu-help-message) + (action :initform 'helm-imenu-action) + (find-file-target :initform #'helm-imenu-quit-and-find-file-fn) + (group :initform 'helm-imenu))) + +(defcustom helm-imenu-fuzzy-match nil + "Enable fuzzy matching in `helm-source-imenu'." + :group 'helm-imenu + :type 'boolean + :set (lambda (var val) + (set var val) + (setq helm-source-imenu + (helm-make-source "Imenu" 'helm-imenu-source + :fuzzy-match helm-imenu-fuzzy-match)))) + +(defun helm-imenu--maybe-switch-to-buffer (candidate) + (let ((cand (cdr candidate))) + (helm-aif (and (markerp cand) (marker-buffer cand)) + (helm-buffers-switch-to-buffer-or-tab it)))) + +(defun helm-imenu--execute-action-at-once-p () + (let ((cur (helm-get-selection)) + (mb (with-helm-current-buffer + (save-excursion + (goto-char (pos-bol)) + (point-marker))))) + ;; Happen when cursor is on the line where a definition is. This + ;; prevent jumping to the definition where we are already, instead + ;; display helm with all definitions and preselection to the place + ;; we already are. + (if (equal (cdr cur) mb) + (prog1 nil + (helm-set-pattern "") + (helm-force-update + (concat "\\_<" (regexp-quote (car cur)) "\\_>"))) + t))) + +(defun helm-imenu-quit-and-find-file-fn (source) + (let ((sel (helm-get-selection nil nil source))) + (when (and (consp sel) (markerp (cdr sel))) + (buffer-file-name (marker-buffer (cdr sel)))))) + +(defun helm-imenu-action (candidate) + "Default action for `helm-source-imenu'." + (helm-log-run-hook "helm-imenu-action" 'helm-goto-line-before-hook) + (helm-imenu--maybe-switch-to-buffer candidate) + (imenu candidate) + ;; If semantic is supported in this buffer + ;; imenu used `semantic-imenu-goto-function' + ;; and position have been highlighted, + ;; no need to highlight again. + (unless (eq imenu-default-goto-function + 'semantic-imenu-goto-function) + (helm-highlight-current-line))) + +(defun helm-imenu-persistent-action (candidate) + "Default persistent action for `helm-source-imenu'." + (helm-imenu--maybe-switch-to-buffer candidate) + (imenu candidate) + (helm-highlight-current-line)) + +(defun helm-imenu-candidates (&optional buffer) + (with-current-buffer (or buffer helm-current-buffer) + (let ((tick (buffer-modified-tick))) + (if (eq helm-cached-imenu-tick tick) + helm-cached-imenu-candidates + (setq imenu--index-alist nil) + (prog1 (setq helm-cached-imenu-candidates + (let ((index (imenu--make-index-alist t))) + (helm-imenu--candidates-1 + (delete (assoc "*Rescan*" index) index)))) + (setq helm-cached-imenu-tick tick)))))) + +(defun helm-imenu-candidates-in-all-buffers (&optional build-sources) + (let* ((lst (buffer-list)) + (progress-reporter (make-progress-reporter + "Imenu indexing buffers..." 1 (length lst)))) + (prog1 + (cl-loop with cur-buf = (if build-sources + (current-buffer) helm-current-buffer) + for b in lst + for count from 1 + when (with-current-buffer b + (and (or (member major-mode helm-imenu-extra-modes) + (derived-mode-p 'prog-mode)) + (helm-same-major-mode-p + cur-buf helm-imenu-all-buffer-assoc))) + if build-sources + collect (helm-make-source + (format "Imenu in %s" (buffer-name b)) + 'helm-imenu-source + :candidates (with-current-buffer b + (helm-imenu-candidates b)) + :fuzzy-match helm-imenu-fuzzy-match) + else + append (with-current-buffer b + (helm-imenu-candidates b)) + do (progress-reporter-update progress-reporter count)) + (progress-reporter-done progress-reporter)))) + +(defun helm-imenu--candidates-1 (alist) + (cl-loop for elm in alist + nconc (cond + ((imenu--subalist-p elm) + (helm-imenu--candidates-1 + (cl-loop for (e . v) in (cdr elm) collect + (cons (propertize + e 'helm-imenu-type (car elm)) + ;; If value is an integer, convert it + ;; to a marker, otherwise it is a cons cell + ;; and it will be converted on next recursions. + ;; (Bug#1060) [1]. + (if (integerp v) (copy-marker v) v))))) + ((listp (cdr elm)) + (and elm (list elm))) + (t + ;; bug in imenu, should not be needed. + (and (cdr elm) + ;; Semantic uses overlays whereas imenu uses + ;; markers (Bug#1706). + (setcdr elm (helm-acase (cdr elm) ; Same as [1]. + ((guard* (overlayp it)) + (copy-overlay it)) + ((guard* (or (markerp it) (integerp it))) + (copy-marker it)))) + (list elm)))))) + +(defun helm-imenu--get-prop (item) + ;; property value of ITEM can have itself + ;; a property value which have itself a property value + ;; ...and so on; Return a list of all these + ;; properties values starting at ITEM. + (let* ((prop (get-text-property 0 'helm-imenu-type item)) + (lst (list prop item))) + (when prop + (while prop + (setq prop (get-text-property 0 'helm-imenu-type prop)) + (and prop (push prop lst))) + lst))) + +(defun helm-imenu-icon-for-type (type) + "Return an icon for type TYPE. +The icon is found in `helm-imenu-icon-type-alist', if not +`helm-imenu-default-type-sexp' is evaled to provide a default icon." + (let ((all-the-icons-scale-factor 1.0) + (all-the-icons-default-adjust 0.0) + (nerd-icons-scale-factor 1.0) + (nerd-icons-default-adjust 0.0)) + (or (helm-aand (assoc-default type helm-imenu-icon-type-alist) + (apply (car it) (cdr it))) + (apply (car helm-imenu-default-type-sexp) + (cdr helm-imenu-default-type-sexp))))) + +(defun helm-imenu-transformer (candidates) + (cl-loop for (k . v) in candidates + ;; (k . v) == (symbol-name . marker) + for bufname = (buffer-name + (helm-acase v + ((guard* (overlayp it)) (overlay-buffer it)) + ((guard* (markerp it)) (marker-buffer it)))) + for types = (or (helm-imenu--get-prop k) + (list (if (with-current-buffer bufname + (derived-mode-p 'prog-mode)) + "Function" + "Top level") + k)) + for type-icon = (and helm-imenu-use-icon + (helm-imenu-icon-for-type (car types))) + for type-name = (propertize + (car types) 'face + (cl-loop for (p . f) in helm-imenu-type-faces + when (string-match p (car types)) + return f + finally return 'default)) + for disp1 = (mapconcat 'identity + (cdr types) + (propertize helm-imenu-delimiter + 'face 'shadow)) + for disp = (concat (if helm-imenu-use-icon + (concat (propertize " " 'display type-icon) " ") + "") + (if helm-imenu-hide-item-type-name + "" + (concat type-name + (propertize helm-imenu-delimiter + 'face 'shadow))) + (propertize disp1 'help-echo bufname 'types types)) + collect + (cons (propertize disp 'type-name type-name) (cons k v)))) + + +;;;###autoload +(defun helm-imenu () + "Preconfigured `helm' for `imenu'." + (interactive) + (require 'which-func) + (unless helm-source-imenu + (setq helm-source-imenu + (helm-make-source "Imenu" 'helm-imenu-source + :fuzzy-match helm-imenu-fuzzy-match))) + (let* ((imenu-auto-rescan t) + (helm-highlight-matches-around-point-max-lines 'never) + (str (thing-at-point 'symbol)) + (init-reg (and str (concat "\\_<" (regexp-quote str) "\\_>"))) + (helm-execute-action-at-once-if-one + helm-imenu-execute-action-at-once-if-one)) + (helm :sources 'helm-source-imenu + :default (and str (list init-reg str)) + :preselect (helm-aif (which-function) + (concat "\\_<" (regexp-quote it) "\\_>") + init-reg) + :buffer "*helm imenu*"))) + +;;;###autoload +(defun helm-imenu-in-all-buffers () + "Fetch Imenu entries in all buffers with similar mode as current. +A mode is similar as current if it is the same, it is derived +i.e. `derived-mode-p' or it have an association in +`helm-imenu-all-buffer-assoc'." + (interactive) + (require 'which-func) + (unless helm-imenu-in-all-buffers-separate-sources + (unless helm-source-imenu-all + (setq helm-source-imenu-all + (helm-make-source "Imenu in all buffers" 'helm-imenu-source + :init (lambda () + ;; Use a cache to avoid repeatedly sending + ;; progress-reporter message when updating + ;; (Bug#1704). + (setq helm-imenu--in-all-buffers-cache + (helm-imenu-candidates-in-all-buffers))) + :candidates 'helm-imenu--in-all-buffers-cache + :fuzzy-match helm-imenu-fuzzy-match)))) + (let* ((imenu-auto-rescan t) + (helm-highlight-matches-around-point-max-lines 'never) + (str (thing-at-point 'symbol)) + (init-reg (and str (concat "\\_<" (regexp-quote str) "\\_>"))) + (helm-execute-action-at-once-if-one + helm-imenu-execute-action-at-once-if-one) + (helm-maybe-use-default-as-input + (not (null (memq 'helm-source-imenu-all + helm-sources-using-default-as-input)))) + (sources (if helm-imenu-in-all-buffers-separate-sources + (helm-imenu-candidates-in-all-buffers 'build-sources) + '(helm-source-imenu-all)))) + (helm :sources sources + :default (and str (list init-reg str)) + :preselect (helm-aif (which-function) + (concat "\\_<" (regexp-quote it) "\\_>") + init-reg) + :buffer "*helm imenu all*"))) + +(provide 'helm-imenu) + +;;; helm-imenu.el ends here diff --git a/elpa/helm-20260424.1357/helm-info.el b/elpa/helm-20260424.1357/helm-info.el new file mode 100644 index 00000000..8271a935 --- /dev/null +++ b/elpa/helm-20260424.1357/helm-info.el @@ -0,0 +1,410 @@ +;;; helm-info.el --- Browse info index with helm -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2026 Thierry Volpiatto + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Code: + +(require 'cl-lib) +(require 'info) +;; helm-utils is requiring helm which is requiring helm-lib, but let's require +;; them explicitely anyway to make it clear what we need. helm-core is needed to +;; build all the helm-info-* commands and sources. +(require 'helm) +(require 'helm-lib) +(require 'helm-utils) ; for `helm-goto-line'. + +(declare-function Info-index-nodes "info" (&optional file)) +(declare-function Info-goto-node "info" (&optional fork)) +(declare-function Info-find-node "info" (filename nodename &optional no-going-back)) +(declare-function ring-insert "ring") +(declare-function ring-empty-p "ring") +(declare-function ring-ref "ring") +(defvar Info-history) +(defvar Info-directory-list) +(defvar helm-completions-detailed) +;; `Info-minibuf-history' is not declared in Emacs, see emacs bug/58786. +(when (and (> emacs-major-version 28) + (not (boundp 'Info-minibuf-history))) + (defvar Info-minibuf-history nil)) + + +;;; Customize + +(defgroup helm-info nil + "Info-related applications and libraries for Helm." + :group 'helm) + +(defcustom helm-info-default-sources + '(helm-source-info-elisp + helm-source-info-cl + helm-source-info-eieio + helm-source-info-pages) + "Default sources to use for looking up symbols at point in Info +files with `helm-info-at-point'." + :group 'helm-info + :type '(repeat (choice symbol))) + +;;; Build info-index sources with `helm-info-source' class. + +(defun helm-info-init (&optional file) + "Initialize candidates for info FILE. +If FILE have nodes, loop through all nodes and accumulate candidates +found in each node, otherwise scan only the current info buffer." + (unless file (setq file (helm-get-attr 'info-file))) + ;; Allow reinit candidate buffer when using edebug. + (helm-aif (and debug-on-error + (helm-candidate-buffer)) + (kill-buffer it)) + (unless (helm-candidate-buffer) + (save-window-excursion + (info file " *helm info temp buffer*") + (let ((tobuf (helm-candidate-buffer 'global)) + Info-history) + (helm-aif (Info-index-nodes) + (dolist (node it) + (Info-goto-node node) + (helm-info-scan-current-buffer tobuf)) + (helm-info-scan-current-buffer tobuf)) + (bury-buffer))))) + +(defun helm-info-scan-current-buffer (tobuf) + "Scan current info buffer and print lines to TOBUF. +Argument TOBUF is the `helm-candidate-buffer'." + (let (start end line) + (goto-char (point-min)) + (while (search-forward "\n* " nil t) + (unless (search-forward "Menu:\n" (1+ (pos-eol)) t) + (setq start (pos-bol) + ;; Fix Bug#1503 by getting the invisible + ;; info displayed on next line in long strings. + ;; e.g "* Foo.\n (line 12)" instead of + ;; "* Foo.(line 12)" + end (or (save-excursion + (goto-char (pos-bol)) + (re-search-forward "(line +[0-9]+)" nil t)) + (pos-eol)) + ;; Long string have a new line inserted before the + ;; invisible spec, remove it. + line (replace-regexp-in-string + "\n" "" (buffer-substring start end))) + (with-current-buffer tobuf + (insert line) + (insert "\n")))))) + +(defun helm-info-goto (node-line) + "The helm-info action to jump to NODE-LINE." + (require 'helm-utils) + (let ((alive (buffer-live-p (get-buffer "*info*")))) + (Info-goto-node (car node-line)) + (when alive (revert-buffer nil t)) + (helm-goto-line (cdr node-line)))) + +(defvar helm-info--node-regexp + "^\\* +\\(.+\\):[[:space:]]+\\(.*\\)\\(?:[[:space:]]*\\)(line +\\([0-9]+\\))" + "A regexp that should match file name, node name and line number in +a line like this: + +\* bind: Bash Builtins. (line 21).") + +(defun helm-info-display-to-real (line) + "Transform LINE to an acceptable argument for `info'. +If line have a node use the node, otherwise use directly first name found." + (let ((info-file (helm-get-attr 'info-file)) + nodename linum) + (when (string-match helm-info--node-regexp line) + (setq nodename (match-string 2 line) + linum (match-string 3 line))) + (if nodename + (cons (format "(%s)%s" + info-file + (replace-regexp-in-string ":\\'" "" nodename)) + (string-to-number (or linum "1"))) + (cons (format "(%s)%s" + info-file + (helm-aand (replace-regexp-in-string "^* " "" line) + (replace-regexp-in-string "::?.*\\'" "" it))) + 1)))) + +(defclass helm-info-source (helm-source-in-buffer) + ((info-file :initarg :info-file + :initform nil + :custom 'string) + (init :initform #'helm-info-init) + (filtered-candidate-transformer + :initform + (lambda (candidates _source) + (require 'helm-mode) + (cl-loop for line in candidates + when (string-match helm-info--node-regexp line) + do (progn + (helm-add-face-text-properties + (match-beginning 1) (match-end 1) + 'font-lock-keyword-face + nil line) + (helm-add-face-text-properties + (match-beginning 2) (match-end 2) + 'helm-completions-detailed + nil line)) + collect line))) + (display-to-real :initform #'helm-info-display-to-real) + (get-line :initform #'buffer-substring) + (action :initform '(("Goto node" . helm-info-goto))))) + +(defmacro helm-build-info-source (fname &rest args) + `(helm-make-source (concat "Info Index: " ,fname) 'helm-info-source + :info-file ,fname ,@args)) + +(defun helm-build-info-index-command (name doc source buffer) + "Define a Helm command NAME with documentation DOC. +Arg SOURCE will be an existing helm source named +`helm-source-info-' and BUFFER a string buffer name." + (defalias (intern (concat "helm-info-" name)) + (lambda () + (interactive) + (helm :sources source + :buffer buffer + :candidate-number-limit 1000)) + doc)) + +(defun helm-define-info-index-sources (info-list &optional commands) + "Define Helm info sources for all entries in INFO-LIST. + +Sources will be named named helm-source-info- where NAME is an element of +INFO-LIST. + +Sources are generated for all entries of `helm-default-info-index-list' which is +generated by `helm-get-info-files'. + +If COMMANDS arg is non-nil, also build commands named `helm-info-'." + (cl-loop for str in info-list + for sym = (intern (concat "helm-source-info-" str)) + do (set sym (helm-build-info-source str)) + when commands + do (helm-build-info-index-command + str (format "Predefined helm for %s info." str) + sym (format "*helm info %s*" str)))) + +(defun helm-info-index-set (var value) + (set var value) + (helm-define-info-index-sources value t)) + +;;; Search Info files + +;; `helm-info' is the main entry point here. It prompts the user for an Info +;; file, then a term in the file's index to jump to. + +(defvar helm-info-searched (make-ring 32) + "Ring of previously searched Info files.") + +(defun helm-get-info-files () + "Return list of Info files to use for `helm-info'. + +Elements of the list are strings of Info file names without +extensions (e.g., \"emacs\" for file \"emacs.info.gz\"). Info +files are found by searching directories in +`Info-directory-list'." + (info-initialize) ; Build Info-directory-list from INFOPATH (Bug#2118) + (let ((files (cl-loop for d in (or Info-directory-list + Info-default-directory-list) + when (file-directory-p d) + append (directory-files d nil "\\.info")))) + (helm-fast-remove-dups + (cl-loop for f in files collect + (helm-file-name-sans-extension f)) + :test 'equal))) + +(defcustom helm-default-info-index-list + (helm-get-info-files) + "Info files to search in with `helm-info'." + :group 'helm-info + :type '(repeat (choice string)) + :set 'helm-info-index-set) + +(defun helm-info-search-index (candidate) + "Search the index of CANDIDATE's Info file using the function +helm-info-." + (let ((helm-info-function + (intern-soft (concat "helm-info-" candidate)))) + (when (fboundp helm-info-function) + (funcall helm-info-function) + (ring-insert helm-info-searched candidate)))) + +(defvar helm-info--files-cache nil) +(defvar helm-info--files-doc-cache (make-hash-table :test 'equal)) + +(defun helm-info-file-doc (file) + "Return dir entry from the Info FILE." + (or + (with-temp-buffer + (ignore-errors (info-insert-file-contents file)) + (goto-char (point-min)) + (when (re-search-forward "^START-INFO-DIR-ENTRY$" nil t) + (forward-line 1) + (when (re-search-forward + "^\\*[[:space:]]+\\([^:]+\\):[[:space:]]+([^)]+)\\.[[:space:]]+\\(.+\\)" + (pos-eol) t) + (format-message "%s: %s" (match-string 1) (match-string 2))))) + "No summary")) + +(defun helm-def-source--info-files () + "Return a Helm source for Info files." + (require 'helm-mode) + (helm-build-sync-source "Helm Info" + :candidates + (lambda () (copy-sequence helm-default-info-index-list)) + :candidate-number-limit 999 + :candidate-transformer + (lambda (candidates) + (let ((candidates (sort candidates #'string-lessp)) + (longest (apply #'max (mapcar #'length candidates))) + done) + (cl-loop with reporter = (unless done + (make-progress-reporter + "Scanning libraries..." + 0 (length candidates))) + for c in candidates + for count from 0 + for sep = (helm-make-separator c longest) + for file = (or + (assoc-default c helm-info--files-cache) + (helm-aif (Info-find-file c t) + (prog1 it + (push (cons c it) helm-info--files-cache)))) + for doc = (and file + (or completions-detailed + helm-completions-detailed) + (or (gethash file helm-info--files-doc-cache) + (puthash file (helm-info-file-doc file) + helm-info--files-doc-cache))) + for disp = (and file + (if (and doc + (or completions-detailed + helm-completions-detailed)) + (helm-aand (propertize + doc 'face + 'helm-completions-detailed) + (propertize + " " 'display (concat sep it)) + (concat c it)) + c)) + when disp + collect (cons disp c) + when reporter do (progress-reporter-update reporter count) + finally do (setq done t)))) + :nomark t + :action '(("Search index" . helm-info-search-index)))) + +;;;###autoload +(defun helm-info (&optional refresh) + "Preconfigured `helm' for searching Info files' indices. + +With a prefix argument \\[universal-argument], set REFRESH to +non-nil. + +Optional parameter REFRESH, when non-nil, re-evaluates +`helm-default-info-index-list' and clears caches (see below). +If the variable has been customized, set it to its saved value. +If not, set it to its standard value. See +`custom-reevaluate-setting' for more. + +REFRESH is useful when new Info files are installed. If +`helm-default-info-index-list' has not been customized, the new +Info files are made available. + +When `completions-detailed' or `helm-completions-detailed' is non +nil, a description of Info files is provided. The Info files are +partially cached in the variables `helm-info--files-cache' and +`helm-info--files-docs-cache'. TIP: You can make these vars +persistent for faster start with the psession package, using +\\[psession-make-persistent-variable]. + +NOTE: The caches affect as well `info-dislpay-manual' when +`helm-mode' is enabled and `completions-detailed' is non nil. +When new Info files are installed, for example a library update +changed Info dir node entry, you can reset the caches with +a prefix arg." + (interactive "P") + (let ((default (unless (ring-empty-p helm-info-searched) + (ring-ref helm-info-searched 0)))) + (when refresh + (custom-reevaluate-setting 'helm-default-info-index-list) + (setq helm-info--files-cache nil) + (clrhash helm-info--files-doc-cache)) + (helm :sources (helm-def-source--info-files) + :buffer "*helm Info*" + :preselect (and default + (concat "\\_<" (regexp-quote default) "\\_>"))))) + +;;;; Info at point + +;; `helm-info-at-point' is the main entry point here. It searches for the +;; symbol at point through the Info sources defined in +;; `helm-info-default-sources' and jumps to it. + +(defvar helm-info--pages-cache nil + "Cache for all Info pages on the system.") + +(defvar helm-source-info-pages + (helm-build-sync-source "Info Pages" + :init #'helm-info-pages-init + :candidates (lambda () helm-info--pages-cache) + :action `(("Show with Info" + . ,(lambda (node-str) + (info (replace-regexp-in-string + "^[^:]+: " "" node-str))))) + :requires-pattern 2) + "Helm source for Info pages.") + +(defun helm-info-pages-init () + "Collect candidates for initial Info node Top." + (or helm-info--pages-cache + (let ((info-topic-regexp "\\* +\\([^:]+: ([^)]+)[^.]*\\)\\.")) + (save-selected-window + (info "dir" " *helm info temp buffer*") + (Info-find-node "dir" "top") + (goto-char (point-min)) + (while (re-search-forward info-topic-regexp nil t) + (push (match-string-no-properties 1) + helm-info--pages-cache)) + (kill-buffer))))) + +;;;###autoload +(defun helm-info-at-point () + "Preconfigured `helm' for searching info at point." + (interactive) + ;; Symbol at point is used as default as long as one of the sources + ;; in `helm-info-default-sources' is member of + ;; `helm-sources-using-default-as-input'. + (let* ((current (and Info-current-file + (intern-soft + (concat "helm-source-info-" + (helm-basename Info-current-file))))) + (helm-info-default-sources + (if (and current (not (memq current helm-info-default-sources))) + (cons current helm-info-default-sources) + helm-info-default-sources))) + (cl-loop for src in helm-info-default-sources + for name = (if (symbolp src) + (assoc 'name (symbol-value src)) + (assoc 'name src)) + unless name + do (warn "Couldn't build source `%S' without its info file" src)) + (helm :sources helm-info-default-sources + :buffer "*helm info*"))) + +(provide 'helm-info) + +;;; helm-info.el ends here diff --git a/elpa/helm-20260424.1357/helm-locate.el b/elpa/helm-20260424.1357/helm-locate.el new file mode 100644 index 00000000..a5f21017 --- /dev/null +++ b/elpa/helm-20260424.1357/helm-locate.el @@ -0,0 +1,531 @@ +;;; helm-locate.el --- helm interface for locate. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2026 Thierry Volpiatto + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; NOTE for WINDOZE users: +;; You have to install Everything with his command line interface here: +;; http://www.voidtools.com/download.php + +;;; Code: + +(require 'cl-lib) +(require 'helm) +(require 'helm-types) +(require 'helm-help) + +(defvar helm-ff-default-directory) +(declare-function helm-read-file-name "helm-mode") + + +(defgroup helm-locate nil + "Locate related Applications and libraries for Helm." + :group 'helm) + +(defcustom helm-locate-db-file-regexp "m?locate\\.db$" + "Default regexp to match locate database. +If nil Search in all files." + :type 'string) + +(defcustom helm-ff-locate-db-filename "locate.db" + "The basename of the locatedb file you use locally in your directories. +When this is set and Helm finds such a file in the directory from +where you launch locate, it will use this file and will not +prompt you for a db file. +Note that this happen only when locate is launched with a prefix +arg." + :type 'string) + +(defcustom helm-locate-command nil + "A list of arguments for locate program. + +Helm will calculate a default value for your system on startup +unless `helm-locate-command' is non-nil. + +Here are the default values it will use according to your system: + +Gnu/linux: \"locate %s -e -A -N --regex %s\" +berkeley-unix: \"locate %s %s\" +windows-nt: \"es %s %s\" +Others: \"locate %s %s\" + +This string will be passed to format so it should end with `%s'. +The first format spec is used for the \"-i\" value of locate/es, +so don't set it directly but use `helm-locate-case-fold-search' +for this. + +The last option must be the one preceding pattern i.e \"-r\" or +\"--regex\". + +The option \"-N\" may not be available on old locate versions, it is needed on +latest systems as locate send quoted filenames, it is BTW enabled by default, if +this option is not recognized on your system, remove it. + +You will be able to pass other options such as \"-b\" or \"l\" +during Helm invocation after entering pattern only when multi +matching, not when fuzzy matching. + +Note that the \"-b\" option is added automatically by Helm when +var `helm-locate-fuzzy-match' is non-nil and switching back from +multimatch to fuzzy matching (this is done automatically when a +space is detected in pattern)." + :type 'string) + +(defcustom helm-locate-create-db-command + "updatedb -l 0 -o '%s' -U '%s'" + "Command used to create a locale locate db file." + :type 'string) + +(defcustom helm-locate-case-fold-search helm-case-fold-search + "It have the same meaning as `helm-case-fold-search'. +The -i option of locate will be used depending of value of +`helm-pattern' when this is set to \\='smart. +When nil \"-i\" will not be used at all and when non-nil it will +always be used. +NOTE: the -i option of the \"es\" command used on windows does +the opposite of \"locate\" command." + :type 'symbol) + +(defcustom helm-locate-fuzzy-match nil + "Enable fuzzy matching in `helm-locate'. +Note that when this is enabled searching is done on basename." + :type 'boolean) + +(defcustom helm-locate-fuzzy-sort-fn + #'helm-locate-default-fuzzy-sort-fn + "Default fuzzy matching sort function for locate." + :type 'boolean) + +(defcustom helm-locate-project-list nil + "A list of directories, your projects. +When set, allow browsing recursively files in all directories of +this list with `helm-projects-find-files'." + :type '(repeat string)) + +(defcustom helm-locate-recursive-dirs-command "find %s -type d -regex .*%s.*$" + "Command used for recursive directories completion in `helm-find-files'. + +For Windows and `es' use something like \"es -r ^%s.*%s.*$\" + +The two format specs are mandatory. + +We were using locate command as default in the past like this: + + \"locate -i -e -A --regex '^%s' '%s.*$'\" + +But in most distributions updatedb is not indexing user dirs +among others (see PRUNE_BIND_MOUNTS in updatedb.conf man page). +However if you use a local db file, it will be used instead of +the global updatedb cache and will be very fast. + +So we use now the find shell command by default which is available on most +distributions and doesn't suffer of these indexing problems. It +is however slower than locate. Here the possible values you can +use: + + \"find %s -type d -regex .*%s.*$\" + \"find %s -type d -name '*%s*'\" + +You can use also the \"fdfind\" command which may be slow at first call because +it creates an index, but is then very fast on subsequent calls, here is the +command you can use: + + \"fdfind --hidden --type d --glob '*%s*' %s\" + +NOTE: The \"fdfind\" executable name may change on some systems, +it can be \"fd\" or whatever. + +See `helm-find-files' embedded help for more infos." + :type 'string + :group 'helm-files) + + +(defvar helm-locate-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-generic-files-map) + (define-key map (kbd "DEL") 'helm-delete-backward-no-update) + map)) + +(defface helm-locate-finish + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :foreground "Green")) + "Face used in mode line when locate process is finish." + :group 'helm-locate) + + +(defun helm-ff-find-locatedb (&optional from-ff) + "Try to find if a local locatedb file is available. +The search is done in `helm-ff-default-directory' or falls back to +`default-directory' if FROM-FF is nil." + (helm-aif (and helm-ff-locate-db-filename + (locate-dominating-file + (or (and from-ff + helm-ff-default-directory) + default-directory) + helm-ff-locate-db-filename)) + (expand-file-name helm-ff-locate-db-filename it))) + +(defun helm-locate-create-db-default-function (db-name directory) + "Default function used to create a locale locate db file. +Argument DB-NAME name of the db file. +Argument DIRECTORY root of file system subtree to scan." + (format helm-locate-create-db-command + db-name (expand-file-name directory))) + +(defvar helm-locate-create-db-function + #'helm-locate-create-db-default-function + "Function used to create a locale locate db file. +It should receive the same arguments as +`helm-locate-create-db-default-function'.") + +(defun helm-locate-1 (&optional localdb init from-ff default) + "Generic function to run Locate. +Prefix arg LOCALDB when (4) search and use a local locate db file +when it exists or create it, when (16) force update of existing +db file even if exists. +It has no effect when locate command is \\='es'. INIT is a string +to use as initial input in prompt. +See `helm-locate-with-db' and `helm-locate'." + (require 'helm-mode) + (helm-locate-set-command) + (let ((pfn (lambda (candidate) + (if (file-directory-p candidate) + (message "Error: The locate Db should be a file") + (if (= (shell-command + (funcall helm-locate-create-db-function + candidate + helm-ff-default-directory)) + 0) + (message "New locatedb file `%s' created" candidate) + (error "Failed to create locatedb file `%s'" candidate))))) + (locdb (and localdb + (not (string-match "^es" helm-locate-command)) + (or (and (equal '(4) localdb) + (helm-ff-find-locatedb from-ff)) + (helm-read-file-name + "Create Locate Db file: " + :initial-input (expand-file-name "locate.db" + (or helm-ff-default-directory + default-directory)) + :preselect helm-locate-db-file-regexp + :test (lambda (x) + (if helm-locate-db-file-regexp + ;; Select only locate db files and directories + ;; to allow navigation. + (or (string-match + helm-locate-db-file-regexp x) + (file-directory-p x)) + x))))))) + (when (and locdb (or (equal localdb '(16)) + (not (file-exists-p locdb)))) + (funcall pfn locdb)) + (helm-locate-with-db (and localdb locdb) init default))) + +(defun helm-locate-set-command () + "Setup `helm-locate-command' if not already defined." + (unless helm-locate-command + (setq helm-locate-command + (cl-case system-type + ;; Use -N option by default (bug#2625) + (gnu/linux "locate %s -e -A -N --regex %s") + (berkeley-unix "locate %s %s") + (windows-nt "es %s %s") + (t "locate %s %s"))))) + +(defun helm-locate-initial-setup () + (require 'helm-for-files) + (helm-locate-set-command)) + +(defvar helm-file-name-history nil) +(defun helm-locate-with-db (&optional db initial-input default) + "Run locate -d DB. +If DB is not given or nil use locate without -d option. +Argument DB can be given as a string or list of db files. +Argument INITIAL-INPUT is a string to use as initial-input. +See also `helm-locate'." + (require 'helm-files) + (when (and db (stringp db)) (setq db (list db))) + (helm-locate-set-command) + (let ((helm-locate-command + (if db + (replace-regexp-in-string + "locate" + (format (if helm-locate-fuzzy-match + "locate -b -d '%s'" "locate -d '%s'") + (mapconcat 'identity + ;; Remove eventually + ;; marked directories by error. + (cl-loop for i in db + unless (file-directory-p i) + ;; expand-file-name to resolve + ;; abbreviated fnames not + ;; expanding inside single + ;; quotes i.e. '%s'. + collect (expand-file-name i)) + ":")) + helm-locate-command) + (if (and helm-locate-fuzzy-match + (not (string-match-p "\\`locate -b" helm-locate-command))) + (replace-regexp-in-string + "\\`locate" "locate -b" helm-locate-command) + helm-locate-command)))) + (setq helm-file-name-history (mapcar 'helm-basename file-name-history)) + (helm :sources 'helm-source-locate + :buffer "*helm locate*" + :ff-transformer-show-only-basename nil + :input initial-input + :default default + :history 'helm-file-name-history))) + +(defun helm-locate-update-mode-line (process-name) + "Update mode-line with PROCESS-NAME status information." + (with-helm-window + (setq mode-line-format + `(" " mode-line-buffer-identification " " + (:eval (format "L%s" (helm-candidate-number-at-point))) " " + (:eval (propertize + (format "[%s process finished - (%s results)]" + ,process-name + (max (1- (count-lines + (point-min) (point-max))) + 0)) + 'face 'helm-locate-finish)))) + (force-mode-line-update))) + +(defun helm-locate--default-process-coding-system () + "Fix `default-process-coding-system' in locate for Windows systems." + ;; This is an attempt to fix issue #1322. + (if (and (eq system-type 'windows-nt) + (boundp 'w32-ansi-code-page)) + (let ((code-page-eol + (intern (format "cp%s-%s" w32-ansi-code-page "dos")))) + (if (ignore-errors (check-coding-system code-page-eol)) + (cons code-page-eol code-page-eol) + default-process-coding-system)) + default-process-coding-system)) + +(defun helm-locate-init () + "Initialize async locate process for `helm-source-locate'." + (let* ((default-process-coding-system + (helm-locate--default-process-coding-system)) + (locate-is-es (string-match "\\`es" helm-locate-command)) + (real-locate (string-match "\\`locate" helm-locate-command)) + (case-sensitive-flag (if locate-is-es "-i" "")) + (ignore-case-flag (if (or locate-is-es + (not real-locate)) "" "-i")) + (args (helm-mm-split-pattern helm-pattern)) + (cmd (format helm-locate-command + (cl-case helm-locate-case-fold-search + (smart (let ((case-fold-search nil)) + (if (string-match "[[:upper:]]" helm-pattern) + case-sensitive-flag + ignore-case-flag))) + (t (if helm-locate-case-fold-search + ignore-case-flag + case-sensitive-flag))) + (helm-aif (cdr args) + (concat + ;; The pattern itself. + (shell-quote-argument (car args)) " " + ;; Possible locate args added + ;; after pattern, don't quote them. + (mapconcat 'identity it " ")) + (shell-quote-argument (car args))))) + (default-directory (if (file-directory-p default-directory) + default-directory "/")) + process-connection-type) + (helm-log "helm-locat-init" "Starting helm-locate process") + (helm-log "helm-locat-init" "Command line used was:\n\n%s" + (concat ">>> " (propertize cmd 'face 'font-lock-comment-face) "\n\n")) + (prog1 + (start-process-shell-command + "locate-process" helm-buffer + cmd) + (set-process-sentinel + (get-buffer-process helm-buffer) + (lambda (process event) + (let* ((err (process-exit-status process)) + (noresult (= err 1))) + (cond (noresult + (with-helm-buffer + (unless (cdr helm-sources) + (insert (concat "* Exit with code 1, no result found," + " command line was:\n\n " + cmd))))) + ((or (string= event "finished\n") + (process-get process 'reach-limit)) + (when (and helm-locate-fuzzy-match + (not (string-match-p "\\s-" helm-pattern))) + (helm-redisplay-buffer)) + (helm-locate-update-mode-line "Locate")) + (t + (helm-log "helm-locat-init" "Error: Locate %s" + (replace-regexp-in-string "\n" "" event)))))))))) + +(defun helm-locate-default-fuzzy-sort-fn (candidates) + "Default sort function for files in fuzzy matching. +Sort is done on basename of CANDIDATES." + (helm-fuzzy-matching-default-sort-fn-1 candidates nil t)) + +(defclass helm-locate-source (helm-source-async helm-type-file) + ((init :initform 'helm-locate-initial-setup) + (candidates-process :initform 'helm-locate-init) + (requires-pattern :initform 3) + (history :initform 'helm-file-name-history) + (persistent-action :initform 'helm-ff-kill-or-find-buffer-fname) + (candidate-number-limit :initform 9999) + (redisplay :initform (progn helm-locate-fuzzy-sort-fn)))) + +;; Override helm-type-file class keymap. +(cl-defmethod helm--setup-source :after ((source helm-locate-source)) + (setf (slot-value source 'keymap) helm-locate-map) + (setf (slot-value source 'group) 'helm-locate)) + +(defvar helm-source-locate + (helm-make-source "Locate" 'helm-locate-source + :pattern-transformer 'helm-locate-pattern-transformer + ;; :match-part is only used here to tell helm which part + ;; of candidate to highlight. + :match-part (lambda (candidate) + (if (or (string-match-p " -b\\'" helm-pattern) + (and helm-locate-fuzzy-match + (not (string-match "\\s-" helm-pattern)))) + (helm-basename candidate) + candidate)))) + +(defun helm-locate-pattern-transformer (pattern) + (if helm-locate-fuzzy-match + ;; When fuzzy is enabled helm add "-b" option on startup. + (cond ((string-match-p " " pattern) + (when (string-match "\\`locate -b" helm-locate-command) + (setq helm-locate-command + (replace-match "locate" t t helm-locate-command))) + pattern) + (t + (unless (string-match-p "\\`locate -b" helm-locate-command) + (setq helm-locate-command + (replace-regexp-in-string + "\\`locate" "locate -b" helm-locate-command))) + (helm--mapconcat-pattern pattern))) + pattern)) + +(defun helm-locate-find-dbs-in-projects (&optional update) + (let* ((pfn (lambda (candidate directory) + (unless (= (shell-command + (funcall helm-locate-create-db-function + candidate + directory)) + 0) + (error "Failed to create locatedb file `%s'" candidate)))) + (projects (cl-loop for p in helm-locate-project-list + when (file-directory-p p) + collect p))) + (cl-loop for p in projects + for db = (expand-file-name + helm-ff-locate-db-filename + (file-name-as-directory p)) + if (and (null update) (file-exists-p db)) + collect db + else do (funcall pfn db p) + and collect db))) + +;;; Directory completion for hff. +;; +(defclass helm-locate-subdirs-source (helm-source-in-buffer) + ((basedir :initarg :basedir + :initform nil + :custom string) + (subdir :initarg :subdir + :initform nil + :custom 'string) + (data :initform #'helm-locate-init-subdirs) + (group :initform 'helm-locate))) + +(defun helm-locate-init-subdirs () + (let ((cmd (helm-acase helm-locate-recursive-dirs-command + (;; Fd + (guard* (string-match-p "\\`fd" it)) + ;; fd pass path at end. + (format it (helm-get-attr 'subdir) (helm-get-attr 'basedir))) + (;; Es + (guard* (string-match-p "\\`es" it)) + (format it (replace-regexp-in-string + "/" "\\\\\\\\" (helm-get-attr 'basedir)) + (helm-get-attr 'subdir))) + (;; Locate + (guard* (string-match-p "\\`locate" it)) + ;; Try to use a locale DB if some. + (let* ((db (locate-dominating-file + (helm-get-attr 'basedir) + helm-ff-locate-db-filename)) + (lcmd (if (and db (not (string-match-p "-d" it))) + (mapconcat + #'identity + (helm-append-at-nth + (split-string it) + (format "-d %s" + (expand-file-name + helm-ff-locate-db-filename db)) + 1) + " ") + it))) + (format lcmd (helm-get-attr 'basedir) (helm-get-attr 'subdir)))) + ;; Find + (t (format it (helm-get-attr 'basedir) (helm-get-attr 'subdir)))))) + (with-temp-buffer + (call-process-shell-command cmd nil t nil) + (buffer-string)))) + +;;;###autoload +(defun helm-projects-find-files (update) + "Find files with locate in `helm-locate-project-list'. +With a prefix arg refresh the database in each project." + (interactive "P") + (helm-locate-set-command) + (cl-assert (and (string-match-p "\\`locate" helm-locate-command) + (executable-find "updatedb")) + nil "Unsupported locate program") + (let ((dbs (helm-locate-find-dbs-in-projects update))) + (if dbs + (helm-locate-with-db dbs) + (user-error "No projects found, please setup `helm-locate-project-list'")))) + +;;;###autoload +(defun helm-locate (arg) + "Preconfigured `helm' for Locate. +Note: you can add locate options after entering pattern. +See \\='man locate' for valid options and also `helm-locate-command'. + +You can specify a local database with prefix argument ARG. +With two prefix arg, refresh the current local db or create it if +it doesn't exists. + +To create a user specific db, use +\"updatedb -l 0 -o db_path -U directory\". +Where db_path is a filename matched by +`helm-locate-db-file-regexp'." + (interactive "P") + (helm-set-local-variable 'helm-async-outer-limit-hook + (list (lambda () + (when (and helm-locate-fuzzy-match + (not (string-match-p + "\\s-" helm-pattern))) + (helm-redisplay-buffer))))) + (setq helm-ff-default-directory default-directory) + (helm-locate-1 arg nil nil (thing-at-point 'filename))) + +(provide 'helm-locate) + +;;; helm-locate.el ends here diff --git a/elpa/helm-20260424.1357/helm-man.el b/elpa/helm-20260424.1357/helm-man.el new file mode 100644 index 00000000..983a5ba3 --- /dev/null +++ b/elpa/helm-20260424.1357/helm-man.el @@ -0,0 +1,176 @@ +;;; helm-man.el --- Man and woman UI -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2026 Thierry Volpiatto + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Code: + +(require 'cl-lib) +(require 'helm) +(require 'helm-help) + +(defvar woman-topic-all-completions) +(defvar woman-manpath) +(defvar woman-path) +(defvar woman-expanded-directory-path) +(defvar warning-suppress-log-types) +(declare-function woman-file-name "woman.el" (topic &optional re-cache)) +(declare-function woman-file-name-all-completions "woman.el" (topic)) +(declare-function Man-getpage-in-background "man.el" (topic)) +(declare-function woman-expand-directory-path "woman.el" (path-dirs path-regexps)) +(declare-function woman-topic-all-completions "woman.el" (path)) +(declare-function helm-generic-sort-fn "helm-utils.el" (S1 S2)) +(declare-function helm-comp-read "helm-mode") + +(defgroup helm-man nil + "Man and Woman applications for Helm." + :group 'helm) + +(defcustom helm-man-or-woman-function 'Man-getpage-in-background + "Default command to display a man page." + :group 'helm-man + :type '(radio :tag "Preferred command to display a man page" + (const :tag "Man" Man-getpage-in-background) + (const :tag "Woman" woman))) + +(defcustom helm-man-format-switches (cl-case system-type + ((darwin macos) "%s") + (t "-l %s")) + "Arguments to pass to the `manual-entry' function. +Arguments are passed to `manual-entry' with `format.'" + :group 'helm-man + :type 'string) + +;; Internal +(defvar helm-man--pages nil + "All man pages on system. +Will be calculated the first time you invoke Helm with this +source.") + +(defvar helm-source-man-pages nil) + +(defvar helm-man--tldr-cache nil) + +(defun helm-man-default-action (candidate) + "Default action for jumping to a woman or man page from Helm." + (let ((wfiles (mapcar #'car (woman-file-name-all-completions candidate)))) + (condition-case nil + (let ((file (if (cdr wfiles) + (helm-comp-read "ManFile: " wfiles :must-match t) + (car wfiles)))) + (if (eq helm-man-or-woman-function 'Man-getpage-in-background) + (manual-entry (format helm-man-format-switches file)) + (condition-case nil + (woman-find-file file) + ;; If woman is unable to format correctly + ;; try Man instead. + (error (kill-buffer) + (manual-entry (format helm-man-format-switches file)))))) + ;; If even Man failed with file as argument, try again with Man + ;; but using Topic candidate instead of the file calculated by + ;; woman. + (error (kill-buffer) + (Man-getpage-in-background candidate))))) + +(defun helm-man--init () + "Init caches for helm-man." + (require 'warnings) + (let ((warning-suppress-log-types '((defvaralias)))) + (require 'woman)) + (require 'helm-utils) + (unless helm-man--tldr-cache + (setq helm-man--tldr-cache (helm-man--tldr-cache))) + (unless helm-man--pages + (setq woman-expanded-directory-path + (woman-expand-directory-path woman-manpath woman-path)) + (setq woman-topic-all-completions + (woman-topic-all-completions woman-expanded-directory-path)) + (setq helm-man--pages (mapcar 'car woman-topic-all-completions))) + (helm-init-candidates-in-buffer 'global helm-man--pages)) + +(defun helm-man-popup-info (candidate) + "The popup-info function for `helm-man-pages-class'." + ;; On some systems mandb don't run automatically, in this case whatis or man + ;; -f may return nothing. + (let ((output (shell-command-to-string (format "man -f '%s'" candidate)))) + (when (string-match (format "\\(%s ?([^(]+)\\) *- ?\\(.*\\)\n" candidate) + output) + (match-string 2 output)))) + +(defun helm-man-tldr-render (command) + "Display the output of `tldr' command." + (with-current-buffer-window "*tldr*" '(display-buffer-full-frame) nil + (let ((status (call-process "tldr" nil t nil "--color" "always" command)) + map) + (when (zerop status) + (ansi-color-apply-on-region (point-min) (point-max)) + (goto-char (point-min)) + (setq map (let ((m (make-sparse-keymap))) + (define-key m (kbd "") #'browse-url-at-point) + (define-key m [mouse-1] #'browse-url-at-point) + m)) + (save-excursion + (while (re-search-forward "http[s]://" nil t) + (let* ((pos (bounds-of-thing-at-point 'url)) + (ov (make-overlay (car pos) (cdr pos)))) + (overlay-put ov 'face 'font-lock-keyword-face) + (overlay-put ov 'keymap map) + (overlay-put ov 'mouse-face 'highlight) + (overlay-put ov 'help-echo "mouse-1: Browse url")))) + (local-set-key "q" 'quit-window))))) + +(defun helm-man--tldr-cache () + "Return the output of tldr -l as a list." + (when (executable-find "tldr") + (with-temp-buffer + (call-process "tldr" nil t nil "-l") + (split-string (buffer-string) "\n")))) + +(defun helm-man-action-transformer (actions _candidate) + "The action transformer fn for `helm-man-woman'." + (let ((disp (helm-get-selection nil t))) + (if (member disp helm-man--tldr-cache) + (append actions '(("Tldr" . helm-man-tldr-render))) + actions))) + +(defclass helm-man-pages-class (helm-source-in-buffer) + ((popup-info :initform #'helm-man-popup-info))) + +;;;###autoload +(defun helm-man-woman (arg) + "Preconfigured `helm' for Man and Woman pages. +With a prefix ARG reinitialize the cache. To have a popup +showing a basic description of selected candidate, turn on +`helm-popup-tip-mode'." + (interactive "P") + (when arg (setq helm-man--pages nil + helm-man--tldr-cache nil)) + (unless helm-source-man-pages + (setq helm-source-man-pages + (helm-make-source "Manual Pages" 'helm-man-pages-class + :init #'helm-man--init + :persistent-action #'ignore + :filtered-candidate-transformer + (lambda (candidates _source) + (sort candidates #'helm-generic-sort-fn)) + :action-transformer 'helm-man-action-transformer + :action '(("Display Man page" . helm-man-default-action)) + :group 'helm-man))) + (helm :sources 'helm-source-man-pages + :buffer "*helm man woman*")) + +(provide 'helm-man) + +;;; helm-man.el ends here diff --git a/elpa/helm-20260424.1357/helm-misc.el b/elpa/helm-20260424.1357/helm-misc.el new file mode 100644 index 00000000..8064b4a5 --- /dev/null +++ b/elpa/helm-20260424.1357/helm-misc.el @@ -0,0 +1,410 @@ +;;; helm-misc.el --- Various functions for helm -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2026 Thierry Volpiatto + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Code: +(require 'cl-lib) +(require 'helm) +(require 'helm-help) +(require 'helm-types) + +(declare-function display-time-world-display "time.el") +(defvar display-time-world-list) +(declare-function LaTeX-math-mode "ext:latex.el") +(declare-function jabber-chat-with "ext:jabber.el") +(declare-function jabber-read-account "ext:jabber.el") +(declare-function helm-comp-read "helm-mode") +(declare-function outline-back-to-heading "outline.el") +(declare-function outline-end-of-heading "outline.el") +(declare-function helm-goto-char "helm-utils") +(declare-function helm-highlight-current-line "helm-utils") + + +(defgroup helm-misc nil + "Various Applications and libraries for Helm." + :group 'helm) + +(defcustom helm-time-zone-home-location "Paris" + "The time zone of your home." + :group 'helm-misc + :type 'string) + +(defcustom helm-timezone-actions + `(("Set timezone env (TZ)" . ,(lambda (candidate) + (setenv "TZ" candidate)))) + "Actions for helm-timezone." + :group 'helm-misc + :type '(alist :key-type string :value-type function)) + +(defface helm-time-zone-current + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :foreground "green")) + "Face used to colorize current time in `helm-world-time'." + :group 'helm-misc) + +(defface helm-time-zone-home + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :foreground "red")) + "Face used to colorize home time in `helm-world-time'." + :group 'helm-misc) + + + +;;; Latex completion +;; +;; Test +;; (setq LaTeX-math-menu '("Math" +;; ["foo" val0 t] +;; ("bar" +;; ["baz" val1 t]) +;; ("aze" +;; ["zer" val2 t]) +;; ("AMS" +;; ("rec" +;; ["fer" val3 t]) +;; ("rty" +;; ["der" val4 t])) +;; ("ABC" +;; ("xcv" +;; ["sdf" val5 t]) +;; ("dfg" +;; ["fgh" val6 t])))) +;; (helm-latex-math-candidates) +;; => +;; (("foo" . val0) +;; ("baz" . val1) +;; ("zer" . val2) +;; ("fer" . val3) +;; ("der" . val4) +;; ("sdf" . val5) +;; ("fgh" . val6)) + +(defvar LaTeX-math-menu) +(defun helm-latex-math-candidates () + (cl-labels ((helm-latex--math-collect (L) + (cond ((vectorp L) + (list (cons (aref L 0) (aref L 1)))) + ((listp L) + (cl-loop for a in L nconc + (helm-latex--math-collect a)))))) + (helm-latex--math-collect LaTeX-math-menu))) + +(defvar helm-source-latex-math + (helm-build-sync-source "Latex Math Menu" + :init (lambda () + (with-helm-current-buffer + (LaTeX-math-mode 1))) + :candidate-number-limit 9999 + :candidates 'helm-latex-math-candidates + :action (lambda (candidate) + (call-interactively candidate)))) + + +;;; Jabber Contacts (jabber.el) +(defun helm-jabber-online-contacts () + "List online Jabber contacts." + (with-no-warnings + (cl-loop for item in (jabber-concat-rosters) + when (get item 'connected) + collect + (if (get item 'name) + (cons (get item 'name) item) + (cons (symbol-name item) item))))) + +(defvar helm-source-jabber-contacts + (helm-build-sync-source "Jabber Contacts" + :init (lambda () (require 'jabber)) + :candidates (lambda () (mapcar 'car (helm-jabber-online-contacts))) + :action (lambda (x) + (jabber-chat-with + (jabber-read-account) + (symbol-name + (cdr (assoc x (helm-jabber-online-contacts)))))))) + +;;; World time +;; +(defvar zoneinfo-style-world-list) +(defvar legacy-style-world-list) + +(defun helm-time-zone-transformer (candidates _source) + (cl-loop for i in candidates + for (z . p) in display-time-world-list + collect + (cons + (cond ((string-match (format-time-string "%H:%M" (current-time)) i) + (propertize i 'face 'helm-time-zone-current)) + ((string-match helm-time-zone-home-location i) + (propertize i 'face 'helm-time-zone-home)) + (t i)) + z))) + +(defvar helm-source-time-world + (helm-build-in-buffer-source "Time World List" + :init (lambda () + (require 'time) + (unless (and display-time-world-list + (listp display-time-world-list)) + ;; adapted from `time--display-world-list' from + ;; emacs-27 for compatibility as + ;; `display-time-world-list' is set by default to t. + (setq display-time-world-list + ;; Determine if zoneinfo style timezones are + ;; supported by testing that America/New York and + ;; Europe/London return different timezones. + (let ((nyt (format-time-string "%z" nil "America/New_York")) + (gmt (format-time-string "%z" nil "Europe/London"))) + (if (string-equal nyt gmt) + legacy-style-world-list + zoneinfo-style-world-list))))) + :data (lambda () + (with-temp-buffer + (display-time-world-display display-time-world-list) + (buffer-string))) + :action 'helm-timezone-actions + :filtered-candidate-transformer 'helm-time-zone-transformer)) + +;;; Minibuffer History +;; +;; +(defvar helm-minibuffer-history-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (define-key map [remap helm-minibuffer-history] 'undefined) + map)) + +(defcustom helm-minibuffer-history-must-match t + "Allow inserting non matching elements when nil or \\='confirm." + :group 'helm-misc + :type '(choice + (const :tag "Must match" t) + (const :tag "Confirm" confirm) + (const :tag "Always allow" nil))) + +(defcustom helm-minibuffer-history-key "C-r" + "The key `helm-minibuffer-history' is bound to in minibuffer local maps." + :type '(choice (string :tag "Key") (const :tag "no binding")) + :group 'helm-mode) + +(defconst helm-minibuffer-history-old-key + (cl-loop for map in '(minibuffer-local-completion-map + minibuffer-local-filename-completion-map + minibuffer-local-filename-must-match-map ; Emacs 23.1.+ + minibuffer-local-isearch-map + minibuffer-local-map + minibuffer-local-must-match-filename-map ; Older Emacsen + minibuffer-local-must-match-map + minibuffer-local-ns-map) + when (and (boundp map) (symbol-value map)) + collect (cons map (lookup-key (symbol-value map) "\C-r")))) + +;;;###autoload +(define-minor-mode helm-minibuffer-history-mode + "Bind `helm-minibuffer-history-key' in al minibuffer maps. +This mode is enabled by `helm-mode', so there is no need to enable it directly." + :group 'helm-misc + :global t + (if helm-minibuffer-history-mode + (let ((key helm-minibuffer-history-key)) + (dolist (map '(minibuffer-local-completion-map + minibuffer-local-filename-completion-map + minibuffer-local-filename-must-match-map ; Emacs 23.1.+ + minibuffer-local-isearch-map + minibuffer-local-map + minibuffer-local-must-match-filename-map ; Older Emacsen + minibuffer-local-must-match-map + minibuffer-local-ns-map)) + (let ((vmap (and (boundp map) (symbol-value map)))) + (when (keymapp vmap) + (let ((val (and (boundp 'helm-minibuffer-history-key) + (symbol-value 'helm-minibuffer-history-key)))) + (when val + (define-key vmap + (if (stringp val) (read-kbd-macro val) val) + nil))) + (when key + (define-key (symbol-value map) + (if (stringp key) (read-kbd-macro key) key) + 'helm-minibuffer-history)))))) + (dolist (map '(minibuffer-local-completion-map + minibuffer-local-filename-completion-map + minibuffer-local-filename-must-match-map + minibuffer-local-isearch-map + minibuffer-local-map + minibuffer-local-must-match-filename-map + minibuffer-local-must-match-map + minibuffer-local-ns-map)) + (let ((vmap (and (boundp map) (symbol-value map)))) + (when (keymapp vmap) + (let ((val (and (boundp 'helm-minibuffer-history-key) + (symbol-value 'helm-minibuffer-history-key)))) + (when val + (define-key vmap + (if (stringp val) (read-kbd-macro val) val) + (assoc-default map helm-minibuffer-history-old-key))))))))) + + +;;; Helm ratpoison UI +;; +;; +(defvar helm-source-ratpoison-commands + (helm-build-in-buffer-source "Ratpoison Commands" + :init 'helm-ratpoison-commands-init + :action (helm-make-actions + "Execute the command" 'helm-ratpoison-commands-execute) + :display-to-real 'helm-ratpoison-commands-display-to-real + :candidate-number-limit 999999)) + +(defun helm-ratpoison-commands-init () + (unless (helm-candidate-buffer) + (with-current-buffer (helm-candidate-buffer 'global) + ;; with ratpoison prefix key + (save-excursion + (call-process "ratpoison" nil (current-buffer) nil "-c" "help")) + (while (re-search-forward "^\\([^ ]+\\) \\(.+\\)$" nil t) + (replace-match " \\1: \\2")) + (goto-char (point-max)) + ;; direct binding + (save-excursion + (call-process "ratpoison" nil (current-buffer) nil "-c" "help top")) + (while (re-search-forward "^\\([^ ]+\\) \\(.+\\)$" nil t) + (replace-match "\\1: \\2"))))) + +(defun helm-ratpoison-commands-display-to-real (display) + (and (string-match ": " display) + (substring display (match-end 0)))) + +(defun helm-ratpoison-commands-execute (candidate) + (call-process "ratpoison" nil nil nil "-ic" candidate)) + +;;; Helm stumpwm UI +;; +;; +(defvar helm-source-stumpwm-commands + (helm-build-in-buffer-source "Stumpwm Commands" + :init 'helm-stumpwm-commands-init + :action (helm-make-actions + "Execute the command" 'helm-stumpwm-commands-execute) + :candidate-number-limit 999999)) + +(defun helm-stumpwm-commands-init () + (with-current-buffer (helm-candidate-buffer 'global) + (save-excursion + (call-process "stumpish" nil (current-buffer) nil "commands")) + (while (re-search-forward "[ ]*\\([^ ]+\\)[ ]*\n?" nil t) + (replace-match "\n\\1\n")) + (delete-blank-lines) + (sort-lines nil (point-min) (point-max)) + (goto-char (point-max)))) + +(defun helm-stumpwm-commands-execute (candidate) + (call-process "stumpish" nil nil nil candidate)) + +;;;###autoload +(defun helm-world-time () + "Preconfigured `helm' to show world time. +Default action change TZ environment variable locally to emacs." + (interactive) + (helm :sources 'helm-source-time-world :buffer "*helm world time*")) + +;;;###autoload +(defun helm-insert-latex-math () + "Preconfigured helm for latex math symbols completion." + (interactive) + (helm :sources 'helm-source-latex-math :buffer "*helm latex*")) + +;;;###autoload +(defun helm-ratpoison-commands () + "Preconfigured `helm' to execute ratpoison commands." + (interactive) + (helm :sources 'helm-source-ratpoison-commands + :buffer "*helm ratpoison commands*")) + +;;;###autoload +(defun helm-stumpwm-commands() + "Preconfigured helm for stumpwm commands." + (interactive) + (helm :sources 'helm-source-stumpwm-commands + :buffer "*helm stumpwm commands*")) + +;;;###autoload +(defun helm-minibuffer-history () + "Preconfigured `helm' for `minibuffer-history'." + (interactive) + (cl-assert (minibuffer-window-active-p (selected-window)) nil + "Error: Attempt to use minibuffer history outside a minibuffer") + (let* ((enable-recursive-minibuffers t) + (query-replace-p (or (eq last-command 'query-replace) + (eq last-command 'query-replace-regexp))) + (elm (helm-comp-read "Next element matching (regexp): " + (cl-loop for i in + (symbol-value minibuffer-history-variable) + unless (equal "" i) collect i into history + finally return + (if (consp (car history)) + (mapcar 'prin1-to-string history) + history)) + :header-name + (lambda (name) + (format "%s (%s)" name minibuffer-history-variable)) + :buffer "*helm minibuffer-history*" + :must-match helm-minibuffer-history-must-match + :multiline t + :keymap helm-minibuffer-history-map + :allow-nest t))) + ;; Fix Bug#1667 with emacs-25+ `query-replace-from-to-separator'. + (when (and (boundp 'query-replace-from-to-separator) query-replace-p) + (let ((pos (string-match "\0" elm))) + (and pos + (add-text-properties + pos (1+ pos) + `(display ,query-replace-from-to-separator separator t) + elm)))) + (delete-minibuffer-contents) + (insert elm))) + +;;;###autoload +(defun helm-outline (&optional arg) + "Basic helm navigation tool for outline buffers." + (interactive "P") + (require 'outline) + (let ((outline-regexp (if arg (read-regexp "Outline regexp") outline-regexp))) + (helm :sources (helm-build-sync-source "helm outline" + :candidates + (lambda () + (with-helm-current-buffer + (save-excursion + (goto-char (point-min)) + (cl-loop while (re-search-forward outline-regexp nil t) + for beg = (match-beginning 0) + for end = (progn + (outline-end-of-heading) (point)) + collect + (cons (buffer-substring beg end) beg))))) + :action (lambda (pos) + (helm-goto-char pos) + (helm-highlight-current-line))) + :preselect (save-excursion + (when (condition-case _err + (outline-back-to-heading) + (error nil)) + (regexp-quote + (buffer-substring + (point) (progn (outline-end-of-heading) (point)))))) + :buffer "*helm outline*"))) + +(provide 'helm-misc) + +;;; helm-misc.el ends here diff --git a/elpa/helm-20260424.1357/helm-mode.el b/elpa/helm-20260424.1357/helm-mode.el new file mode 100644 index 00000000..d437fb26 --- /dev/null +++ b/elpa/helm-20260424.1357/helm-mode.el @@ -0,0 +1,3252 @@ +;;; helm-mode.el --- Enable helm completion everywhere. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2026 Thierry Volpiatto + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Code: + +(require 'cl-lib) +(require 'helm) +(require 'helm-lib) +(require 'helm-files) +(require 'helm-misc) + +(defvar crm-separator) +(defvar ido-everywhere) +(defvar completion-flex-nospace) +(defvar helm-completion--sorting-done) +(defvar helm-mode) +(defvar password-cache) +(defvar package--builtins) +(defvar helm--locate-library-doc-cache) +(defvar helm--locate-library-cache) +(defvar completion-lazy-hilit) ; Emacs-30 only. +(defvar eww-bookmarks) +(defvar helm-info--files-cache) +(defvar helm-info--files-doc-cache) +(defvar Info-current-file) +(defvar helm-M-x-prefix-argument) +(defvar helm-M-x--timer) + +;; No warnings in Emacs built --without-x +(declare-function x-file-dialog "xfns.c") + +(declare-function ido-mode "ido.el") +(declare-function helm-apropos-init "helm-elisp") +(declare-function helm-lisp-completion-persistent-action "helm-elisp") +(declare-function helm-lisp-completion-persistent-help "helm-elisp") +(declare-function help--symbol-class "help-fns.el") +(declare-function helm-get-first-line-documentation "helm-elisp") +(declare-function package-desc-summary "package") +(declare-function package-built-in-p "package") +(declare-function package-desc-status "package") +(declare-function package-get-descriptor "package") +(declare-function print-coding-system-briefly "mul-diag.el") +(declare-function color-rgb-to-hex "color.el") +(declare-function find-library-name "find-func.el") +(declare-function helm-info-file-doc "helm-info") +(declare-function Info-find-file "info") +(declare-function helm-M-x--notify-prefix-arg "helm-command") +(declare-function helm-M-x--unwind-forms "helm-command") +(declare-function helm-M-x--move-selection-after-hook "helm-command") +(declare-function helm-M-x--before-action-hook "helm-command") +(declare-function helm-M-x-persistent-action "helm-command") + +(defgroup helm-mode nil + "Enable helm completion." + :group 'helm) + +(defcustom helm-completing-read-handlers-alist + '((find-tag . helm-completing-read-default-find-tag) + (ggtags-find-tag-dwim . helm-completing-read-default-find-tag) + (tmm-menubar . nil) + (find-file . nil) + (execute-extended-command . nil) + (dired-do-rename . helm-read-file-name-handler-1) + (dired-do-copy . helm-read-file-name-handler-1) + (dired-do-symlink . helm-read-file-name-handler-1) + (dired-do-relsymlink . helm-read-file-name-handler-1) + (dired-do-hardlink . helm-read-file-name-handler-1) + ;; Next two are using completing-read where not needed. + (read-multiple-choice--long-answers . nil) + (dired-do-touch . nil) + (basic-save-buffer . helm-read-file-name-handler-1) + (write-file . (default helm-read-file-name-handler-1)) + (write-region . (default helm-read-file-name-handler-1)) + (all-the-icons-insert . helm-mode-all-the-icons-handler)) + "Completing read functions for specific Emacs commands. + +By default `helm-mode' use `helm-completing-read-default-handler' to +provide helm completion in each `completing-read' or `read-file-name' +found, but other functions can be specified here for specific +commands. This also allows disabling helm completion for some commands +when needed. + +Each entry is a cons cell like (EMACS_COMMAND . COMPLETING-READ_HANDLER) +where key and value are symbols. +However if a command is using in its definition both a `completing-read' AND +a `read-file-name' we may want to specify a handler for both of them, +this can be done by specifying value as a list of two symbols instead of +a single symbol where the 1st element of the list specify the handler for the +`completing-read' and the second the handler for the `read-file-name'. +Special symbol \\='default' means use the default helm handler for either +`completing-read' or `read-file-name'. +e.g. (write-region . (default helm-read-file-name-handler-1)) +means helm will use `helm-completing-read-default-handler' when +`write-region' calls `completing-read' and +`helm-read-file-name-handler-1' when it calls `read-file-name'. + +Each key is an Emacs command that use originaly `completing-read' +or/and `read-file-name'. + +Each value maybe a helm function that takes same arguments as +`completing-read' plus NAME and BUFFER, where NAME is the name of the new +helm source and BUFFER the name of the buffer we will use, but it can +be also a function not using helm, in this case the function should +take the same args as `completing-read' and not be prefixed by \"helm-\". + +`helm' will use the name of the command calling `completing-read' as +NAME and BUFFER will be computed as well with NAME but prefixed with +\"*helm-mode-\". + +This function prefix name must start by \"helm-\" when it uses helm, +otherwise `helm' assumes the function is not a helm function and +expects the same args as `completing-read', this allows you to define a +handler not using helm completion. + +Example: + + (defun foo/test () + (interactive) + (message \"%S\" (completing-read \"test: \" \\='(a b c d e)))) + + (defun helm-foo/test-completing-read-handler (prompt collection + predicate require-match + initial-input hist def + inherit-input-method + name buffer) + (helm-comp-read prompt collection :marked-candidates t + :name name + :buffer buffer)) + + (add-to-list \\='helm-completing-read-handlers-alist + \\='(foo/test . helm-foo/test-completing-read-handler)) + + +We want here to make the regular `completing-read' in `foo/test' +return a list of candidate(s) instead of a single candidate. + +Note that this function will be reused for ALL the `completing-read' +of this command, so it should handle all cases. E.g., +if first `completing-read' completes against symbols and +second `completing-read' should handle only buffer, +your specialized function should handle both. + +If the value of an entry is nil completion will fall back to +Emacs vanilla behaviour. +Example: + +If you want to disable helm completion for `describe-function', use: + + (describe-function . nil) + +Ido is also supported, you can use `ido-completing-read' and +`ido-read-file-name' as value of an entry or just \\='ido. +Example: +Enable ido completion for `find-file': + + (find-file . ido) + +same as + + (find-file . ido-read-file-name) + +Note that you don't need to enable `ido-mode' for this to work, see +`helm-mode' documentation." + :group 'helm-mode + :type '(alist + :key-type symbol + :value-type (choice + function + (list :tag "Specify the completing-read and read-file-name handlers" + (choice + (const :tag "Use default helm completing-read handler" default) + (function :tag "Use this helm completing-read function")) + (function :tag "Use this helm read file name function")) + (other :tag "Disabled" nil)))) + +(defcustom helm-comp-read-case-fold-search helm-case-fold-search + "Default Local setting of `helm-case-fold-search' for `helm-comp-read'. +See `helm-case-fold-search' for more info." + :group 'helm-mode + :type 'symbol) + +(defcustom helm-mode-handle-completion-in-region t + "Whether to replace or not `completion-in-region-function'. +This enables support for `completing-read-multiple' and `completion-at-point' +when non--nil." + :group 'helm-mode + :type 'boolean) + +(defcustom helm-mode-no-completion-in-region-in-modes nil + "A list of modes that do not want helm for `completion-in-region'." + :group 'helm-mode + :type 'boolean) + +(defcustom helm-mode-reverse-history t + "Display history source after current source when non nil. + +Apply only in `helm-mode' handled commands." + :group 'helm-mode + :type 'boolean) + +(defcustom helm-completion-in-region-default-sort-fn + 'helm-completion-in-region-sort-fn + "The default sort function to sort candidates in completion-in-region. + +When nil no sorting is done. +The function is a `filtered-candidate-transformer' function which takes +two args CANDIDATES and SOURCE. +The function must use the flag `helm-completion--sorting-done' and +return CANDIDATES unchanged when the flag is nil. +See default function `helm-completion-in-region-sort-fn' as example. +It will be used only when `helm-completion-style' is either Emacs or +helm, otherwise when helm-fuzzy style is used, the fuzzy sort function +will be used." + :group 'helm-mode + :type 'function) + +(defcustom helm-mode-ignore-diacritics nil + "Ignore diacritics in completing-read." + :group 'helm-mode + :type 'boolean) + +(defcustom helm-completion-mark-suffix t + "Push mark at end of suffix when non nil." + :group 'helm-mode + :type 'boolean) + +(defcustom helm-read-file-name-use-default-arg-behavior nil + "Use emacs vanilla `read-file-name' behavior for default arg. + +The behavior of default arg in `read-file-name' and friends is using +the default arg as default value when initial input is not modified, +even if this initial input is a valid value i.e. an existing file. +We expect generally a default arg to be used if nothing is specified +in the prompt or if what is specified is invalid, but the emacs behavior +here is really weird, so we use this variable to disable this +behavior, letting user specify default if needed with `M-n'. +However we keep the emacs default for `read-file-name' and derived +fns, this variable affecting only `helm-read-file-name'." + :type 'boolean + :group 'helm-mode) + +(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.") + +(defvar helm-comp-read-require-match-overrides '((describe-function . t) + (describe-command . t) + (describe-minor-mode . t) + (load-theme . t) + (describe-theme . t)) + "Allow overriding REQUIRE-MATCH completing-read arg for a specific function.") + +(defcustom helm-completions-detailed t + "Provide detailed completion in several places. +See `helm-completing-read-extra-metadata' and +`helm-completing-read-command-categories'. +Setting `completions-detailed' when available have the same effect." + :type 'boolean + :group 'helm-mode) + +(defvar helm-mode-find-file-target-alist + '(("switch-to-buffer" . helm-buffers-quit-and-find-file-fn)) + "An alist composed of (SOURCE_NAME . FUNCTION) elements. +Where FUNCTION is a function suitable for `helm-quit-and-find-file'.") + +(defface helm-mode-prefix + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + (:background "red" :foreground "black"))) + "Face used for prefix completion." + :group 'helm-mode) + +(defface helm-completion-invalid + '((t :inherit font-lock-property-name-face)) + "Face used to highlight invalid functions." + :group 'helm-mode) + +(defface helm-completions-detailed + '((t :inherit font-lock-warning-face)) + "Face used to highlight completion-detailed informations." + :group 'helm-mode) + +(defface helm-completions-annotations + '((t :inherit font-lock-property-name-face)) + "Face used to highlight annotations in completion." + :group 'helm-mode) + +(defface helm-completions-key-binding + '((t :inherit font-lock-constant-face)) + "Face used to highlight key binding in completion." + :group 'helm-mode) + + +(defvar helm-comp-read-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (define-key map (kbd "") 'helm-cr-empty-string) + (define-key map (kbd "M-RET") 'helm-cr-empty-string) + map) + "Keymap for `helm-comp-read'.") + +(defvar helm-comp-in-region-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-comp-read-map) + map) + "Keymap for completion-at-point and friends.") + +(defun helm-mode-delete-char-backward-1 () + (interactive) + (condition-case err + (call-interactively 'delete-backward-char) + (text-read-only + (if (with-selected-window (minibuffer-window) + (not (string= (minibuffer-contents) ""))) + (message "Trying to delete prefix completion, next hit will quit") + (user-error "%s" (car err)))))) +(put 'helm-mode-delete-char-backward-1 'helm-only t) + +(defun helm-mode-delete-char-backward-2 () + (interactive) + (condition-case _err + (call-interactively 'delete-backward-char) + (text-read-only + (unless (with-selected-window (minibuffer-window) + (string= (minibuffer-contents) "")) + (with-helm-current-buffer + (run-with-timer 0.1 nil (lambda () + (call-interactively 'delete-backward-char)))) + (helm-keyboard-quit))))) +(put 'helm-mode-delete-char-backward-2 'helm-only t) + +(helm-multi-key-defun helm-mode-delete-char-backward-maybe + "Delete char backward when text is not the prefix helm is completing against. +First call warns user about deleting prefix completion. +Second call deletes backward char in current-buffer and quits helm completion, +letting the user start a new completion with a new prefix." + '(helm-mode-delete-char-backward-1 helm-mode-delete-char-backward-2) 1) + +(defcustom helm-completion-style 'helm + "Style of completion to use in `completion-in-region'. + +This affects only `completion-at-point' and friends, and +the `completing-read' using the default handler +i.e. `helm-completing-read-default-handler'. + +NB: This has nothing to do with `completion-styles', it is independent from +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 are three possible values to use: + +- helm, use multi match regular helm completion. + +- helm-fuzzy, use fuzzy matching. Note that as usual when + entering a space helm switches 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 provides a style called `flex' that can be used + aside `helm' style (see `completion-styles-alist'). When `flex' style + is not available (Emacs<27) helm provides `helm-flex' style which is + similar to `flex' and helm fuzzy matching. + +For a better experience with \\='emacs style, 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 or you want to force using helm-flex +instead of flex (see note above about flex). + +See also `helm-completion-styles-alist' to override +`helm-completion-style' for specific modes and commands. + +Of course when using `helm' or `helm-fuzzy' as `helm-completion-style' +emacs `completion-styles' have no effect. + +Please use custom interface or `customize-set-variable' to set this, +NOT `setq'." + :group 'helm-mode + :type '(choice (const :tag "Emacs" emacs) + (const :tag "Helm" helm) + (const :tag "Helm-fuzzy" helm-fuzzy)) + :set (lambda (var val) + (set var val) + (if (memq val '(helm helm-fuzzy)) + (define-key helm-comp-in-region-map (kbd "DEL") 'helm-mode-delete-char-backward-maybe) + (define-key helm-comp-in-region-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) + ;; See https://github.com/djcb/mu/issues/2181. + (mu4e-compose-mode . emacs) + (wfnames-mode . (emacs helm ,(if (assq 'flex completion-styles-alist) + 'flex 'helm-flex)))) + "Allow configuring `helm-completion-style' per mode or command. + +NOTE: Commands involving `completing-read' specified in +`helm-completing-read-handlers-alist' take precedence on commands +you put here. Specifying a mode instead of a command affect only +completion-in-region and not the completing-read's called in this mode, use +`helm-completing-read-handlers-alist' for this. + +Each entry is a cons cell like (mode_or_command . style) where +style must be a suitable value for `helm-completion-style'. When +specifying emacs as style for a mode or a command, +`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." + :group 'helm-mode + :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 +;; +;; +(defvar helm-comp-read-use-marked nil + "[INTERNAL] When non nil `helm-comp-read' will return marked candidates. + +Use this ONLY in `let', NOT globally, this allows third party packages +to use a list as return value when `helm-mode' is enabled, e.g. + + (let ((helm-comp-read-use-marked t)) + (completing-read \"test: \" \\='(a b c d e f g))) + +") + +(defun helm-cr-empty-string () + "Return empty string." + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action + (lambda (_candidate) + (identity ""))))) +(put 'helm-cr-empty-string 'helm-only t) + +(defun helm-mode--keyboard-quit () + ;; Use this instead of `keyboard-quit' + ;; to avoid deactivating mark in current-buffer. + (let ((debug-on-quit nil)) + (signal 'quit nil))) + +(defun helm-comp-read-get-candidates (collection + &optional test sort-fn alistp input) + "Convert COLLECTION to list removing elements that don't match TEST. +See `helm-comp-read' about supported COLLECTION arguments. + +SORT-FN is a predicate to sort COLLECTION. + +ALISTP when non--nil will not use `all-completions' to collect +candidates because it doesn't handle alists correctly for helm. +i.e In `all-completions' the car of each pair is used as value. +In helm we want to use the cdr instead like (display . real), +so we return the alist as it is with no transformation by +`all-completions'. + +e.g + +\(setq A \\='((a . 1) (b . 2) (c . 3))) +==>((a . 1) (b . 2) (c . 3)) +\(helm-comp-read \"test: \" A :alistp nil + :exec-when-only-one t + :initial-input \"a\") +==>\"a\" Which is not what we expect. + +\(helm-comp-read \"test: \" A :alistp t + :exec-when-only-one t + :initial-input \"1\") +==>\"1\" + +See docstring of `all-completions' for more info. + +INPUT is the string you want to complete against, defaulting to +`helm-pattern' which is the value of what you enter in minibuffer. +Note that when using a function as COLLECTION this value will be +available with the input argument of the function only when using a +sync source from `helm-comp-read', i.e. not using +`:candidates-in-buffer', otherwise the function is called only once +with an empty string as value for `helm-pattern' because +`helm-pattern' is not yet computed, which is what we want otherwise +data would not be fully collected at init time. + +If COLLECTION is an `obarray', a TEST should be needed. See `obarray'." + (unless input (setq input helm-pattern)) + ;; Ensure COLLECTION is computed from `helm-current-buffer' because some + ;; functions used as COLLECTION work only in the context of current-buffer, + ;; presumably when completing-region (Bug#1030) OTOH completion functions used + ;; from completing-read generally expect to be called from the minibuffer + ;; (Bug#2744). + (with-current-buffer (if helm--completing-region + helm-current-buffer + (window-buffer + (or (active-minibuffer-window) + (minibuffer-window)))) + (let ((cands + (cond ((and alistp (hash-table-p collection)) + (cl-loop for k being the hash-keys of collection + using (hash-values v) + collect (cons k v))) + ((vectorp collection) + (all-completions input collection test)) + ((and (symbolp collection) (boundp collection) + ;; Bug#324 history is let-bounded and given + ;; quoted as hist argument of completing-read. + ;; See example in `rcirc-browse-url'. + (symbolp (symbol-value collection))) + nil) + ;; When collection is a symbol, most of the time + ;; it should be a symbol used as a minibuffer-history. + ;; The value of this symbol in this case return a list + ;; of string which maybe are converted later as symbol + ;; in special cases. + ;; we treat here commandp as a special case as it return t + ;; also with a string unless its last arg is provided. + ;; Also, the history collections generally collect their + ;; elements as string, so intern them to call predicate. + ((and (symbolp collection) (boundp collection) test) + (let ((predicate (lambda (elm) + (condition-case _err + (if (eq test 'commandp) + (funcall test (intern elm)) + (funcall test elm)) + (wrong-type-argument + (funcall test (intern elm))))))) + (all-completions input (symbol-value collection) predicate))) + ((and (symbolp collection) (boundp collection)) + (all-completions input (symbol-value collection))) + ;; Normally file completion should not be handled here, + ;; but special cases like `find-file-at-point' do it. + ;; Handle here specially such cases. + ((and (functionp collection) (not (string= input "")) + (or minibuffer-completing-file-name + (eq (completion-metadata-get + (completion-metadata input collection test) + 'category) + 'file))) + (cl-loop for f in (funcall collection input test t) + unless (member f '("./" "../")) + if (string-match helm--url-regexp input) + collect f + else + collect (concat (file-name-as-directory + (helm-basedir input)) + f))) + ((functionp collection) + (funcall collection input test t)) + ((and alistp (null test)) collection) + ;; Next test ensure circular objects are removed + ;; with `all-completions' (Bug#1530). + (t (all-completions input collection test))))) + (if sort-fn (sort cands sort-fn) cands)))) + +(defun helm-cr--pattern-in-candidates-p (candidates &optional pattern) + (unless pattern (setq pattern helm-pattern)) + (or (assoc pattern candidates) + (assoc (concat " " pattern) candidates) + (assq (intern pattern) candidates) + (member pattern candidates) + (member (downcase pattern) candidates) + (member (upcase pattern) candidates))) + +(defun helm-cr-default-transformer (candidates _source) + "Default filter candidate function for `helm-comp-read'." + ;; Annotation and affixation are already handled in completion-in-region and + ;; in helm-completing-read-default-2 when emacs style is in use. + ;; For helm-completing-read-default-1 we handle them in an extra FCT; This + ;; allows extracting annotation and affixation from metadata which is not + ;; accessible from here. + (cl-loop for c in candidates + for cand = (let ((elm (if (stringp c) + (replace-regexp-in-string "\\s\\" "" c) + c))) + (cond ((and (stringp elm) + (string-match "\n" elm)) + (cons (replace-regexp-in-string "\n" "->" elm) c)) + (t c))) + collect cand)) + +(defun helm-cr-default (default cands) + (delq nil + (cond ((and (consp default) (string= helm-pattern "")) + (append (cl-loop for d in default + ;; Don't convert + ;; nil to "nil" (i.e the string) + ;; it will be delq'ed on top. + for str = (if (null d) d (helm-stringify d)) + when (member str cands) + do (setq cands (delete d cands)) + when str collect str) + cands)) + ;; Some functions like debug-on-entry use (symbol-name sym) + ;; without checking if sym is non nil, so the return value become + ;; "nil". + ((and (not (member default '("" "nil"))) + (string= helm-pattern "")) + (cons default (delete (helm-stringify default) + cands))) + (t cands)))) + +;;;###autoload +(cl-defun helm-comp-read (prompt collection + &key + test + initial-input + default + preselect + (buffer "*Helm Completions*") + must-match + fuzzy + reverse-history + (requires-pattern 0) + (history nil shistory) + raw-history + input-history + (case-fold helm-comp-read-case-fold-search) + (persistent-action nil) + (persistent-help "DoNothing") + (mode-line helm-comp-read-mode-line) + help-message + (keymap helm-comp-read-map) + (name "Helm Completions") + header-name + candidates-in-buffer + (get-line #'buffer-substring) + diacritics + match-part + match-dynamic + exec-when-only-one + quit-when-no-cand + (volatile t) + sort + fc-transformer + hist-fc-transformer + (marked-candidates helm-comp-read-use-marked) + nomark + (alistp t) + (candidate-number-limit helm-candidate-number-limit) + multiline + allow-nest + coerce + raw-candidate + (group 'helm) + popup-info) + "Read a string in the minibuffer, with helm completion. + +It is helm `completing-read' equivalent. + +- PROMPT is the prompt name to use. + +- COLLECTION can be a list, alist, vector, obarray or hash-table. + For alists and hash-tables their car are use as real value of + candidate unless ALISTP is non-nil. + It can be also a function that receives three arguments: + the values string, predicate and t. See `all-completions' for more details. + +Keys description: + +- TEST: A predicate called with one arg i.e candidate. + +- INITIAL-INPUT: Same as input arg in `helm'. + +- PRESELECT: See preselect arg of `helm'. + +- DEFAULT: This option is used only for compatibility with regular + Emacs `completing-read' (Same as DEFAULT arg of `completing-read'). + +- BUFFER: Name of helm-buffer. + +- MUST-MATCH: Candidate selected must be one of COLLECTION. + +- FUZZY: Enable fuzzy matching. + +- REVERSE-HISTORY: When non--nil display history source after current + source completion. + +- REQUIRES-PATTERN: Same as helm attribute, default is 0. + +- HISTORY: A symbol where each result will be saved. + If not specified as a symbol an error will popup. + When specified, all elements of HISTORY are displayed in + a special source before or after COLLECTION according to REVERSE-HISTORY. + The main difference with INPUT-HISTORY is that the result of the + completion is saved whereas in INPUT-HISTORY it is the minibuffer + contents which is saved when you exit. + Don't use the same symbol for INPUT-HISTORY and HISTORY. + NOTE: As mentionned above this has nothing to do with + `minibuffer-history-variable', therefore if you want to save this + history persistently, you will have to add this variable to the + relevant variable of your favorite tool for persistent emacs session + i.e. psession, desktop etc... + +- RAW-HISTORY: When non-nil do not remove backslashs if some in + HISTORY candidates. + +- INPUT-HISTORY: A symbol. The minibuffer input history will be + stored there, if nil or not provided, `minibuffer-history' + will be used instead. You can navigate in this history with + `M-p' and `M-n'. + Don't use the same symbol for INPUT-HISTORY and HISTORY. + +- CASE-FOLD: Same as `helm-case-fold-search'. + +- PERSISTENT-ACTION: A function called with one arg i.e candidate. + +- PERSISTENT-HELP: A string to document PERSISTENT-ACTION. + +- MODE-LINE: A string or list to display in mode line. + Default is `helm-comp-read-mode-line'. + +- KEYMAP: A keymap to use in this `helm-comp-read'. + (the keymap will be shared with history source) + +- NAME: The name related to this local source. + +- HEADER-NAME: A function to alter NAME, see `helm'. + +- EXEC-WHEN-ONLY-ONE: Bound `helm-execute-action-at-once-if-one' + to non--nil. (possibles values are t or nil). + +- VOLATILE: Use volatile attribute. + +- SORT: A predicate to give to `sort' e.g `string-lessp' + Use this only on small data as it is inefficient. + If you want to sort faster add a sort function to + FC-TRANSFORMER. + Note that FUZZY when enabled is already providing a sort function. + +- FC-TRANSFORMER: A `filtered-candidate-transformer' function + or a list of functions. + +- HIST-FC-TRANSFORMER: A `filtered-candidate-transformer' + function for the history source. + +- MARKED-CANDIDATES: If non-nil return candidate or marked candidates as a list. + +- NOMARK: When non--nil don't allow marking candidates. + +- ALISTP: + When non-nil (default) pass the value of (DISPLAY . REAL) + candidate in COLLECTION to action when COLLECTION is an alist or a + hash-table, otherwise DISPLAY is always returned as result on exit, + which is the default when using `completing-read'. + See `helm-comp-read-get-candidates'. + +- CANDIDATES-IN-BUFFER: when non--nil use a source build with + `helm-source-in-buffer' which is much faster. + Argument VOLATILE have no effect when CANDIDATES-IN-BUFFER is non--nil. + +- GET-LINE: Specify the :get-line slot of `helm-source-in-buffer', has no effect + when CANDIDATES-IN-BUFFER is nil. + +- MATCH-PART: Allow matching only one part of candidate. + See match-part documentation in `helm-source'. + +- MATCH-DYNAMIC: See match-dynamic in `helm-source-sync' + It has no effect when used with CANDIDATES-IN-BUFFER. + +- ALLOW-NEST: Allow nesting this `helm-comp-read' in a helm session. + See `helm'. + +- MULTILINE: See multiline in `helm-source'. + +- COERCE: See coerce in `helm-source'. + +- RAW-CANDIDATE: Do not unquote the unknown candidate coming from helm-pattern + when non nil. + +- GROUP: See group in `helm-source'. + +Any prefix args passed during `helm-comp-read' invocation will be recorded +in `helm-current-prefix-arg', otherwise if prefix args were given before +`helm-comp-read' invocation, the value of `current-prefix-arg' will be used. +That means you can pass prefix args before or after calling a command +that use `helm-comp-read'. See `helm-M-x' for example." + ;; Handle error with HISTORY: + ;; + ;; Should show helm with one source at first run and save result on + ;; exit, should show the history source along candidates source on + ;; next run as soon as `test-hist' value is feeded. + ;; (setq test-hist nil) + ;; (helm-comp-read "test: " '(a b c d e) + ;; :history 'test-hist) + ;; + ;; Should run normally as long as `test-hist' is bound and nil. As + ;; soon `test-hist' becomes non-nil throw an error. + ;; (helm-comp-read "test: " '(a b c d e) + ;; :history test-hist) + ;; + ;; Should run normally. + ;; (completing-read "test: " '(a b c d e)) + (cl-assert (if shistory + (or (null history) + (and history (symbolp history))) + t) + nil "Error: History should be specified as a symbol") + (when (get-buffer helm-action-buffer) + (kill-buffer helm-action-buffer)) + ;; The value of MUST-MATCH is given to + ;; `helm--set-minibuffer-completion-confirm' which compute it and propagate it + ;; to `minibuffer-completion-confirm' which is then used by + ;; `helm-confirm-and-exit-minibuffer'. + (unless (or (memq must-match '(confirm confirm-after-completion t nil)) + (functionp must-match)) + ;; Fix completing-read's using something else than (confirm + ;; confirm-after-completion t nil) or a function e.g. 1 or + ;; whatever (bug #2527). + (setq must-match t)) + (let ((action-fn `(("Sole action (Identity)" + . ,(lambda (candidate) + (if marked-candidates + (helm-marked-candidates) + (identity candidate))))))) + (let* ((minibuffer-completion-predicate test) + (minibuffer-completion-table + (or minibuffer-completion-table collection)) + (helm-read-file-name-mode-line-string + (replace-regexp-in-string "helm-maybe-exit-minibuffer" + "helm-confirm-and-exit-minibuffer" + helm-read-file-name-mode-line-string)) + (get-candidates + (lambda () + (let ((cands (helm-comp-read-get-candidates + ;; If `helm-pattern' is passed as INPUT + ;; and :alistp is nil INPUT is passed to + ;; `all-completions' which defeat helm + ;; matching functions (multi match, fuzzy + ;; etc...) Bug#2134. + collection test sort alistp + (if (and match-dynamic (null candidates-in-buffer)) + helm-pattern "")))) + (helm-cr-default default cands)))) + (history-get-candidates + (lambda () + (let ((cands (helm-comp-read-get-candidates + history test nil alistp))) + (when cands + (delete "" (helm-cr-default default cands)))))) + (src-hist (helm-build-sync-source (format "%s History" name) + :candidates history-get-candidates + :fuzzy-match fuzzy + :multiline multiline + :match-part match-part + :filtered-candidate-transformer + (append `((lambda (candidates _source) + (if ,raw-history + candidates + (cl-loop for i in candidates + ;; Input is added to history in completing-read's + ;; and may be regexp-quoted, so unquote it + ;; but check if cand is a string (it may be at this stage + ;; a symbol or nil) Bug#1553. + when (stringp i) + collect (replace-regexp-in-string "\\s\\" "" i))))) + (and hist-fc-transformer (helm-mklist hist-fc-transformer))) + :persistent-action persistent-action + :persistent-help persistent-help + :keymap keymap + :must-match must-match + :group group + :popup-info popup-info + :coerce coerce + :mode-line mode-line + :help-message help-message + :action action-fn)) + (dummy-src (helm-build-dummy-source "Unknown candidate" + :must-match must-match + :keymap keymap + :filtered-candidate-transformer + (lambda (_candidates _source) + (let ((pat (if raw-candidate + helm-pattern + (replace-regexp-in-string "\\s\\" "" helm-pattern)))) + (unless (string= pat "") + (list (cons (helm-aand (propertize "[?]" 'face 'helm-ff-prefix) + (propertize " " 'display it 'unknown t) + (concat it pat)) + pat))))) + :action action-fn)) + (src (helm-build-sync-source name + :candidates get-candidates + :popup-info popup-info + :match-part match-part + :multiline multiline + :header-name header-name + :filtered-candidate-transformer + (let ((transformers (helm-mklist fc-transformer))) + (append transformers + (unless (member 'helm-cr-default-transformer transformers) + '(helm-cr-default-transformer)))) + :requires-pattern requires-pattern + :persistent-action persistent-action + :persistent-help persistent-help + :fuzzy-match fuzzy + :diacritics diacritics + :keymap keymap + :must-match must-match + :group group + :coerce coerce + :mode-line mode-line + :match-dynamic match-dynamic + :help-message help-message + :action action-fn + :volatile volatile)) + (src-1 (helm-build-in-buffer-source name + :data get-candidates + :match-part match-part + :get-line get-line + :multiline multiline + :header-name header-name + :filtered-candidate-transformer + (let ((transformers (helm-mklist fc-transformer))) + (append transformers + (unless (member 'helm-cr-default-transformer transformers) + '(helm-cr-default-transformer)))) + :popup-info popup-info + :requires-pattern requires-pattern + :persistent-action persistent-action + :fuzzy-match fuzzy + :diacritics diacritics + :keymap keymap + :must-match must-match + :group group + :coerce coerce + :persistent-help persistent-help + :mode-line mode-line + :help-message help-message + :action action-fn)) + (src-list (list src-hist + (if candidates-in-buffer + src-1 src))) + (helm-execute-action-at-once-if-one exec-when-only-one) + (helm-quit-if-no-candidate quit-when-no-cand) + result) + (when nomark + (setq src-list (cl-loop for src in src-list + collect (cons '(nomark) src)))) + (when reverse-history (setq src-list (nreverse src-list))) + (unless (eq must-match t) + (setq src-list (append src-list (list dummy-src)))) + (when raw-candidate + (cl-loop for src in src-list + do (helm-set-attr 'raw-candidate t src))) + (setq result (helm + :sources src-list + :input initial-input + :default default + :preselect preselect + :prompt prompt + :resume 'noresume + :keymap keymap ;; Needed with empty collection. + :allow-nest allow-nest + :candidate-number-limit candidate-number-limit + :case-fold-search case-fold + :history (and (symbolp input-history) input-history) + :buffer buffer)) + ;; If `history' is a symbol save it, except when it is t. + (when (and result history (symbolp history) (not (eq history t))) + (set history + ;; RESULT may be a a string or a list of strings bug #2461. + (delete-dups (append (mapcar #'substring-no-properties (helm-mklist result)) + (symbol-value history))))) + (or result (helm-mode--keyboard-quit))))) + + +;; Generic completing-read +;; +;; Support also function as collection. +;; e.g M-x man is supported. +;; Support hash-table and vectors as collection. +;; NOTE: +;; Some crap emacs functions may not be supported +;; like ffap-alternate-file (bad use of completing-read) +;; and maybe others. +;; Provide a mode `helm-mode' which turn on +;; helm in all `completing-read' and `read-file-name' in Emacs. +;; +(defvar helm-completion-mode-string " Helm") + +(defvar helm-completion-mode-quit-message + "Helm completion disabled") + +(defvar helm-completion-mode-start-message + "Helm completion enabled") + +;;; Specialized handlers +;; +;; +(defun helm-completing-read-symbols + (prompt _collection test _require-match init + hist default _inherit-input-method name buffer) + "Specialized function for fast symbols completion in `helm-mode'." + (require 'helm-elisp) + (or + (helm + :sources (helm-build-in-buffer-source name + :init (lambda () + (helm-apropos-init (lambda (x) + (and (funcall test x) + (not (keywordp x)))) + (or (car-safe default) default))) + :filtered-candidate-transformer 'helm-apropos-default-sort-fn + :help-message #'helm-comp-read-help-message + :fuzzy-match (eq helm-completion-style 'helm-fuzzy) + :persistent-action + (lambda (candidate) + (helm-lisp-completion-persistent-action + candidate name)) + :persistent-help (helm-lisp-completion-persistent-help)) + :prompt prompt + :buffer buffer + :input init + :history hist + :resume 'noresume + :default (or default "")) + (helm-mode--keyboard-quit))) + + +;;; Extra metadata for completions-detailed +;; +;; +(defvar helm-completing-read-extra-metadata + '((buffer . (metadata + (affixation-function . helm-completing-read-buffer-affixation) + (category . buffer) + (flags . (helm-completing-read--buffer-lgst-mode)))) + (symbol-help . (metadata + (affixation-function . helm-symbol-completion-table-affixation) + (persistent-fn . t) + (category . symbol-help))) + (command-help . (metadata + (prefix-arg . t) + (persistent-fn . t) + (affixation-function . helm-symbol-completion-table-affixation) + (category . symbol-help))) + (eww-help . (metadata ;; Emacs-30 only + (affixation-function . helm-completion-eww-affixation) + (category . eww-help))) + (package . (metadata + (affixation-function . helm-completion-package-affixation) + (category . package))) + (theme . (metadata + (affixation-function . helm-completion-theme-affixation) + (category . theme))) + (coding-system . (metadata + (affixation-function . helm-completion-coding-system-affixation) + (category . coding-system))) + (color . (metadata + (affixation-function . helm-completion-color-affixation) + (category . color))) + (library . (metadata + (affixation-function . helm-completion-library-affixation) + (category . library))) + (charset . (metadata + (affixation-function . helm-completion-charset-affixation) + (category . charset))) + (man . (metadata + (popup-info-function . helm-completion-man-popup-info) + (category . man))) + (info . (metadata + (affixation-function . helm-completion-info-file-affixation) + (category . info))) + (bookmark . (metadata + (affixation-function . helm-completion-bookmark-affixation) + (category . bookmark)))) + "Extra metadatas for completing-read. + +It is used to add `affixation-function' or `annotation-function' if original +metadata doesn't have some or to override existing metadata according to the +category extracted from current metadata. +Helm provides as well an extra property called `popup-info-function' for +categories where it would be too costly to extract informations for all +candidates (See \\='man' category). + +It is an alist composed of (CATEGORY . METADATA) elements. +CATEGORY is a symbol specifying the category according +to the command in use and METADATA is a list composed like this: + + (metadata (affixation-function . fun) + (annotation-function . fun) + (category . category) + (flags . flags)) + +Categories for a specific commands are stored in +`helm-completing-read-command-categories'. + +FLAGS is a list of variables to renitialize to nil when exiting or quitting.") + +(defvar helm-completing-read-command-categories + '(("man" . man) + ("manual-entry" . man) + ("customize-variable" . symbol-help) + ("customize-set-variable" . symbol-help) + ("customize-set-value" . symbol-help) + ("customize-save-variable" . symbol-help) + ("describe-function" . symbol-help); For Emacs-27. + ("describe-variable" . symbol-help); For Emacs-27. + ("describe-symbol" . symbol-help) ; For Emacs-27. + ("describe-command" . symbol-help) ; For Emacs-27. + ("set-variable" . symbol-help) + ("customize-group" . symbol-help) + ("find-function" . symbol-help) + ("find-variable" . symbol-help) + ("trace-function" . symbol-help) + ("trace-function-foreground" . symbol-help) + ("trace-function-background" . symbol-help) + ("describe-minor-mode" . symbol-help) + ("toggle-option" . symbol-help) + ("where-is" . symbol-help) + ("execute-extended-command" . symbol-help) + ("execute-extended-command-for-buffer" . command-help) + ("info-lookup-symbol" . symbol-help) + ("Info-goto-emacs-command-node" . symbol-help) + ("find-library" . library) + ("locate-library" . library) + ("kill-buffer" . buffer) + ("package-install" . package) + ("package-upgrade" . package) + ("package-recompile" . package) + ("package-reinstall" . package) + ("package-delete" . package) + ("package-vc-install" . package) + ("package-vc-checkout" . package) + ("package-vc-log-incoming" . package) + ("package-vc-prepare-patch" . package) + ("package-vc-rebuild" . package) + ("package-vc-upgrade" . package) + ("describe-package" . package) + ("load-theme" . theme) + ("describe-theme" . theme) + ("describe-coding-system" . coding-system) + ("set-file-name-coding-system" . coding-system) + ("set-keyboard-coding-system" . coding-system) + ("set-terminal-coding-system" . coding-system) + ("set-process-coding-system" . coding-system) + ("set-buffer-process-coding-system" . coding-system) + ("set-buffer-file-coding-system" . coding-system) + ("set-selection-coding-system" . coding-system) + ("set-next-selection-coding-system" . coding-system) + ("set-clipboard-coding-system" . coding-system) + ("universal-coding-system-argument" . coding-system) + ("read-color" . color) + ("list-charset-chars" . charset) + ("info-display-manual" . info) + ;; Emacs-30 only + ("eww" . eww-help) + ("bookmark-jump" . bookmark)) + "An alist to specify metadata category by command. + +Some commands provide a completion-table with no category +specified in metadata, we allow here specifying the category of +the completion provided by a specific command. The command +should be specified as a string and the category as a symbol.") + +;; We can't reuse the function from helm-man.el because the candidates are here +;; differents e.g. apt vs apt(8). +(defun helm-completion-man-popup-info (candidate) + "Popup-info function for `man' category. +See `helm-completing-read-extra-metadata'." + ;; Man has the stupid habit to use symbol at point as default, try to not + ;; match it. + (let* ((com (if (string-match "\\(.*\\) ?([^()]+)" candidate) + (match-string 1 candidate) + candidate)) + (output (shell-command-to-string (format "man -f '%s'" com)))) + (when (string-match (format "\\(%s ?([^(]+)\\) *- ?\\(.*\\)\n" com) + output) + (match-string 2 output)))) + +(defvar helm-completing-read--buffer-lgst-mode nil) +(defun helm-completing-read-buffer-affixation (completions) + "Affixation function for `buffer' category. +See `helm-completing-read-extra-metadata'." + (let ((len-mode (or helm-completing-read--buffer-lgst-mode + (setq helm-completing-read--buffer-lgst-mode + (cl-loop for bn in completions + maximize (with-current-buffer bn + (length (symbol-name major-mode)))))))) + (lambda (comp) + (let* ((buf (get-buffer comp)) + (fname (buffer-file-name buf)) + (modified (and fname (buffer-modified-p buf))) + (prefix (cond (modified + (propertize + "fm " 'face 'font-lock-comment-face)) + (fname + (propertize + " f " 'face 'helm-completions-annotations)) + (t (propertize "nf " 'face 'font-lock-doc-face)))) + (mode (with-current-buffer comp + (propertize + (symbol-name major-mode) 'face 'helm-completions-detailed))) + (size (helm-buffer-size buf)) + (max-len (helm-acase helm-buffer-max-length + ((guard* (numberp it)) it) + (t 20))) + (bname (truncate-string-to-width + comp max-len nil nil + helm-buffers-end-truncated-string)) + (suffix (format "%s%s%s%s%s `%s'" + (make-string (1+ (- max-len (length bname))) ? ) + (propertize size + 'face 'helm-buffer-size) + (make-string (- 7 (length size)) ? ) + mode + (make-string (1+ (- len-mode (length mode))) ? ) + (helm-aif fname + (propertize + (abbreviate-file-name (file-name-directory it)) + 'face 'font-lock-type-face) + (propertize + (with-current-buffer comp + (abbreviate-file-name default-directory)) + 'face 'font-lock-doc-face))))) + (list (propertize + bname 'face (if fname + 'font-lock-builtin-face + 'font-lock-doc-face)) + (propertize " " 'display prefix) + (propertize " " 'display suffix)))))) + +(defun helm-symbol-completion-table-affixation (_completions) + "Affixation function for `symbol-help' category. +See `helm-completing-read-extra-metadata'. + +Override `help--symbol-completion-table-affixation'. + +Normally affixation functions use COMPLETIONS as arg, and return a list of +modified COMPLETIONS. Now we allow affixations functions to return a +function instead, just like annotation functions. The function should return a +list of three elements like (comp prefix suffix). This increase significantly +the speed avoiding one useless loop on complete list of candidates. + +Returns a function and not a list of completions. + +It affects currently describe-variable/function/command/symbol functions. +It uses `helm-get-first-line-documentation' which allow providing documentation +for `describe-variable' symbols and align properly documentation when helm style +is used." + (lambda (comp) + (require 'help-fns) + (let* ((sym (intern comp)) + ;; When using in-buffer implementation we should have the + ;; longest len to align documentation for free. + ;; Check for style as well in case user switches to emacs + ;; style and a candidate buffer remains (with its local vars + ;; still available). + (max-len (and (memq helm-completion-style '(helm helm-fuzzy)) + (helm-in-buffer-get-longest-candidate))) + (sep (if (or (null max-len) (zerop max-len)) + " -- " ; Default separator. + (helm-make-separator comp max-len))) + (doc (ignore-errors + (helm-get-first-line-documentation sym))) + (symbol-class (with-helm-current-buffer (help--symbol-class sym))) + (group (helm-group-p sym)) + (key (helm-completion-get-key sym))) + (list + ;; Symbol (comp). + (if (or (symbol-function sym) (boundp sym) + (facep sym) group) + comp + ;; Not already defined function. To test add an advice on a non + ;; existing function. + (propertize comp 'face 'helm-completion-invalid)) + ;; Prefixes meaning: (see `help--symbol-class' which returns such strings for a + ;; given symbol). + ;; " c " command + ;; " - " obsolete, 'byte-obsolete-info + ;; " v " var, not a defcustom + ;; " ' " local-variable-if-set-p + ;; " * " not default value if buffer local + ;; " - " 'byte-obsolete-variable + (helm-aand (cond ((and symbol-class group) + (concat "g" symbol-class)) + ((and (not (string= symbol-class "")) + symbol-class)) + (group "g") + (t "i")) ; Not already defined function. + (propertize it 'face 'helm-completions-detailed) + ;; help--symbol-class currently can return at most 8 + ;; characters long symbol class but it is very rare, it is + ;; generally max 4 (bug#2656). + (propertize + ;; (format "%-4s" it) may make spaces inheriting text props + ;; with emacs -nw in emacs<29. + " " 'display (format "%-4s" it))) + ;; Suffix. + (if doc + (helm-aand (propertize doc 'face 'helm-completions-detailed) + (propertize " " 'display (concat sep it key))) + ""))))) + +(defun helm-completion-get-key (sym) + "Return key description on symbol SYM." + (with-helm-current-buffer + (let* ((key (and (commandp sym) (where-is-internal sym nil 'first-only))) + (binding (and key (key-description key)))) + (when binding + (propertize (format " (%s)" binding) 'face 'helm-completions-key-binding))))) + +(defun helm-mode--package-name-from-full-name (comp) + "Extract the package name from a package full-name. +e.g. w3m-20251201.129 => w3m." + (if (string-match "\\(.*\\)-[[:digit:]]+" comp) + (match-string 1 comp) + comp)) + +(defun helm-completion-package-affixation (_completions) + "Affixation function for `package' category. +See `helm-completing-read-extra-metadata'." + (lambda (comp) + (let* ((sym (intern-soft (helm-mode--package-name-from-full-name comp))) + (id (package-get-descriptor sym)) + (built-in (package-built-in-p sym)) + (status (and id (package-desc-status id))) + (desc (if built-in + (aref (assoc-default sym package--builtins) 2) + (and id (package-desc-summary id)))) + (sep (helm-make-separator comp))) + (list comp + (propertize + (if status + (format "%s " (substring status 0 1)) + "b ") + 'face 'helm-completions-annotations) + (or (helm-aand desc + (propertize it 'face 'helm-completions-detailed) + (propertize " " 'display (concat sep it))) + ""))))) + +(defun helm-completion-bookmark-affixation (_completions) + "Affixation function for `bookmark' category. +See `helm-completing-read-extra-metadata'." + (lambda (comp) + (let* ((sep (helm-make-separator comp)) + (loc (bookmark-location comp))) + (list (propertize comp 'face 'bookmark-menu-bookmark) + "" + (helm-aand (propertize loc 'face 'helm-completions-detailed) + (propertize " " 'display (concat sep it))))))) + +(defun helm-completion-theme-affixation (_completions) + "Affixation function for `theme' category. +See `helm-completing-read-extra-metadata'." + (lambda (comp) + (let* ((sym (intern-soft comp)) + (sep (helm-make-separator comp)) + (doc (if (custom-theme-p sym) + (helm-get-first-line-documentation sym) + (helm--get-theme-doc-1 sym)))) + (list comp + "" + (helm-aand (propertize doc 'face 'helm-completions-detailed) + (propertize " " 'display (concat sep it))))))) + +(defun helm--get-theme-doc-1 (sym) + (let ((fn (locate-file (concat (symbol-name sym) "-theme.el") + (custom-theme--load-path) + '("" "c"))) + doc) + ;; Avoid loading theme as much as possible. + (when fn + (with-temp-buffer + (insert-file-contents fn) + (helm-awhile (let ((read-circle nil)) + (condition-case nil + (read (current-buffer)) + (end-of-file nil))) + (let ((docstring (nth 2 it))) + (when (and (eq (car-safe it) 'deftheme) docstring) + (cl-return (setq doc (car (split-string docstring "\n"))))))) + (unless doc + (setq doc (helm--get-theme-doc-from-header))))) + doc)) + +(defun helm--get-theme-doc-from-header () + "Extract doc in first line of theme file." + (goto-char (point-min)) + (let (beg end) + (when (re-search-forward "--- " (pos-eol) t) + (setq beg (point))) + (if (re-search-forward " -\\*-" (pos-eol) t) + (setq end (match-beginning 0)) + (setq end (pos-eol))) + (when (and beg end) + (buffer-substring beg end)))) + +(defun helm-completion-coding-system-affixation (_comps) + "Affixation function for `coding-system' category. +See `helm-completing-read-extra-metadata'." + (require 'mule-diag) + (lambda (comp) + (let ((doc (with-output-to-string + (with-current-buffer standard-output + (print-coding-system-briefly (intern comp) 'tightly)))) + (sep (helm-make-separator comp))) + (list comp "" (helm-aand (replace-regexp-in-string "^ *" "" doc) + (replace-regexp-in-string "[\n]" "" it) + (propertize it 'face 'helm-completions-detailed) + (propertize " " 'display (concat sep it))))))) + +(defun helm-completion-charset-affixation (_comps) + "Affixation function for `charset' category. +See `helm-completing-read-extra-metadata'." + (lambda (comp) + (let ((doc (charset-description (intern comp))) + (sep (helm-make-separator comp))) + (list comp "" (helm-aand (propertize doc 'face 'helm-completions-detailed) + (propertize " " 'display (concat sep it))))))) + +(defun helm-completion-color-affixation (_comps) + "Affixation function for `color' category. +See `helm-completing-read-extra-metadata'." + (lambda (comp) + (let ((sep (helm-make-separator comp)) + (rgb (condition-case nil + (helm-acase comp + ("foreground at point" (with-helm-current-buffer + (foreground-color-at-point))) + ("background at point" (with-helm-current-buffer + (background-color-at-point))) + (t + (apply #'color-rgb-to-hex (color-name-to-rgb comp)))) + (error "SAMPLE")))) + (list comp + "" + (helm-aand (propertize rgb 'face `(:background ,rgb + :distant-foreground "black")) + (propertize " " 'display (concat sep it))))))) + +(defun helm-completion-library-affixation (_comps) + "Affixation function for `library' category. +See `helm-completing-read-extra-metadata'." + ;; We share here the same cache as `helm-locate-library'. + (require 'helm-elisp) + (lambda (comp) + ;; Because find-library-include-other-files default to t, we have all the + ;; unrelated files and directories coming in ... Even if this modify the + ;; behavior of find-library-include-other-files remove them for the benefit + ;; of everybody. + (unless (or (string-match "\\(\\.elc\\|/\\)\\'" comp) + (string-match "\\`\\.#" comp)) ; (bug#2526) + (let* ((sep (helm-make-separator comp)) + (path (or (assoc-default comp helm--locate-library-cache) + (let ((p (find-library-name comp))) + (push (cons comp p) helm--locate-library-cache) + p))) + (doc (or (gethash comp helm--locate-library-doc-cache) + (puthash comp (helm-locate-lib-get-summary path) + helm--locate-library-doc-cache)))) + (list comp + "" + (helm-aand (propertize doc 'face 'helm-completions-detailed) + (propertize " " 'display (concat sep it)))))))) + +(defun helm-completion-eww-affixation (_completions) + "Affixation function for `eww-help' category. +See `helm-completing-read-extra-metadata'." + (lambda (comp) + (let* ((title (or (cl-loop for bmk in eww-bookmarks + for title = (plist-get bmk :title) + for url = (plist-get bmk :url) + thereis (and (string= comp url) title)) + "Unknown title")) + (sep (helm-make-separator title 72))) + (list (propertize comp 'display + (truncate-string-to-width comp 72 nil nil t)) + (helm-aand (propertize (truncate-string-to-width title 72) + 'face 'helm-completions-detailed) + (propertize " " 'display (concat it sep))) + "")))) + +(defun helm-completion-info-file-affixation (_completions) + "Affixation function for `info' category. +See `helm-completing-read-extra-metadata'." + ;; We share here the same cache as `helm-info'. + (require 'info) + (require 'helm-info) + (lambda (comp) + (let* ((sep (helm-make-separator comp)) + (prefix "") + (file (or + ;; The `info-display-manual' favours `Info-mode' + ;; buffers. However, each buffer like that may be opened from + ;; a file that has not been installed and is not visible to a + ;; `Info-find-file'. Retrieve the such a file name from the + ;; buffer, and use it to scan for affixation, however don't + ;; cache the result in `helm-info--files-cache' to avoid using + ;; wrong file. For example, the latter can happen after a + ;; development version of info file has been opened. + (let ((manual-re (concat "\\(?:/\\|\\`\\)" comp + "\\(?:\\.\\|\\'\\)")) + (case-fold-search t)) + (cl-loop for buffer in (buffer-list) thereis + (with-current-buffer buffer + (when (and (derived-mode-p 'Info-mode) + (stringp Info-current-file) + (string-match + manual-re Info-current-file)) + (setq prefix "*") + Info-current-file)))) + (assoc-default comp helm-info--files-cache) + (helm-aif (Info-find-file comp t) + (prog1 it (push (cons comp it) helm-info--files-cache))))) + (summary (or (gethash file helm-info--files-doc-cache) + (puthash file (helm-info-file-doc file) + helm-info--files-doc-cache)))) + (list comp + (helm-aand (propertize prefix 'face 'helm-completions-detailed) + (propertize " " 'display (format "%-2s" it))) + (helm-aand (propertize summary 'face 'helm-completions-detailed) + (propertize " " 'display (concat sep it))))))) + + +;;; Completing read handlers +;; +;; +(defun helm-completing-read-default-1 + (prompt collection test require-match + init hist default _inherit-input-method + name buffer &optional cands-in-buffer exec-when-only-one alistp get-line) + "Helm `completing-read' handler not rebuilding its candidates dynamically. + +It is used usually with helm or helm-fuzzy `helm-completion-style'. +Call `helm-comp-read' with same args as `completing-read'. + +Extra optional arg CANDS-IN-BUFFER means use `candidates-in-buffer' +method which is faster. + +EXEC-WHEN-ONLY-ONE allow exiting when COLLECTION contains only one candidate. + +ALISTP is same as `helm-comp-read' :alistp slot. + +When using CANDS-IN-BUFFER, GET-LINE can be specified to exit with candidate +handling properties, see `helm-comp-read'. + +This handler should be used when candidate list doesn't need to be rebuilt +dynamically otherwise use `helm-completing-read-default-2'." + (require 'helm-command) + (let* ((history (or (car-safe hist) hist)) + (initial-input (helm-acase init + ((guard* (stringp it)) it) + ((guard* (consp it)) (car it)))) + (minibuffer-completion-table collection) + (metadata (or (completion-metadata (or initial-input "") collection test) + '(metadata))) + (afun (or (plist-get completion-extra-properties :annotation-function) + (completion-metadata-get metadata 'annotation-function))) + (afix (or (plist-get completion-extra-properties :affixation-function) + (completion-metadata-get metadata 'affixation-function))) + (category (completion-metadata-get metadata 'category)) + (sort-fn (unless (eq helm-completion-style 'helm-fuzzy) + (or + (completion-metadata-get + metadata 'display-sort-function) + (lambda (candidates) + (sort candidates #'helm-generic-sort-fn))))) + popup-info flags pref-arg pers-fn keymap) + (helm-aif (and (null category) + (assoc-default name helm-completing-read-command-categories)) + (setq metadata `(metadata (category . ,it)) + category it)) + (helm-aif (and (or (and (boundp 'completions-detailed) completions-detailed) + helm-completions-detailed) + (assoc-default category helm-completing-read-extra-metadata)) + (progn + (setq metadata it) + (setq afun (completion-metadata-get metadata 'annotation-function) + afix (completion-metadata-get metadata 'affixation-function) + ;; prefix-arg metadata is only in command-help category. + pref-arg (completion-metadata-get metadata 'prefix-arg) + pers-fn (and (completion-metadata-get metadata 'persistent-fn) + (helm-mode--get-persistent-fn name)) + popup-info (completion-metadata-get metadata 'popup-info-function) + flags (completion-metadata-get metadata 'flags)))) + (setq keymap (if pref-arg + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-comp-read-map) + (define-key map (kbd "C-u") 'helm-M-x-universal-argument) + map) + helm-comp-read-map) + prompt (if pref-arg + (concat (helm-acase helm-M-x-prefix-argument + (- "-") + ;; Why &rest? isn't this always a list of one arg? + ((dst* (l &rest args)) + (if (eq l 4) "C-u " (format "%d " l))) + ((guard* (integerp it)) (format "%d " it))) + prompt) + prompt) + helm--mode-line-display-prefarg pref-arg) + (when pref-arg + (setq helm-M-x--timer (run-at-time 1 0.1 #'helm-M-x--notify-prefix-arg)) + (add-hook 'helm-move-selection-after-hook + #'helm-M-x--move-selection-after-hook) + (add-hook 'helm-before-action-hook + #'helm-M-x--before-action-hook) + ;; Notify C-u entered before Hitting M-[xX]. + (setq helm-M-x-prefix-argument current-prefix-arg) + (setq current-prefix-arg nil) + ;; Remove command-execute advice when execute-extended-command exit. + (advice-add 'execute-extended-command :around #'helm--advice-execute-extended-command)) + (unwind-protect + (prog1 + (helm-comp-read + prompt collection + :test test + :keymap keymap + :history history + :reverse-history helm-mode-reverse-history + :input-history history + :must-match require-match + :alistp alistp + :diacritics helm-mode-ignore-diacritics + :help-message #'helm-comp-read-help-message + :persistent-action pers-fn + :persistent-help (if pers-fn (format "Toggle %s" name) "DoNothing") + :name name + :requires-pattern (if (and (stringp default) + (string= default "") + (memq require-match + '(confirm confirm-after-completion))) + 1 0) + :fc-transformer + ;; When afun afix and category are nil + ;; helm-completion--decorate returns + ;; candidates (COMPS) unmodified. + (append (list (lambda (candidates _source) + (helm-completion--decorate + (if (and sort-fn (> (length helm-pattern) 0)) + (funcall sort-fn candidates) + candidates) + afun afix category))) + '(helm-cr-default-transformer)) + :popup-info popup-info + :quit-when-no-cand (eq require-match t) + :nomark (null helm-comp-read-use-marked) + :candidates-in-buffer cands-in-buffer + :get-line (or get-line #'buffer-substring) + :exec-when-only-one exec-when-only-one + :fuzzy (eq helm-completion-style 'helm-fuzzy) + :buffer buffer + ;; If DEF is not provided, fallback to empty string + ;; to avoid `thing-at-point' to be appended on top of list + :default (or default "") + ;; Fail with special characters (e.g in gnus "nnimap+gmail:") + ;; if regexp-quote is not used. + ;; when init is added to history, it will be unquoted by + ;; helm-comp-read. + :initial-input initial-input) + (when pref-arg + (advice-add 'command-execute :around #'helm--advice-command-execute))) + (when pref-arg (helm-M-x--unwind-forms)) + (dolist (f flags) (set f nil))))) + +(defun helm-mode--get-persistent-fn (name) + "Return a lambda to use in symbol-help persistent-action for NAME." + (lambda (candidate) + (helm-elisp--persistent-help + candidate + (helm-acase name + ("describe-symbol" 'helm-describe-symbol) + ("describe-variable" 'helm-describe-variable) + (t 'helm-describe-function))))) + +(defun helm--advice-command-execute (old--fn &rest args) + (helm-M-x--unwind-forms 'done) + ;; `command-execute' is wrapped in a let with `prefix-arg' bound to the argument + ;; PREFIXARG of `execute-extended-command' so set this let-bounded `prefix-arg' + ;; to the value defined during helm completion. We use + ;; helm-M-x-prefix-argument instead of initial PREFIXARG to allow changing the + ;; initial prefix arg during helm completion e.g. C-u M-X foo C-u 2 foo, in + ;; this case the initial C-u is replaced by C-u 2. + (setq prefix-arg (or helm-current-prefix-arg helm-M-x-prefix-argument)) + (apply old--fn args)) + +(defun helm--advice-execute-extended-command (old--fn &rest args) + (prog1 (apply old--fn args) + (advice-remove 'command-execute 'helm--advice-command-execute))) + +(defun helm-completing-read-default-2 + (prompt collection predicate require-match + init hist default _inherit-input-method + name buffer &optional _cands-in-buffer exec-when-only-one) + "Helm `completing-read' handler with dynamic matching. + +Call `helm-comp-read' with same args as `completing-read'. +For the meaning of optional args see `helm-completing-read-default-1'. +This handler uses dynamic matching which allows honouring `completion-styles'." + (let* ((completion-lazy-hilit t) + (history (or (car-safe hist) hist)) + (input (helm-acase init + ((guard* (stringp it)) it) + ((guard* (consp it)) (car it)))) + (completion-flex-nospace t) + (minibuffer-completion-table collection) + ;; (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))) + (afix (or (plist-get completion-extra-properties :affixation-function) + (completion-metadata-get metadata 'affixation-function))) + (category (completion-metadata-get metadata 'category)) + (compfn (lambda (str _predicate _action) + (let* ((completion-ignore-case (helm-set-case-fold-search)) + ;; Use a copy of metadata to avoid accumulation of + ;; adjustment in metadata (This is not needed in + ;; emacs-31+, it has been fixed in emacsbug + ;; #74718). This also avoid the flex adjustment fn + ;; reusing the previous sort fn. + (md (copy-sequence metadata)) + (comps + (completion-all-completions + str ; This is helm-pattern + collection + predicate + (length str) + md)) + (last-data (last comps)) + ;; Helm style sort fn is added to metadata only in + ;; emacs-27 by adjustment , so in 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) + (or + ;; Emacs-27+ + (completion-metadata-get + md 'display-sort-function) + ;; Emacs-26 + (lambda (candidates) + (sort candidates #'helm-generic-sort-fn))))) + all) + (when (cdr last-data) + ;; Remove the last element of + ;; comps by side-effect. + (setcdr last-data nil)) + (setq helm-completion--sorting-done (and sort-fn t)) + (setq all (copy-sequence comps)) + ;; Default is passed here only with helm + ;; h-c-styles, otherwise with emacs style it is + ;; passed with the :default arg of helm-comp-read + ;; and computed in its get-candidates function. + (append (and default + (memq helm-completion-style '(helm helm-fuzzy)) + (list default)) + (if (and sort-fn (> (length str) 0)) + (funcall sort-fn all) + all))))) + (data (if (memq helm-completion-style '(helm helm-fuzzy)) + (funcall compfn (or input "") nil nil) + compfn)) + (helm-completion-in-region-default-sort-fn + (lambda (candidates _source) + (if (or helm-completion--sorting-done + (string= helm-pattern "")) + candidates + (sort candidates 'helm-generic-sort-fn)))) + popup-info flags) + (helm-aif (and (null category) + (assoc-default name helm-completing-read-command-categories)) + (setq metadata `(metadata (category . ,it)) + category it)) + (helm-aif (and (or (and (boundp 'completions-detailed) completions-detailed) + helm-completions-detailed) + (assoc-default category helm-completing-read-extra-metadata)) + (progn + (setq metadata it) + (setq afun (completion-metadata-get metadata 'annotation-function) + afix (completion-metadata-get metadata 'affixation-function) + popup-info (completion-metadata-get metadata 'popup-info-function) + flags (completion-metadata-get metadata 'flags)))) + (unwind-protect + (helm-comp-read + ;; Completion-at-point and friends have no prompt. + prompt + data + :name name + :initial-input input + :buffer buffer + :history history + :nomark (null helm-comp-read-use-marked) + :reverse-history helm-mode-reverse-history + ;; If DEF is not provided, fallback to empty string + ;; to avoid `thing-at-point' to be appended on top of list. + ;; FIXME: default is added first in the collection fn, and then it is + ;; added here and appended to candidates with the get candidates fn of + ;; helm-comp-read, later when sorting default may move somewhere + ;; whereas it has to stay on top. + :default (or default "") + :fc-transformer + ;; When afun afix and category are nil + ;; helm-completion--decorate returns + ;; candidates (COMPS) unmodified and + ;; helm-completion-in-region-default-sort-fn returns + ;; its candidates unmodified when sorting is already done. + (append (list (lambda (candidates source) + (helm-completion--decorate + ;; When `helm-completion-in-region-default-sort-fn' is + ;; nil use CANDIDATES unmodified (bug #2689). + (if helm-completion-in-region-default-sort-fn + (funcall helm-completion-in-region-default-sort-fn + candidates source) + candidates) + afun afix category))) + '(helm-cr-default-transformer)) + :popup-info popup-info + :match-dynamic (eq helm-completion-style 'emacs) + :diacritics helm-mode-ignore-diacritics + :fuzzy (eq helm-completion-style 'helm-fuzzy) + :exec-when-only-one exec-when-only-one + :quit-when-no-cand (eq require-match t) + :must-match require-match) + (setq helm-completion--sorting-done nil) + (dolist (f flags) (set f nil))))) + +(defun helm-mode-all-the-icons-handler (prompt collection test require-match + init hist default inherit-input-method + name buffer) + "Helm `completing-read' handler for `all-the-icons-insert'." + (let* ((max-len 0) + sname + (cands (cl-loop for (desc . str) in collection + ;; When the FAMILY argument is passed to + ;; `all-the-icons-insert' DESC is the name of icon only + ;; otherwise it is "name [family]" with unpredictable + ;; spaces or tab numbers between name and [family]. + for descnp = (substring-no-properties desc) + for sdesc = (if (string-match + "\\(.*\\)[[:blank:]]+\\(\\[.*\\]\\)" descnp) + ;; This is all-the-icons-insert function. + (match-string 1 descnp) + ;; This is one of + ;; all-the-icons-insert- + ;; functions, extract the family name. + (prog1 descnp + (unless sname + (setq sname (plist-get + (get-text-property + 0 'font-lock-face + (get-text-property 0 'display desc)) + :family))))) + for sdesc2 = (match-string 2 descnp) + do (setq max-len (max max-len (string-width sdesc))) + collect (cons (concat sdesc " " str " " sdesc2) desc))) + (fn (lambda () + (with-helm-buffer + (save-excursion + (goto-char (point-min)) + (helm-skip-header-and-separator-line 'next) + (while (re-search-forward "^[[:alnum:]_-]+" nil t) + (insert (make-string (- max-len (current-column)) ? ))))))) + (helm-after-update-hook (append helm-after-update-hook `(,fn)))) + (helm-completing-read-default-1 prompt cands test require-match + init hist default inherit-input-method + (or sname name) buffer t nil t 'buffer-substring))) + +(defun helm-completing-read-default-find-tag + (prompt collection test require-match + init hist default inherit-input-method + name buffer) + "Helm `completing-read' handler for `find-tag'." + ;; Some commands like find-tag may use `read-file-name' from inside + ;; the calculation of collection. in this case it clash with + ;; candidates-in-buffer that reuse precedent data (files) which is wrong. + ;; So (re)calculate collection outside of main helm-session. + (let* ((cands (helm-comp-read-get-candidates + collection test nil nil))) + (helm-completing-read-default-1 prompt cands test require-match + init hist default inherit-input-method + name buffer t))) + +(defun helm-completing-read-sync-default-handler + (prompt collection test require-match + init hist default inherit-input-method + name buffer) + "Helm `completing-read' handler using sync source as backend." + (helm-completing-read-default-1 prompt collection test require-match + init hist default inherit-input-method + name buffer)) + +(defun helm-completing-read-inbuffer-default-handler + (prompt collection test require-match + init hist default inherit-input-method + name buffer) + "Helm `completing-read' handler using inbuffer source as backend." + (helm-completing-read-default-1 prompt collection test require-match + init hist default inherit-input-method + name buffer t)) + +(defun helm-completing-read-default-handler + (prompt collection test require-match + init hist default inherit-input-method + name buffer) + "Default Helm `completing-read' handler. + +Use either `helm-completing-read-default-1' or `helm-completing-read-default-2' +according to `helm-completion-style'." + (let* (;; Standard will be used as CANDS-IN-BUFFER arg. + (standard (and (memq helm-completion-style '(helm helm-fuzzy)) t)) + (fn (if standard + #'helm-completing-read-default-1 + #'helm-completing-read-default-2))) + (funcall fn + prompt collection test require-match + init hist default inherit-input-method name buffer + ;; CANDS-IN-BUFFER + standard))) + +(defun helm-mode--read-buffer-to-switch (prompt) + "[INTERNAL] This is used to advice `read-buffer-to-switch'. +Don't use it directly." + ;; `read-buffer-to-switch' is passing `minibuffer-completion-table' + ;; to `read-buffer' through `minibuffer-setup-hook' which is too + ;; late to be known by `read-buffer-function', in our case + ;; `helm--generic-read-buffer'. It should let bind it to allow us + ;; using it. + (let ((minibuffer-completion-table (internal-complete-buffer-except))) + (read-buffer prompt (other-buffer (current-buffer)) + (confirm-nonexistent-file-or-buffer)))) + +(defun helm--generic-read-buffer (prompt &optional default require-match predicate) + "The `read-buffer-function' for `helm-mode'. +Affects `switch-to-buffer' `kill-buffer' and related." + ;; `read-buffer' is using internally `Vbuffer_alist' which is an + ;; alist with elements like (BUF-NAME . BUF-OBJ), therefore some + ;; predicates in Emacs are working only on such cons cells. + ;; However, helm is transforming COLLECTION in a list of strings and + ;; such predicates are failing because they expect cons cells (see + ;; bug#2506 with `project-switch-to-buffer'), even if they should + ;; handle strings as well according to `read-buffer' + ;; documentation. + (let ((pred (when predicate + (lambda (buffer) + (let ((buf (cons buffer (get-buffer buffer)))) + (condition-case _err + (funcall predicate buffer) + (wrong-type-argument + (funcall predicate buf)))))))) + (helm--completing-read-default + prompt (or minibuffer-completion-table + (internal-complete-buffer "" nil t)) + pred require-match nil nil default))) + +(defun helm-mode--get-default-handler-for (comp-or-file entry) + ;; Use 'comp for completing-read and 'file for 'read-file-name as + ;; COMP-OR-FILE value. + (let ((val (cdr-safe entry)) + (reading-file (eq comp-or-file 'file))) + (if (consp val) + (helm-acase (if reading-file (cadr val) (car val)) + (default (if reading-file + #'helm-read-file-name + #'helm-completing-read-default-handler)) + (t it)) + val))) + +(defun helm-mode--apply-helm-handler (handler arg-list) + "Ensure `minibuffer-complete' is disabled when running HANDLER. +ARG-LIST is a list of arguments to pass to HANDLER." + ;; Some functions are calling `minibuffer-complete' + ;; within `minibuffer-setup-hook' when calling their + ;; `completing-read', like `woman-file-name' (bug #2527). + ;; This defeat Helm which is already + ;; completing minibuffer, so deactivate + ;; minibuffer-complete one time for all [1]. + (cl-letf (((symbol-function 'minibuffer-complete) #'ignore)) + (apply handler arg-list))) + +(cl-defun helm--completing-read-default + (prompt collection &optional + predicate require-match + initial-input hist def + inherit-input-method) + "An helm replacement of `completing-read'. +This function should be used only as a `completing-read-function'. + +Don't use it directly, use instead `helm-comp-read' in your programs. + +See documentation of `completing-read' and `all-completions' for details." + (let* ((current-command (or (helm-this-command) this-command)) + (str-command (if current-command + (helm-symbol-name current-command) + "completing-read")) + (buf-name (format "*helm-mode-%s*" str-command)) + (entry (assq current-command + helm-completing-read-handlers-alist)) + (def-com (helm-mode--get-default-handler-for 'comp entry)) + (str-defcom (and def-com (helm-symbol-name def-com))) + (def-args (list prompt collection predicate + (helm-aif (assq current-command + helm-comp-read-require-match-overrides) + (cdr it) require-match) + initial-input hist def inherit-input-method)) + ;; Append the two extra args needed to set the buffer and source name + ;; in helm specialized functions. + (others-args (append def-args (list str-command buf-name))) + helm-completion-mode-start-message ; Be quiet + helm-completion-mode-quit-message + ;; Be sure this pesty *completion* buffer doesn't popup. + ;; Note: `minibuffer-with-setup-hook' may setup a lambda + ;; calling `minibuffer-completion-help' or other minibuffer + ;; functions we DONT WANT here, in these cases removing the hook + ;; (a symbol) have no effect. Bug#448. + ;; Because `minibuffer-completion-table' and + ;; `minibuffer-completion-predicate' are not bound + ;; anymore here, these functions should have no effect now, + ;; except in some rare cases like in `woman-file-name', + ;; so remove all incompatible functions + ;; from `minibuffer-setup-hook' (Bug#1205, Bug#1240). + ;; otherwise helm have not the time to close its initial session. + (minibuffer-setup-hook + (cl-loop for h in minibuffer-setup-hook + ;; lambdas are no more represented as list in + ;; Emacs-29+ Bug#2666. + unless (or (and (not (symbolp h)) (functionp h)) ; a lambda. + (byte-code-function-p h) + (helm-subr-native-elisp-p h) + (memq h helm-mode-minibuffer-setup-hook-black-list)) + collect h)) + ;; Disable hack that could be used before `completing-read'. + ;; i.e (push ?\t unread-command-events). + unread-command-events + ;; Let-bounding here helm-completion-style according to + ;; helm-completion-styles-alist allow using helm style per commands. + (helm-completion-style (helm-aif (cdr (assq current-command helm-completion-styles-alist)) + (if (cdr-safe it) (car it) it) + (default-value 'helm-completion-style))) + (completion-styles + (helm--prepare-completion-styles current-command)) + (default-handler + ;; If nothing is found in + ;; helm-completing-read-handlers-alist use default + ;; handler which will itself use `helm-completion-style'. + #'helm-completing-read-default-handler)) + (when (eq def-com 'ido) (setq def-com 'ido-completing-read)) + (unless (or (not entry) def-com) + ;; An entry in *read-handlers-alist exists but have + ;; a nil value, so we exit from here, disable `helm-mode' + ;; and run the command again with it original behavior. + ;; `helm-mode' will be restored on exit. + (cl-return-from helm--completing-read-default + (unwind-protect + (progn + (helm-mode -1) + (apply completing-read-function def-args)) + (helm-mode 1)))) + ;; If we use now `completing-read' we MUST turn off `helm-mode' + ;; to avoid infinite recursion and CRASH. It will be reenabled on exit. + (when (or (eq def-com 'completing-read) + ;; All specialized functions are prefixed by "helm" + (and (stringp str-defcom) + (not (string-match "^helm" str-defcom)))) + (helm-mode -1)) + (unwind-protect + (cond (;; An helm specialized function exists, run it. + (and def-com helm-mode) + ;; Disable `minibuffer-complete' for handlers using + ;; helm (bug #2533). + (helm-mode--apply-helm-handler + def-com others-args)) + (;; Try to handle `ido-completing-read' everywhere. + (and def-com (eq def-com 'ido-completing-read)) + (setcar (memq collection def-args) + (all-completions "" collection predicate)) + (apply def-com def-args)) + (;; A non helm function specified in + ;; `helm-completing-read-handlers-alist' use it with + ;; exactly the same args as in `completing-read'. If + ;; we are here `helm-mode' is now disabled. + def-com + (apply def-com def-args)) + (;; Use by default a in-buffer handler unless + ;; COLLECTION is a function. + t + ;; Disable `minibuffer-complete' for handlers using + ;; helm (bug #2533). + (helm-mode--apply-helm-handler + default-handler others-args))) + (helm-mode 1) + ;; When exiting minibuffer, `this-command' is set to + ;; `helm-exit-minibuffer', which is unwanted when starting + ;; on another `completing-read', so restore `this-command' to + ;; initial value when exiting. + (setq this-command current-command)))) + +;;; Generic read-file-name +;; +;; +;;;###autoload +(cl-defun helm-read-file-name + (prompt + &key + (name "Read File Name") + initial-input + (buffer "*Helm file completions*") + test + noret + (case-fold helm-file-name-case-fold-search) + preselect + history + must-match + (fuzzy t) + default + marked-candidates + all-marked + (candidate-number-limit helm-ff-candidate-number-limit) + nomark + (alistp t) + (persistent-action-if 'helm-find-files-persistent-action-if) + (persistent-help "Hit1 Expand Candidate, Hit2 or (C-u) Find file") + (mode-line helm-read-file-name-mode-line-string)) + "Read a file name with helm completion. + +It is helm `read-file-name' emulation. + +Argument PROMPT is the default prompt to use. + +Keys description: + +- NAME: Source name, default to \"Read File Name\". + +- INITIAL-INPUT: Where to start reading file name, + default to `default-directory' or $HOME. + +- BUFFER: `helm-buffer' name, defaults to \"*Helm Completions*\". + +- TEST: A predicate called with one arg \\='candidate'. + +- NORET: Allow disabling helm-ff-RET (have no effect if helm-ff-RET + isn't bound to RET). + +- CASE-FOLD: Same as `helm-case-fold-search'. + +- PRESELECT: helm preselection. + +- HISTORY: Display HISTORY in a special source. + +- MUST-MATCH: Can be \\='confirm, nil, or t. + +- FUZZY: Enable fuzzy matching when non-nil (Enabled by default). + +- MARKED-CANDIDATES: When non--nil return a list of marked candidates + otherwise a single filename is returned. + +- ALL-MARKED: Allow marking several dummy candidates. + +- NOMARK: When non--nil don't allow marking candidates. + +- ALISTP: Don't use `all-completions' in history + (take effect only on history). + +- PERSISTENT-ACTION-IF: a persistent if action function. + +- PERSISTENT-HELP: persistent help message. + +- MODE-LINE: A mode line message, default is + `helm-read-file-name-mode-line-string'." + (require 'tramp) + (unless initial-input + (setq initial-input (or default-directory (getenv "HOME")))) + (when (get-buffer helm-action-buffer) + (kill-buffer helm-action-buffer)) + (mapc (lambda (hook) + (add-hook 'helm-after-update-hook hook)) + '(helm-ff-update-when-only-one-matched + helm-ff-auto-expand-to-home-or-root)) + (let* ((action-fn `(("Sole action (Identity)" + . ,(lambda (candidate) + (if marked-candidates + (helm-marked-candidates + :with-wildcard t :all-sources all-marked) + (identity candidate)))))) + ;; Be sure we don't erase the underlying minibuffer if some. + (helm-ff-auto-update-initial-value + (and helm-ff-auto-update-initial-value + (not (minibuffer-window-active-p (minibuffer-window))))) + helm-follow-mode-persistent + (helm-ff-fuzzy-matching + (and fuzzy + (not (memq helm-mm-matching-method '(multi1 multi3p))))) + (hist (and history (helm-comp-read-get-candidates + history nil nil alistp))) + (helm-ff--RET-disabled noret) + (minibuffer-completion-predicate test) + ;; Since Emacs-30+ `minibuffer-completing-file-name' affect + ;; `file-directory-p' in that it returns `t' when testing e.g. "/ssh" + ;; which is not a directory, as a result we end up with error in + ;; `helm-find-files-get-candidates' when minibuffer contains only + ;; "/ssh" so we use now our own variable + ;; `helm--minibuffer-completing-file-name'. See emacsbug 74191. + (helm--minibuffer-completing-file-name t) + ;; Ensure not being prompted for password each time we + ;; navigate to a directory. + (password-cache t) + (helm--completing-file-name t) + (helm-read-file-name-mode-line-string + (replace-regexp-in-string "helm-maybe-exit-minibuffer" + "helm-confirm-and-exit-minibuffer" + helm-read-file-name-mode-line-string)) + (dummy-src + (unless (eq must-match t) + ;; Non existing file or dir source. + (helm-build-dummy-source "New file or directory" + :keymap helm-read-file-map + :must-match must-match ; Merge must-match-map and helm-read-file-map. + :all-marked all-marked + :nomark nomark + :filtered-candidate-transformer + (lambda (_candidates _source) + (unless (file-exists-p helm-pattern) + (list (helm-ff-filter-candidate-one-by-one + helm-pattern nil t)))) + :action action-fn))) + (src-list + (list + ;; History source. + (helm-build-sync-source (format "%s History" name) + :header-name (lambda (name) + (concat name (substitute-command-keys + helm-find-files-doc-header))) + :mode-line mode-line + :candidates hist + :nohighlight t + :fuzzy-match fuzzy + :persistent-action-if persistent-action-if + :persistent-help persistent-help + :keymap helm-read-file-map + :nomark nomark + :action action-fn) + ;; List files source. + (helm-build-sync-source name + :header-name (lambda (name) + (concat name (substitute-command-keys + helm-find-files-doc-header))) + :init (lambda () + (setq helm-ff-auto-update-flag + helm-ff-auto-update-initial-value) + (setq helm-ff--auto-update-state + helm-ff-auto-update-flag)) + :mode-line mode-line + :help-message 'helm-read-file-name-help-message + :nohighlight helm-ff-nohighlight-matches + :candidate-number-limit 'helm-ff-candidate-number-limit + :candidates + (lambda () + (if test + (cl-loop with hn = (helm-ff--tramp-hostnames) + ;; helm-find-files-get-candidates is + ;; returning a list of cons cells. + for (d . r) in (helm-find-files-get-candidates) + when (or (member r hn) ; A tramp host + (funcall test r)) ; Test ok + collect (cons d r)) + (helm-find-files-get-candidates))) + :update (lambda () + (remhash helm-ff-default-directory + helm-ff--list-directory-cache)) + :match-on-real t + :match (unless helm-find-files-ignore-diacritics + 'helm-mm-3f-match) + :diacritics (and helm-find-files-ignore-diacritics + 'helm-mm-3f-match-on-diacritics) + :filtered-candidate-transformer '(helm-ff-fct + helm-ff-maybe-show-thumbnails + helm-ff-sort-candidates) + :all-marked all-marked + :persistent-action-if persistent-action-if + :persistent-help persistent-help + :volatile t + ;; Because we don't use :must-match in this source, + ;; helm-read-file-map is NOT merged with must-match map, this to + ;; not override helm-ff-RET, so MUST-MATCH == t is handled by + ;; helm-ff-RET, otherwise the dummy source enter in action and + ;; handle the other possible values of MUST-MATCH. + :keymap helm-read-file-map + :cleanup 'helm-find-files-cleanup + :nomark nomark + :action action-fn))) + ;; Helm result. + (result (helm + :sources (append (if helm-mode-reverse-history + (reverse src-list) src-list) + (list dummy-src)) + :input (if (string-match helm-ff-url-regexp initial-input) + initial-input + (expand-file-name initial-input)) + :prompt prompt + :candidate-number-limit candidate-number-limit + :dim-prompt-on-update t + :resume 'noresume + :case-fold-search case-fold + :default default + :buffer buffer + :full-frame nil + :preselect preselect)) + (helm-mm-matching-method 'multi3f)) + (or + (cond ((and result (stringp result) + (string= result "") "")) + ((and result + (stringp result) + (file-equal-p result initial-input) + helm-read-file-name-use-default-arg-behavior + default) + (if (listp default) (car default) default)) + ((and result (listp result)) + (mapcar #'expand-file-name result)) + ((and result (file-directory-p result)) + (file-name-as-directory (expand-file-name result))) + (result (expand-file-name result))) + (helm-mode--keyboard-quit)))) + +(defun helm-mode--default-filename (fname dir initial) + (unless dir (setq dir default-directory)) + (unless (file-name-absolute-p dir) + (setq dir (expand-file-name dir))) + (unless (or fname (consp fname)) + (setq fname (expand-file-name + (or initial buffer-file-name dir) + dir))) + ;; completing-read default maybe a list of defaults. + (if (and fname (consp fname)) + (cl-loop for f in fname + collect (helm-mode--resolve-fname f dir)) + (helm-mode--resolve-fname fname dir))) + +(defun helm-mode--resolve-fname (fname dir) + (if (file-name-absolute-p fname) + (if (file-remote-p fname) + fname + (substitute-in-file-name + (concat (helm-mode-root-dir dir) fname))) + (expand-file-name fname dir))) + +(defun helm-mode-root-dir (dir) + (if (file-remote-p dir) + (let* ((host (file-remote-p dir 'host)) + (method (file-remote-p dir 'method)) + (user (file-remote-p dir 'user))) + (format "/%s:%s@%s:/" method user host)) + "/")) + +(cl-defun helm--generic-read-file-name + (prompt &optional dir default-filename mustmatch initial predicate) + "Generic helm replacement of `read-file-name'. +Don't use it directly, use instead `helm-read-file-name' in your programs." + (let* ((init (or initial dir default-directory)) + (helm-read-file-name-use-default-arg-behavior t) + (current-command (or (helm-this-command) this-command)) + (str-command (if current-command + (helm-symbol-name current-command) + "read-file-name")) + (helm--file-completion-sources + (cons str-command + (remove str-command helm--file-completion-sources))) + (buf-name (format "*helm-mode-%s*" str-command)) + (entry (assq current-command + helm-completing-read-handlers-alist)) + (def-com (helm-mode--get-default-handler-for 'file entry)) + (str-defcom (and def-com (helm-symbol-name def-com))) + ;; Don't modify the original args list for emacs generic functions. + (def-args (list prompt dir default-filename mustmatch initial predicate)) + ;; Append the two extra args needed to set the buffer and source name + ;; in helm specialized functions. + (others-args (append def-args (list str-command buf-name))) + (reading-directory (eq predicate 'file-directory-p)) + (use-dialog (and (next-read-file-uses-dialog-p) + ;; Graphical file dialogs can't handle + ;; remote files. + (not (file-remote-p init)) + use-file-dialog)) + helm-completion-mode-start-message ; Be quiet + helm-completion-mode-quit-message ; Same here + add-to-history fname) + ;; Build `default-filename' with `dir'+`initial' when + ;; `default-filename' is not specified. + ;; See `read-file-name' docstring for more infos. + (setq default-filename (helm-mode--default-filename + default-filename dir initial)) + ;; Some functions that normally call `completing-read' can switch + ;; brutally to `read-file-name' (e.g find-tag), in this case + ;; the helm specialized function will fail because it is build + ;; for `completing-read', so set it to 'incompatible to be sure + ;; we switch to `helm-read-file-name' and don't try to call it + ;; with wrong number of args. + (when (eq def-com 'ido) + (setq def-com 'ido-read-file-name)) + (when (and def-com (> (length (help-function-arglist def-com)) 8)) + (setq def-com 'incompatible)) + (unless (or (not entry) def-com) + (cl-return-from helm--generic-read-file-name + (unwind-protect + (progn + (helm-mode -1) + (apply read-file-name-function def-args)) + (helm-mode 1)))) + ;; If we use now `read-file-name' or dialog we MUST turn off `helm-mode' + ;; to avoid infinite recursion and CRASH. It will be reenabled on exit. + (when (or (memq def-com '(read-file-name ido-read-file-name)) + use-dialog + (and (stringp str-defcom) + (not (string-match "^helm" str-defcom)))) + (helm-mode -1)) + (unwind-protect + (setq fname + (cond (use-dialog + (let ((dialog-mustmatch + (not (memq mustmatch + '(nil confirm confirm-after-completion))))) + ;; Dialogs don't support a list of default fnames. + (when (and default-filename (consp default-filename)) + (setq default-filename + (expand-file-name (car default-filename) init))) + (setq add-to-history t) + (x-file-dialog prompt init default-filename + dialog-mustmatch + reading-directory))) + ;; A specialized function exists, run it + ;; with the two extra args specific to helm. + ;; Note that the helm handler should ensure + ;; :initial-input is not nil i.e. Use init + ;; which fallback to default-directory instead + ;; of INITIAL. + ((and def-com helm-mode + (not (eq def-com 'ido-read-file-name)) + (not (eq def-com 'incompatible)) + ;; The entry in + ;; `helm-completing-read-handlers-alist' is + ;; a cons cell specifying a completing-read + ;; and a read-file-name handler default + ;; e.g. (foo (default default)). + (not (eq def-com 'helm-read-file-name))) + (apply def-com others-args)) + (;; Def-com value is `ido-read-file-name' + ;; run it with default args. + (and def-com (eq def-com 'ido-read-file-name)) + (ido-mode 1) + (apply def-com def-args)) + (;; Def-com value is `read-file-name' + ;; run it with default args. + (eq def-com 'read-file-name) + (apply def-com def-args)) + (t ; Fall back to classic `helm-read-file-name'. + (helm-read-file-name + prompt + :name str-command + :buffer buf-name + :default default-filename + ;; Helm handlers should always have a non nil INITIAL arg. + :initial-input (if (string-match helm-ff-url-regexp init) + init + (if (file-name-absolute-p init) + (if (file-remote-p init) + init + (substitute-in-file-name + (concat (helm-mode-root-dir + (or dir init)) + init))) + (expand-file-name init dir))) + :alistp nil + :nomark (null helm-comp-read-use-marked) + :marked-candidates helm-comp-read-use-marked + :must-match mustmatch + :test predicate + :noret reading-directory)))) + (and ido-mode (ido-mode -1)) + (helm-mode 1) + ;; Same comment as in `helm--completing-read-default'. + (setq this-command current-command)) + (when add-to-history + (add-to-history 'file-name-history + (minibuffer-maybe-quote-filename fname))) + (if (and + ;; Using `read-directory-name'. + reading-directory + ;; `file-name-as-directory' return "./" when FNAME is + ;; empty string. + (not (string= fname ""))) + (file-name-as-directory fname) + fname))) + +;; Read file name handler with history (Bug#1652) +(defun helm-read-file-name-handler-1 (prompt dir default-filename + mustmatch initial predicate + name buffer) + "A `read-file-name' handler with history. +Can be added to `helm-completing-read-handlers-alist' for functions +that need a `read-file-name' function with directory history. +The `helm-find-files' history `helm-ff-history' is used here." + (let ((helm-always-two-windows t) + (helm-split-window-default-side + (if (eq helm-split-window-default-side 'same) + 'below helm-split-window-default-side)) + helm-reuse-last-window-split-state + ;; Helm handlers should always have a non nil INITIAL arg. + (init (or initial dir default-directory))) + (helm-read-file-name + prompt + :name name + :history helm-ff-history + :buffer buffer + :default default-filename + :initial-input (expand-file-name init dir) + :alistp nil + :must-match mustmatch + :test predicate))) + + +;;; Completion in region and Helm style +;; +(defun helm-mode--advice-lisp--local-variables (old--fn &rest args) + (ignore-errors + (apply old--fn args))) + +(defvar helm-completion--sorting-done nil + "Flag that notifies the FCT if sorting has been done in completion function.") +(defun helm-completion-in-region-sort-fn (candidates _source) + "Default sort function for completion-in-region." + (if helm-completion--sorting-done + candidates + (sort candidates 'helm-generic-sort-fn))) + +(defun helm-mode--completion-in-region-initial-input (str) + "Highlight prefix in helm and helm-fuzzy `helm-completion-styles'." + (if (memq helm-completion-style '(helm helm-fuzzy)) + (propertize str 'read-only t 'face 'helm-mode-prefix 'rear-nonsticky t) + str)) + +(defun helm-completion--decorate (comps afun afix category) + "Decorate COMPS with function AFIX or AFUN. + +When CATEGORY is file or library remove dot files from COMPS. + +If both AFUN and AFIX are provided, AFIX takes precedence. + +When AFUN, AFIX are nil and CATEGORY is not file return COMPS unmodified." + ;; Normally COMPS should be a list of + ;; string but in some cases it is given as a list of strings containing a list + ;; of string e.g. ("a" "b" "c" ("d" "e" "f")) ; This happen in rgrep + ;; (bug#2607) and highlight-* fns (bug #2610), so ensure the list is flattened to + ;; avoid e.g. wrong-type argument: stringp '("d" "e" "f") + ;; FIXME: If this create a new bug with completion-in-region, flatten COMPS + ;; directly in the caller i.e. helm-completing-read-default-1. + (when (or afix afun (memq category '(file library))) + (setq comps (helm-fast-remove-dups + (helm-flatten-list comps) + :test 'equal))) + ;; Filter out dot files in file completion. + ;; We were previously exiting directly without handling afix and afun, but + ;; maybe some file completion tables have an afix or afun in their metadata so + ;; let them a chance to run these functions if some. + (when (memq category '(file library)) + (setq comps + (cl-loop for f in comps + unless (string-match "\\`\\.\\{1,2\\}/\\'" f) + collect f))) + (cond (afix + (let ((affixations (funcall afix comps))) + (if (functionp affixations) + (cl-loop for comp in comps + for cand = (funcall affixations comp) + when cand + collect (cons (propertize (concat (nth 1 cand) ;prefix + (nth 0 cand) ;comp + (nth 2 cand)) ;suffix + 'match-part (nth 0 cand)) + comp)) + (cl-loop for (comp prefix suffix) in affixations + collect (cons (propertize + (concat prefix comp suffix) + 'match-part comp) + comp))))) + (afun + ;; Add annotation at end of + ;; candidate if needed, e.g. foo, this happen when + ;; completing against a quoted symbol. + (mapcar (lambda (s) + (let ((ann (funcall afun s))) + (or (helm-aand + ann + (propertize ann 'face 'helm-completions-annotations) + (cons (concat s (propertize " " 'display it)) s)) + s))) + comps)) + (t comps))) + +;;;###autoload +(defun helm-dynamic-completion (collection predicate &optional point metadata nomode styles) + "Build a completion function for `helm-pattern' in COLLECTION. + +Only the elements of COLLECTION that satisfy PREDICATE are considered. + +Argument POINT is the 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 has +to be provided if needed either with an FCT function in source or +by passing the sort function with METADATA +E.g.: \\='((metadata (display-sort-function . foo))). +Candidates can be modified by passing an affixation-function in METADATA. + +If you don't want the sort fn provided by style to kick +in (emacs-27) you can use as metadata value the symbol `nosort'. + +Example: + + (helm :sources (helm-build-sync-source \"test\" + :candidates (helm-dynamic-completion + \\='(foo bar baz foab) + \\='symbolp) + :match-dynamic t) + :buffer \"*helm test*\") + +When argument NOMODE is non nil don't use `completion-styles' as +specified in `helm-completion-styles-alist' for specific modes. + +When STYLES is specified use these `completion-styles', see +`helm--prepare-completion-styles'. + +Also `helm-completion-style' settings have no effect here, +`emacs' being used inconditionally as value." + (lambda () + (let* (;; Force usage of emacs style otherwise + ;; helm--prepare-completion-styles will reset + ;; completion-styles to default value i.e. (basic partial + ;; emacs22). + (helm-completion-style 'emacs) + (completion-styles + (with-helm-current-buffer + (helm--prepare-completion-styles nomode styles))) + (completion-flex-nospace t) + (nosort (eq metadata 'nosort)) + (compsfn (lambda (str pred _action) + (let* ((completion-ignore-case (helm-set-case-fold-search)) + ;; Use a copy of metadata to avoid accumulation of + ;; adjustment in metadata (This is not needed in + ;; emacs-31+, it has been fixed in emacsbug + ;; #74718). This also avoid the flex adjustment fn + ;; reusing the previous sort fn. + (md (copy-sequence metadata)) + (comps (completion-all-completions + str + (if (functionp collection) + (funcall collection str pred t) + collection) + pred + (or point 0) + (or (and (consp md) md) + (setq metadata '(metadata))))) + (last-data (last comps)) + (sort-fn (unless nosort + (completion-metadata-get + md 'display-sort-function))) + (affix (completion-metadata-get + md 'affixation-function)) + all) + (when (cdr last-data) (setcdr last-data nil)) + (setq all (if (and sort-fn (> (length str) 0)) + (funcall sort-fn comps) + comps)) + (if affix + (helm-completion--decorate all nil affix nil) + all))))) + ;; Ensure circular objects are removed. + (complete-with-action t compsfn helm-pattern predicate)))) + +;; Helm multi matching style + +(defun helm-completion-try-completion (string table pred point) + "The try completion function for `completing-styles-alist'. +Currently does nothing." + ;; AFAIU the try-completions style functions + ;; are here to check if what is at point is suitable for TABLE but + ;; there is no way to pass a multiple pattern from what is at point + ;; apart sending STRING in a minibuffer like helm does. Perhaps + ;; minibuffer-complete should benefit of this but for now just do + ;; nothing as this is used nowhere. It is anyway not clear what the + ;; try-completions functions do in emacs so just do nothing for now. + (ignore string table pred point)) + +(defun helm-completion-all-completions (string table pred point) + "The all completions function for `completing-styles-alist'." + (cl-multiple-value-bind (all _pattern prefix _suffix _carbounds) + (helm-completion--multi-all-completions string table pred point) + (when all (nconc all (length prefix))))) + +(defun helm-completion--multi-all-completions-1 (string collection &optional predicate) + "Allow `all-completions' multi matching on its candidates." + ;; Doing an initial call of all-completions on the first element of + ;; STRING speedup completion and fix file completion when CAPF + ;; returns relative paths to initial pattern (eshell and shell). + (let* ((split (helm-mm-split-pattern string)) + (fpat (or (car split) "")) + (file-comp-p (or minibuffer-completing-file-name + (eq + (completion-metadata-get + (completion-metadata string collection predicate) + 'category) + 'file))) + (all (and file-comp-p + (or (cdr split) + (and (not (cdr split)) + ;; Kickin when STRING is a simple string. + ;; Handle as well "foo " (space at end). + (not (string= fpat ""))) + (string= string "")) + (not (string-match "\\`!" fpat)) + ;; all-completions should return nil if FPAT is a + ;; regexp, it is what we expect. + (all-completions fpat collection + (lambda (x &optional _y) + (let ((elm (if (listp x) (car x) x))) + (funcall (or predicate #'identity) elm)))))) + (pattern (helm-aand all (string-match " " string) + ;; Returns the part of STRING after space + ;; e.g. "foo bar baz" => "bar baz". + (substring string (1+ it))))) + (if (or (and all (not (cdr split))) + (equal pattern "")) ; e.g. STRING == "foo ". + all + (all-completions "" (or all collection) + (lambda (x &optional _y) + ;; Second arg _y is needed when + ;; COLLECTION is a hash-table (Bug#2231) + ;; (C-x 8 RET). + ;; Elements of COLLECTION may be + ;; lists or alists, in this case consider the + ;; car of element (Bug#2219 org-refile). + (let ((elm (if (listp x) (car x) x))) + ;; PREDICATE have been already called in + ;; initial all-completions, no need to call + ;; it a second time, thus ALL is now a list + ;; of strings maybe not supported by + ;; PREDICATE (e.g. symbols vs strings). + (if (and predicate (null all)) + (and (funcall predicate elm) + ;; ALL is nil so use whole STRING + ;; against COLLECTION. + (helm-mm-match (helm-stringify elm) string)) + (helm-mm-match (helm-stringify elm) + (or (and all pattern) string))))))))) + +(defun helm-completion--multi-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))) + (all (helm-completion--multi-all-completions-1 + ;; Using `regexp-quote' on STRING fixes bug#2355 but + ;; breaks regexp matching in multi match, currently with + ;; Helm-3.7.1 and emacs-27+ it seems using plain STRING + ;; works for both so use it. + ;;(regexp-quote string) + string table pred))) + (list all string prefix suffix point))) + +;; 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 + (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) + ,@(cl-loop for (elm . val) in (cdr metadata) + unless (memq elm '(display-sort-function cycle-sort-function)) + collect (cons elm val)))))) +(put 'helm 'completion--adjust-metadata 'helm-completion--adjust-metadata) + +;; Helm-flex style. +;; This is more or less the same as emacs-27 flex style. +(defun helm-flex-completion-try-completion (string table pred point) + "The try completion function for `completing-styles-alist'." + ;; It is needed here to make minibuffer-complete work in emacs-26, + ;; e.g. with regular M-x. + (unless (string-match-p " " string) + (cl-multiple-value-bind (all pattern prefix suffix _carbounds) + (helm-completion--flex-all-completions string table pred point) + (when minibuffer-completing-file-name + (setq all (completion-pcm--filename-try-filter all))) + (completion-pcm--merge-try pattern all prefix suffix)))) + +(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. + (unless (string-match-p " " string) + (cl-multiple-value-bind (all pattern prefix _suffix _carbounds) + (helm-completion--flex-all-completions + string table pred point + #'helm-completion--flex-transform-pattern) + (let ((regexp (completion-pcm--pattern->regex pattern 'group))) + (when all (nconc (helm-flex-add-score-as-prop all regexp) + (length prefix))))))) + +;; Same as emacs-27 completion-substring--all-completions. +(defun helm-completion--flex-all-completions + (string table pred point &optional transform-pattern-fn) + "Match the presumed substring STRING to the entries in TABLE. +Respect PRED and POINT. The pattern used is a PCM-style substring +pattern, but it will be massaged by TRANSFORM-PATTERN-FN, if that +is non-nil." + (let* ((beforepoint (substring string 0 point)) + (afterpoint (substring string point)) + (bounds (completion-boundaries beforepoint table pred afterpoint)) + (suffix (substring afterpoint (cdr bounds))) + (prefix (substring beforepoint 0 (car bounds))) + (basic-pattern (completion-basic--pattern + beforepoint afterpoint bounds)) + (pattern (if (not (stringp (car basic-pattern))) + basic-pattern + (cons 'prefix basic-pattern))) + (pattern (if transform-pattern-fn + (funcall transform-pattern-fn pattern) + pattern)) + (all (completion-pcm--all-completions prefix pattern table pred))) + (list all pattern prefix suffix (car bounds)))) + +(defun helm-completion-in-region--selection () + (with-helm-buffer + (setq helm-saved-selection (helm-get-selection nil 'withprop)))) + +;; Completion-in-region-function + +(defvar helm--completing-region nil + "[INTERNAL] flag let-bounded to nil when completing in region.") + +(defun helm--completion-in-region (origfun start end collection &optional predicate) + "Helm replacement of `completion--in-region'. + +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." + ;; This error may happen when user hits quickly twice e.g. TAB for + ;; completion-at-point which start a second time this function because the + ;; first helm-buffer with its keymap is not ready yet (this happen when helm is + ;; displayed in a frame which is slower to popup than a window). FIXME: Should + ;; I prevent this at a lower level as well? + (cl-assert (not (get-buffer-window helm-buffer 'visible)) nil + "Error: Trying to run helm while a helm session is already running") + (if (memq major-mode helm-mode-no-completion-in-region-in-modes) + (funcall origfun start end collection predicate) + (advice-add + 'lisp--local-variables + :around #'helm-mode--advice-lisp--local-variables) + (let ((old--helm-completion-style helm-completion-style) + (exit-fun (plist-get completion-extra-properties :exit-function)) + ;; 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))) + (current-command (or (helm-this-command) + this-command + ;; Some backends are async and + ;; use a callback, in those + ;; cases, we can't retrieve from + ;; frames the last interactive + ;; command, so fallback to + ;; `last-command' which may be + ;; the one that called the callback. + last-command)) + string) + (helm-aif (cdr (or (assq major-mode helm-completion-styles-alist) + (assq current-command helm-completion-styles-alist))) + (customize-set-variable 'helm-completion-style + (if (cdr-safe it) (car it) it))) + ;; This hook force usage of the display part of candidate with + ;; its properties, this is needed for lsp-mode in its + ;; :exit-function see Bug#2265. + (add-hook 'helm-before-action-hook 'helm-completion-in-region--selection) + (unwind-protect + (let* ((enable-recursive-minibuffers t) + (completion-flex-nospace t) + (helm--completing-region t) + (completion-styles (helm--prepare-completion-styles)) + (input (buffer-substring-no-properties start end)) + (prefix (and (eq helm-completion-style 'emacs) initial-input)) + (point (point)) + (crm (eq current-command 'crm-complete)) + (str-command (helm-symbol-name current-command)) + (buf-name (format "*helm-mode-%s*" str-command)) + ;; If we have a minibuffer use `minibuffer-completion-confirm' + ;; otherwise assume we use `completion-at-point' and use `t'. + (require-match (if crm minibuffer-completion-confirm t)) + (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 " where foo is a function. + ;; See Bug#407. + (afun (or (plist-get completion-extra-properties :annotation-function) + (completion-metadata-get metadata 'annotation-function))) + ;; Not sure if affixations are provided in + ;; completion-in-region, try anyway never know. + (afix (or (plist-get completion-extra-properties :affixation-function) + (completion-metadata-get metadata 'affixation-function))) + (docsig (plist-get completion-extra-properties :company-docsig)) + (helm-truncate-lines (and docsig helm-popup-tip-mode)) + (category (or (eq (completion-metadata-get metadata 'category) 'file) + (eq (plist-get completion-extra-properties :category) 'file))) + (file-comp-p (or (eq category 'file) + (helm-guess-filename-at-point))) + ;; `completion-all-completions' store the base-size in the last `cdr', + ;; so data looks like this: '(a b c d . 0) and (last data) == (d . 0). + base-size + (compfn (lambda (str _predicate _action) + (let* ((completion-lazy-hilit t) + (completion-ignore-case (helm-set-case-fold-search)) + ;; Use a copy of metadata to avoid accumulation of + ;; adjustment in metadata (This is not needed in + ;; emacs-31+, it has been fixed in emacsbug + ;; #74718). This also avoid the flex adjustment fn + ;; reusing the previous sort fn. + (md (copy-sequence metadata)) + (comps + (completion-all-completions + str ; This is helm-pattern + collection + predicate + ;; Use prefix length at first call to + ;; allow styles matching + ;; "prefix*suffix" to kick in. + (length (or prefix str)) + md)) + (last-data (last comps)) + (bs (helm-aif (cdr last-data) + (prog1 it + ;; Remove the last element of + ;; comps by side-effect. + (setcdr last-data nil)) + 0)) + ;; Helm style sort fn is added to metadata only in + ;; emacs-27 by adjustment , so in 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) + (or + ;; Emacs-27+ + (completion-metadata-get + md '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 + ;; args-out-of-range error). + (and prefix (setq prefix nil)) + ;; base-size needs to be set only once at + ;; first call. + (unless base-size (setq base-size bs)) + (setq helm-completion--sorting-done (and sort-fn t)) + (setq all (copy-sequence comps)) + (if (and sort-fn (> (length str) 0)) + (funcall sort-fn all) + all)))) + (data (if (memq helm-completion-style '(helm helm-fuzzy)) + (funcall compfn input nil nil) + compfn)) + (result (if (stringp data) + data + (helm-comp-read + ;; Completion-at-point and friends have no prompt, + ;; we have a prompt only with CRM, in this case + ;; reuse it. Handle the case where user switched out + ;; of minibuffer, leaving an active minibuffer open. + (or (and (minibufferp (current-buffer)) + (minibuffer-prompt)) + "Pattern: ") + data + :name str-command + :nomark (null crm) + :marked-candidates crm + :initial-input + (cond ((and file-comp-p + (not (string-match "/\\'" initial-input))) + (helm-mode--completion-in-region-initial-input + (if (memq helm-completion-style '(helm helm-fuzzy)) + (helm-basename initial-input) + initial-input))) + ((string-match "/\\'" initial-input) + (and (eq helm-completion-style 'emacs) initial-input)) + (t (helm-mode--completion-in-region-initial-input initial-input))) + :buffer buf-name + :fc-transformer + ;; When afun afix and category are nil + ;; helm-completion--decorate returns + ;; candidates (COMPS) unmodified and + ;; helm-completion-in-region-default-sort-fn returns + ;; its candidates unmodified when sorting is already done. + (append (list (lambda (candidates source) + (helm-completion--decorate + ;; Magit is disabling sorting in its + ;; `magit-completing-read-multiple' by let binding + ;; `helm-completion-in-region-default-sort-fn' to + ;; nil to prevent modifying candidates order (bug #2689). + (if helm-completion-in-region-default-sort-fn + (funcall helm-completion-in-region-default-sort-fn + candidates source) + candidates) + afun afix category))) + '(helm-cr-default-transformer)) + :popup-info docsig + :match-dynamic (eq helm-completion-style 'emacs) + :fuzzy (eq helm-completion-style 'helm-fuzzy) + :exec-when-only-one t + :keymap helm-comp-in-region-map + :quit-when-no-cand + (lambda () + ;; Delay message to overwrite "Quit". + (run-with-timer + 0.01 nil + (lambda () + (message "[No matches]"))) + t) ; exit minibuffer immediately. + :must-match require-match)))) + ;; `helm-completion-in-region--insert-result' is stripping + ;; out properties on RESULT by side-effect (perhaps + ;; `choose-completion-string'?) so make a copy of STRING + ;; to not loose props. + (setq string (copy-sequence result)) + (helm-completion-in-region--insert-result + result start point end base-size)) + ;; Allow running extra property `:exit-function' (Bug#2265, + ;; Bug#2356). Function is called with 'exact if the return value of + ;; `try-completion' is a string ending with / (possibly a directory + ;; Bug#2274), otherwise it is always called with 'finished. However it + ;; is still not clear what to use, the documentation on this beeing + ;; really bad (see bug#2646). + (when (and (stringp string) exit-fun) + (funcall exit-fun string + (helm-acase (try-completion initial-input collection predicate) + ((guard* (and (stringp it) + (or (string-match "/\\'" it) + ;; Fix bug#2669. + (string-match "/\\'" string)))) + 'exact) + (t 'finished)))) + (remove-hook 'helm-before-action-hook 'helm-completion-in-region--selection) + (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))))) + +(defvar helm-crm-default-separator "," + "Default separator for `completing-read-multiple'. + +`crm-separator' will take precedence on this when it is a string composed +of a single character. +If used globally, it is a string composed of a single character, +if let-bounded, it can be also nil or a symbol which mean no +separator. Don't set this to a string composed of more than one +character. +Be sure to know what you are doing when modifying this.") +(defun helm-completion-in-region--insert-result (result start point end base-size) + (cond ((stringp result) + ;; When RESULT have annotation, annotation is displayed + ;; in it with a display property attached to a space + ;; added at end of string, take care of removing this + ;; space (Bug#2360). However keep RESULT intact to + ;; pass it to `:exit-function' i.e. Don't store the + ;; modified string in STRING. + (choose-completion-string + (replace-regexp-in-string " \\'" "" result) + (current-buffer) + (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 (or (and + ;; If `crm-separator' is a string of length 1 + ;; assume it can be used as separator (Bug#2298), + ;; otherwise it is a regexp and use the value + ;; it matches or default to "," if no match. + (eq (length crm-separator) 1) + crm-separator) + (and (stringp crm-separator) + (or (get-text-property 0 'separator crm-separator) + (string-replace "[ \t]*" "" crm-separator))) + helm-crm-default-separator))) + ;; Try to find a default separator. If `crm-separator' is a + ;; regexp use the string the regexp is matching. + ;; If SEP is not a string, it have been probably bound to a + ;; symbol or nil through `helm-crm-default-separator' that serve + ;; as a flag to say "Please no separator" (Bug#2353 with + ;; `magit-completing-read-multiple'). + (if (stringp sep) + (save-excursion + (goto-char beg) + (when (looking-back crm-separator (1- (point))) + (setq sep (match-string 0)))) + (setq sep nil)) + (when (> emacs-major-version 29) + (add-function :override (local 'completion-list-insert-choice-function) + #'helm--crm-insert-fn)) + (funcall completion-list-insert-choice-function + beg end (mapconcat 'identity (append result '("")) sep)))) + (t nil))) + +(defun helm--crm-insert-fn (_start _end choice) + ;; Fix Emacs bug~76461. + (let* ((beg (save-excursion + (if (and (re-search-backward crm-separator nil t) + ;; Matches end of prompt (:) when sep is ":". + (not (field-at-pos (point)))) + (1+ (point)) + (minibuffer-prompt-end)))) + (end (save-excursion + (if (re-search-forward crm-separator nil t) + (1- (point)) + (point-max))))) + (completion--replace beg end choice))) + +(defun helm-mode--disable-ido-maybe (&optional from-hook) + (when (and (boundp 'ido-everywhere) ido-everywhere) + (remove-function read-file-name-function #'ido-read-file-name) + (remove-function read-buffer-function #'ido-read-buffer) + (setq ido-everywhere nil) + (if from-hook + (user-error "Unable to turn on Ido-everywhere while Helm-mode is enabled") + (user-error "Helm-mode enabled (Ido-everywhere is incompatible with Helm-mode, disabling it)")))) + +(defun helm-mode--ido-everywhere-hook () + ;; Called only when user calls directly ido-everywhere + ;; and helm-mode is enabled. + (when helm-mode + (helm-mode--disable-ido-maybe t))) + +;;;###autoload +(define-minor-mode helm-mode + "Toggle generic helm completion. + +All functions in Emacs that use `completing-read', +`read-file-name', `completion-in-region' and friends will use helm +interface when this mode is turned on. + +However you can modify this behavior for functions of your choice +with `helm-completing-read-handlers-alist'. + +Called with a positive arg, turn on unconditionally, with a +negative arg turn off. +You can toggle it with M-x `helm-mode'. + +About `ido-mode': +DO NOT enable `ido-everywhere' when using `helm-mode'. Instead of +using `ido-mode', add the commands where you want to use ido to +`helm-completing-read-handlers-alist' with `ido' as value. + +Note: This mode is incompatible with Emacs23." + :group 'helm-mode + :global t + :lighter helm-completion-mode-string + (cl-assert (boundp 'completing-read-function) nil + "`helm-mode' not available, upgrade to Emacs-24") + (if helm-mode + (progn + (add-function :override completing-read-function + #'helm--completing-read-default) + (add-function :override read-file-name-function + #'helm--generic-read-file-name) + (add-function :override read-buffer-function + #'helm--generic-read-buffer) + (when helm-mode-handle-completion-in-region + (add-function :around completion-in-region-function + #'helm--completion-in-region)) + ;; If user have enabled ido-everywhere BEFORE enabling + ;; helm-mode disable it and warn user about its + ;; incompatibility with helm-mode (Bug#2085). + (helm-mode--disable-ido-maybe) + ;; If ido-everywhere is not enabled yet anticipate and + ;; disable it if user attempt to enable it while helm-mode + ;; is running (Bug#2085). + (add-hook 'ido-everywhere-hook #'helm-mode--ido-everywhere-hook) + (when (fboundp 'ffap-read-file-or-url-internal) + ;; `ffap-read-file-or-url-internal' have been removed in + ;; emacs-27 and `ffap-read-file-or-url' is fixed, so no need + ;; to advice it. + (advice-add 'ffap-read-file-or-url :override #'helm-advice--ffap-read-file-or-url)) + (advice-add 'read-buffer-to-switch :override #'helm-mode--read-buffer-to-switch) + (helm-minibuffer-history-mode 1)) + (progn + (remove-function completing-read-function #'helm--completing-read-default) + (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) + (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)) + (advice-remove 'read-buffer-to-switch #'helm-mode--read-buffer-to-switch) + (helm-minibuffer-history-mode -1)))) + +(provide 'helm-mode) + +;;; helm-mode.el ends here diff --git a/elpa/helm-20260424.1357/helm-net.el b/elpa/helm-20260424.1357/helm-net.el new file mode 100644 index 00000000..61f40cae --- /dev/null +++ b/elpa/helm-20260424.1357/helm-net.el @@ -0,0 +1,469 @@ +;;; helm-net.el --- helm browse url and search web. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2026 Thierry Volpiatto + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Code: + +(require 'cl-lib) +(require 'helm) +(require 'helm-help) +(require 'url) +(require 'xml) +(require 'browse-url) + +(declare-function helm-comp-read "helm-mode") + + +(defgroup helm-net nil + "Net related applications and libraries for Helm." + :group 'helm) + +(defcustom helm-google-suggest-default-browser-function nil + "The browse url function you prefer to use with Google suggest. +When nil, use the first browser function available +See `helm-browse-url-default-browser-alist'." + :group 'helm-net + :type 'symbol) + +(defcustom helm-home-url "https://www.google.com" + "Default url to use as home url." + :group 'helm-net + :type 'string) + +(defcustom helm-surfraw-default-browser-function nil + "The browse url function you prefer to use with surfraw. +When nil, fallback to `browse-url-browser-function'." + :group 'helm-net + :type 'symbol) + +(defcustom helm-google-suggest-url + "https://encrypted.google.com/complete/search?output=toolbar&q=%s" + "URL used for looking up Google suggestions. +This is a format string, don't forget the `%s'." + :type 'string + :group 'helm-net) + +(defcustom helm-google-suggest-search-url + "https://encrypted.google.com/search?ie=utf-8&oe=utf-8&q=%s" + "URL used for Google searching. +This is a format string, don't forget the `%s'." + :type 'string + :group 'helm-net) + +(defvaralias 'helm-google-suggest-use-curl-p 'helm-net-prefer-curl) +(make-obsolete-variable 'helm-google-suggest-use-curl-p 'helm-net-prefer-curl "1.7.7") + +(defcustom helm-net-prefer-curl nil + "When non--nil use CURL external program to fetch data. +Otherwise `url-retrieve-synchronously' is used." + :type 'boolean + :group 'helm-net) + +(defcustom helm-surfraw-duckduckgo-url + "https://duckduckgo.com/lite/?q=%s&kp=1" + "The Duckduckgo url. +This is a format string, don't forget the `%s'. +If you have personal settings saved on duckduckgo you should have +a personal url, see your settings on duckduckgo." + :type 'string + :group 'helm-net) + +(defcustom helm-search-suggest-action-wikipedia-url + "https://en.wikipedia.org/wiki/Special:Search?search=%s" + "The Wikipedia search url. +This is a format string, don't forget the `%s'." + :type 'string + :group 'helm-net) + +(defcustom helm-search-suggest-action-youtube-url + "https://www.youtube.com/results?aq=f&search_query=%s" + "The Youtube search url. +This is a format string, don't forget the `%s'." + :type 'string + :group 'helm-net) + +(defcustom helm-search-suggest-action-imdb-url + "http://www.imdb.com/find?s=all&q=%s" + "The IMDb search url. +This is a format string, don't forget the `%s'." + :type 'string + :group 'helm-net) + +(defcustom helm-search-suggest-action-google-maps-url + "https://maps.google.com/maps?f=q&source=s_q&q=%s" + "The Google Maps search url. +This is a format string, don't forget the `%s'." + :type 'string + :group 'helm-net) + +(defcustom helm-search-suggest-action-google-news-url + "https://www.google.com/search?safe=off&prmd=nvlifd&source=lnms&tbs=nws:1&q=%s" + "The Google News search url. +This is a format string, don't forget the `%s'." + :type 'string + :group 'helm-net) + +(defcustom helm-google-suggest-actions + (helm-make-actions + "Google Search" 'helm-google-suggest-action + "Wikipedia" (lambda (candidate) + (helm-search-suggest-perform-additional-action + helm-search-suggest-action-wikipedia-url + candidate)) + "Youtube" (lambda (candidate) + (helm-search-suggest-perform-additional-action + helm-search-suggest-action-youtube-url + candidate)) + "IMDb" (lambda (candidate) + (helm-search-suggest-perform-additional-action + helm-search-suggest-action-imdb-url + candidate)) + "Google Maps" (lambda (candidate) + (helm-search-suggest-perform-additional-action + helm-search-suggest-action-google-maps-url + candidate)) + "Google News" (lambda (candidate) + (helm-search-suggest-perform-additional-action + helm-search-suggest-action-google-news-url + candidate))) + "List of actions for google suggest sources." + :group 'helm-net + :type '(alist :key-type string :value-type function)) + +(defcustom helm-browse-url-firefox-new-window "--new-tab" + "Allow choosing to browse url in new window or new tab. +Can be \"--new-tab\" (default), \"--new-window\" or \"--private-window\"." + :group 'helm-net + :type '(radio + (const :tag "New tab" "--new-tab") + (const :tag "New window" "--new-window") + (const :tag "New private window" "--private-window"))) + +(defcustom helm-net-curl-switches '("-s" "-L") + "Arguments list passed to curl when using `helm-net-prefer-curl'." + :group 'helm-net + :type '(repeat string)) + +;;; Additional actions for search suggestions +;; +;; +;; Internal +(defvar helm-net-curl-log-file (expand-file-name "helm-curl.log" user-emacs-directory)) +(defun helm-search-suggest-perform-additional-action (url query) + "Perform the search via URL using QUERY as input." + (browse-url (format url (url-hexify-string query)))) + +(defun helm-net--url-retrieve-sync (request parser) + (if helm-net-prefer-curl + (with-temp-buffer + (apply #'call-process "curl" + nil `(t ,helm-net-curl-log-file) nil request helm-net-curl-switches) + (funcall parser)) + (with-current-buffer (url-retrieve-synchronously request) + (funcall parser)))) + + +;;; Google Suggestions +;; +;; +(defun helm-google-suggest-parser () + (cl-loop + with result-alist = (xml-get-children + (car (xml-parse-region + (point-min) (point-max))) + 'CompleteSuggestion) + for i in result-alist collect + (cdr (cl-caadr (assq 'suggestion i))))) + +(defun helm-google-suggest-fetch (input) + "Fetch suggestions for INPUT from XML buffer." + (let ((request (format helm-google-suggest-url + (url-hexify-string input)))) + (helm-net--url-retrieve-sync + request #'helm-google-suggest-parser))) + +(defun helm-google-suggest-set-candidates (&optional request-prefix) + "Set candidates with result and number of Google results found." + (let ((suggestions (helm-google-suggest-fetch + (or (and request-prefix + (concat request-prefix + " " helm-pattern)) + helm-pattern)))) + (if (member helm-pattern suggestions) + suggestions + ;; if there is no suggestion exactly matching the input then + ;; prepend a Search on Google item to the list + (append + suggestions + (list (cons (format "Search for '%s' on Google" helm-input) + helm-input)))))) + +(defun helm-ggs-set-number-result (num) + (if num + (progn + (and (numberp num) (setq num (number-to-string num))) + (cl-loop for i in (reverse (split-string num "" t)) + for count from 1 + append (list i) into C + when (= count 3) + append (list ",") into C + and do (setq count 0) + finally return + (replace-regexp-in-string + "^," "" (mapconcat 'identity (reverse C) "")))) + "?")) + +(defun helm-google-suggest-action (candidate) + "Default action to jump to a Google suggested candidate." + (let ((arg (format helm-google-suggest-search-url + (url-hexify-string candidate)))) + (helm-aif helm-google-suggest-default-browser-function + (funcall it arg) + (helm-browse-url arg)))) + +(defvar helm-google-suggest-default-function + 'helm-google-suggest-set-candidates + "Default function to use in `helm-google-suggest'.") + +(defvar helm-source-google-suggest + (helm-build-sync-source "Google Suggest" + :candidates (lambda () + (funcall helm-google-suggest-default-function)) + :action 'helm-google-suggest-actions + :match-dynamic t + :keymap helm-map + :requires-pattern 3)) + +(defun helm-google-suggest-emacs-lisp () + "Try to emacs lisp complete with Google suggestions." + (helm-google-suggest-set-candidates "emacs lisp")) + + +;;; Web browser functions. +;; +;; +;; If default setting of `w3m-command' is not +;; what you want and you modify it, you will have to reeval +;; also `helm-browse-url-default-browser-alist'. + +(defvar helm-browse-url-chromium-program "chromium-browser") +(defvar helm-browse-url-brave-program "brave-browser") +(defvar helm-browse-url-uzbl-program "uzbl-browser") +(defvar helm-browse-url-nyxt-program "nyxt") +(defvar helm-browse-url-conkeror-program "conkeror") +(defvar helm-browse-url-opera-program "opera") +(defvar helm-browse-url-w3m-program (or (and (boundp 'w3m-command) w3m-command) + (executable-find "w3m"))) +(defvar helm-browse-url-default-browser-alist + '((helm-browse-url-w3m-program . w3m-browse-url) + (browse-url-firefox-program . browse-url-firefox) + (helm-browse-url-chromium-program . helm-browse-url-chromium) + (helm-browse-url-brave-program . helm-browse-url-brave) + (helm-browse-url-conkeror-program . helm-browse-url-conkeror) + (helm-browse-url-opera-program . helm-browse-url-opera) + (helm-browse-url-uzbl-program . helm-browse-url-uzbl) + (helm-browse-url-nyxt-program . helm-browse-url-nyxt) + (browse-url-kde-program . browse-url-kde) + (browse-url-gnome-moz-program . browse-url-gnome-moz) + (browse-url-mozilla-program . browse-url-mozilla) + (browse-url-galeon-program . browse-url-galeon) + (browse-url-netscape-program . browse-url-netscape) + (browse-url-xterm-program . browse-url-text-xterm) + ("emacs" . eww-browse-url)) + "Alist of (browse_url_variable . function) to try to find a suitable url browser.") + +(defun helm-generic-browser (url cmd-name &rest args) + "Browse URL with NAME browser." + (let ((proc (concat cmd-name " " url))) + (message "Starting %s..." cmd-name) + (apply 'start-process proc nil cmd-name + (append args (list url))) + (set-process-sentinel + (get-process proc) + (lambda (process event) + (when (string= event "finished\n") + (message "%s process %s" process event)))))) + +(defun helm-browse-url-detached (cmd url &optional new-tab) + "Browse URL with browser CMD and detach it from Emacs. + +NEW-TAB is the command line argument supported by CMD e.g. \"--new-tab\". + +So when you quit Emacs you can keep your browser session open and +not be prompted to kill the browser process. + +NOTE: Probably not supported on some systems (e.g., Windows)." + (setq url (browse-url-encode-url url)) + (setq new-tab (if (stringp new-tab) + (concat " " (replace-regexp-in-string + " " "" new-tab)) + "")) + (let ((process-environment (browse-url-process-environment))) + (call-process-shell-command + (format "(%s%s %s &)" cmd new-tab (shell-quote-argument url))))) + +;;;###autoload +(defun helm-browse-url-firefox (url &optional _ignore) + "Same as `browse-url-firefox' but detach from Emacs. + +So when you quit Emacs you can keep your Firefox session open and +not be prompted to kill the Firefox process. + +NOTE: Probably not supported on some systems (e.g., Windows)." + (interactive (list (read-string "URL: " (browse-url-url-at-point)) + nil)) + (helm-browse-url-detached browse-url-firefox-program url + helm-browse-url-firefox-new-window)) + +;;;###autoload +(defun helm-browse-url-opera (url &optional _ignore) + "Browse URL with Opera browser and detach from Emacs. + +So when you quit Emacs you can keep your Opera session open and +not be prompted to kill the Opera process. + +NOTE: Probably not supported on some systems (e.g., Windows)." + (interactive (list (read-string "URL: " (browse-url-url-at-point)) + nil)) + (helm-browse-url-detached helm-browse-url-opera-program url)) + +;;;###autoload +(defun helm-browse-url-chromium (url &optional _ignore) + "Same as `browse-url-chromium' but detach from emacs. + +So when you quit Emacs you can keep your Chromium session open and +not be prompted to kill the Chromium process. + +NOTE: Probably not supported on some systems (e.g., Windows)." + (interactive (list (read-string "URL: " (browse-url-url-at-point)) + nil)) + (helm-browse-url-detached + helm-browse-url-chromium-program url)) + +;;;###autoload +(defun helm-browse-url-brave (url &optional _ignore) + "Browse URL with Brave browser and detach from emacs. + +Brave browser executable is determined by `helm-browse-url-brave-program'. + +So when you quit Emacs you can keep your Opera session open and +not be prompted to kill the Opera process. + +NOTE: Probably not supported on some systems (e.g., Windows)." + (interactive (list (read-string "URL: " (browse-url-url-at-point)) + nil)) + (helm-browse-url-detached + helm-browse-url-brave-program url "--new-tab")) + +;;;###autoload +(defun helm-browse-url-uzbl (url &optional _ignore) + "Browse URL with uzbl browser." + (interactive "sURL: ") + (helm-generic-browser url helm-browse-url-uzbl-program "-u")) + +;;;###autoload +(defun helm-browse-url-conkeror (url &optional _ignore) + "Browse URL with conkeror browser." + (interactive "sURL: ") + (helm-generic-browser url helm-browse-url-conkeror-program)) + +;;;###autoload +(defun helm-browse-url-nyxt (url &optional _ignore) + "Browse URL with nyxt browser." + (interactive "sURL: ") + (helm-generic-browser url helm-browse-url-nyxt-program)) + +(defun helm-browse-url-default-browser (url &rest args) + "Find the first available browser and ask it to load URL." + (let ((default-browser-fn + (cl-loop for (var . fn) in helm-browse-url-default-browser-alist + for exe = (if (stringp var) + var + (and (boundp var) (symbol-value var))) + thereis (and exe (executable-find exe) (fboundp fn) fn)))) + (if default-browser-fn + (apply default-browser-fn url args) + (error "No usable browser found")))) + +(defun helm-browse-url (url &rest args) + "Default command to browse URL." + (if browse-url-browser-function + (browse-url url args) + (helm-browse-url-default-browser url args))) + + +;;; Surfraw +;; +;; Need external program surfraw. +;; + +;; Internal +(defvar helm-surfraw-engines-history nil) +(defvar helm-surfraw-input-history nil) +(defvar helm-surfraw--elvi-cache nil) + +(defun helm-build-elvi-list () + "Return list of all engines and descriptions handled by surfraw." + (or helm-surfraw--elvi-cache + (setq helm-surfraw--elvi-cache + (cdr (with-temp-buffer + (call-process "surfraw" nil t nil "-elvi") + (split-string (buffer-string) "\n")))))) + +;;;###autoload +(defun helm-surfraw (pattern engine) + "Preconfigured `helm' to search PATTERN with search ENGINE." + (interactive + (list + (let* ((default (if (use-region-p) + (buffer-substring-no-properties + (region-beginning) (region-end)) + (thing-at-point 'symbol))) + (prompt (if default + (format "SearchFor (default %s): " default) + "SearchFor: "))) + (read-string prompt nil 'helm-surfraw-input-history default)) + (helm-comp-read + "Engine: " + (helm-build-elvi-list) + :must-match t + :name "Surfraw Search Engines" + :history 'helm-surfraw-engines-history))) + (let* ((engine-nodesc (car (split-string engine))) + (url (if (string= engine-nodesc "duckduckgo") + ;; "sr duckduckgo -p foo" is broken, workaround. + (format helm-surfraw-duckduckgo-url + (url-hexify-string pattern)) + (with-temp-buffer + (apply 'call-process "surfraw" nil t nil + (append (list engine-nodesc "-p") (split-string pattern))) + (replace-regexp-in-string + "\n" "" (buffer-string))))) + (browse-url-browser-function (or helm-surfraw-default-browser-function + browse-url-browser-function))) + (if (string= engine-nodesc "W") + (helm-browse-url helm-home-url) + (helm-browse-url url)))) + +;;;###autoload +(defun helm-google-suggest () + "Preconfigured `helm' for Google search with Google suggest." + (interactive) + (helm :sources 'helm-source-google-suggest :buffer "*helm google*")) + +(provide 'helm-net) + +;;; helm-net.el ends here diff --git a/elpa/helm-20260424.1357/helm-occur.el b/elpa/helm-20260424.1357/helm-occur.el new file mode 100644 index 00000000..87e5aa00 --- /dev/null +++ b/elpa/helm-20260424.1357/helm-occur.el @@ -0,0 +1,937 @@ +;;; helm-occur.el --- Incremental Occur for Helm. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2026 Thierry Volpiatto + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + + +;;; Code: + +(require 'cl-lib) +(require 'helm) +(require 'helm-help) +(require 'helm-utils) + +(declare-function helm-buffers-get-visible-buffers "helm-buffers") +(declare-function helm-buffer-list "helm-buffers") +(declare-function helm-grep-split-line "helm-grep") +(declare-function helm-grep-highlight-match "helm-grep") +(declare-function helm-grep-ag-1 "helm-grep") +(declare-function helm-grep--ag-command "helm-grep") +(declare-function helm-comp-read "helm-mode") + +(defvar helm-current-error) + +;;; Internals +;; +(defvar helm-source-occur nil + "This will be the name of the source related to `current-buffer'. +Don't use it as it value changes always.") +(defvar helm-source-moccur nil + "This is just a flag to add to `helm-sources-using-default-as-input'. +Don't set it to any value, it will have no effect.") +(defvar helm-occur--buffer-list nil) +(defvar helm-occur--buffer-tick nil) +(defvar helm-occur-history nil) +(defvar helm-occur--search-buffer-regexp "\\`\\([0-9]*\\)\\s-\\(.*\\)\\'" + "The regexp matching candidates in helm-occur candidate buffer.") +(defvar helm-occur-mode--last-pattern nil) +(defvar helm-occur--initial-pos 0) + +(defvar helm-occur-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (define-key map (kbd "C-c o") 'helm-occur-run-goto-line-ow) + (define-key map (kbd "C-c C-o") 'helm-occur-run-goto-line-of) + (define-key map (kbd "C-x C-s") 'helm-occur-run-save-buffer) + (define-key map (kbd "C-s") 'helm-run-occur-grep-ag-buffer-directory) + map) + "Keymap used in occur source.") + +(defgroup helm-occur nil + "Regexp related Applications and libraries for Helm." + :group 'helm) + +(defcustom helm-occur-actions + '(("Go to Line" . helm-occur-goto-line) + ("Goto line other window (C-u vertically)" . helm-occur-goto-line-ow) + ("Goto line new frame" . helm-occur-goto-line-of) + ("Save buffer" . helm-occur-save-results)) + "Actions for helm-occur." + :type '(alist :key-type string :value-type function)) + +(defcustom helm-occur-use-ioccur-style-keys nil + "Similar to `helm-grep-use-ioccur-style-keys' but for multi occur. + +Note that if you define this variable with `setq' your change will +have no effect, use customize instead." + :type 'boolean + :set (lambda (var val) + (set var val) + (if val + (progn + (define-key helm-occur-map (kbd "") 'helm-occur-right) + (define-key helm-occur-map (kbd "") 'helm-occur-run-default-action)) + (define-key helm-occur-map (kbd "") nil) + (define-key helm-occur-map (kbd "") nil)))) + +(defcustom helm-occur-always-search-in-current nil + "Helm multi occur always search in current buffer when non--nil." + :type 'boolean) + +(defcustom helm-occur-truncate-lines t + "Truncate lines in occur buffer when non nil." + :type 'boolean) + +(defcustom helm-occur-auto-update-on-resume nil + "Allow auto updating helm-occur buffer when outdated. +noask => Always update without asking +nil => Don't update but signal buffer needs update +never => Never update and do not signal buffer needs update +Any other non--nil value update after confirmation." + :type '(radio :tag "Allow auto updating helm-occur buffer when outdated." + (const :tag "Always update without asking" noask) + (const :tag "Never update and do not signal buffer needs update" never) + (const :tag "Don't update but signal buffer needs update" nil) + (const :tag "Update after confirmation" t))) + +(defcustom helm-occur-candidate-number-limit 99999 + "Value of `helm-candidate-number-limit' for helm-occur." + :type 'integer) + +(defcustom helm-occur-buffer-substring-fn-for-modes + '((mu4e-headers-mode . buffer-substring)) + "Function used to display buffer contents per major-mode. + +Use this to display lines with their text properties in helm-occur +buffer. Can be one of `buffer-substring' or `buffer-substring-no-properties'. +See `helm-occur-buffer-substring-default-mode' to setup this globally. + +Note that when using `buffer-substring' initialization will be slower." + :type '(alist :key-type (symbol :tag "Mode") + :value-type (radio (const :tag "With text properties" + buffer-substring) + (const :tag "Without text properties" + buffer-substring-no-properties)))) + +(defcustom helm-occur-buffer-substring-default-mode + 'buffer-substring-no-properties + "Function used to display buffer contents in helm-occur buffer. + +Default mode for major modes not defined in +`helm-occur-buffer-substring-fn-for-modes'. +Can be one of `buffer-substring' or `buffer-substring-no-properties'. + +Note that when using `buffer-substring' initialization will be +slower. If buffer-substring, all buffers with the modes not +defined in helm-occur-buffer-substring-fn-for-modes will be +displayed with colors and properties in the helm-occur buffer" + :type '(radio + (const :tag "With text properties" buffer-substring) + (const :tag "Without text properties" buffer-substring-no-properties))) + +(defcustom helm-occur-keep-closest-position t + "When non nil select closest candidate from point after update. +This happen only in `helm-source-occur' which is always related to +`current-buffer'." + :type 'boolean) + +(defcustom helm-occur-ignore-diacritics nil + "When non nil helm-occur will ignore diacritics in patterns." + :type 'boolean) + +(defcustom helm-occur-match-shorthands nil + "Transform pattern according to `read-symbol-shorthands' when non nil." + :type 'boolean) + +(defface helm-moccur-buffer + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :foreground "DarkTurquoise" :underline t)) + "Face used to highlight occur buffer names.") + +(defface helm-resume-need-update + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :background "red")) + "Face used to flash occur buffer when it needs update.") + + +(defun helm-occur--select-closest-candidate () + ;; Prevent error with `with-helm-window' when switching to help. + (unless (or (not (get-buffer-window helm-buffer 'visible)) + (string-equal helm-pattern "")) + (with-helm-window + (let ((lst '()) + ;; `helm-source-occur' name is "Helm occur" when using `helm-occur' + ;; command (searching and starting from current-buffer), whereas it + ;; has the name of current-buffer when using `helm-multi-occur-1'. + (name (helm-get-attr 'name helm-source-occur)) + closest beg end) + (while-no-input + (goto-char (point-min)) + (cond ((string= name "Helm occur") + (setq beg (point) + end (point-max))) + ;; The source corresponding to helm-current-buffer should be + ;; always on top, so no need to search for it by looping in + ;; helm-buffer. + ((string= name (buffer-substring-no-properties + (pos-bol) (pos-eol))) + (forward-line 1) + (setq beg (point) + end (or (helm-get-next-header-pos) (point-max))))) + (save-excursion + (when (and beg end) + (goto-char beg) + (while (re-search-forward "^[0-9]+" end t) + (push (string-to-number (match-string 0)) lst)) + (setq closest (helm-closest-number-in-list + helm-occur--initial-pos lst)))) + (when (and closest (re-search-forward (format "^%s" closest) end t)) + (helm-mark-current-line) + (goto-char (overlay-start + helm-selection-overlay)))))))) + +;;;###autoload +(defun helm-occur () + "Preconfigured helm for searching lines matching pattern in `current-buffer'. + +When `helm-source-occur' is member of +`helm-sources-using-default-as-input' which is the default, +symbol at point is searched at startup. + +When a region is marked search only in this region by narrowing. + +To search in multiples buffers start from one of the commands listing +buffers (i.e. a helm command using `helm-source-buffers-list' like +`helm-mini') and use the multi occur buffers action. + +This is the helm implementation that collect lines matching pattern +like vanilla Emacs `occur' but have nothing to do with it, the search +engine beeing completely different and also much faster." + (interactive) + (setq helm-source-occur + (car (helm-occur-build-sources (list (current-buffer)) "Helm occur"))) + (helm-set-local-variable 'helm-occur--buffer-list (list (current-buffer)) + 'helm-occur--buffer-tick + (list (buffer-chars-modified-tick (current-buffer)))) + (helm-set-attr 'header-name (lambda (_name) + (format "HO [%s]" + (buffer-name helm-current-buffer))) + helm-source-occur) + (when helm-occur-keep-closest-position + (setq helm-occur--initial-pos (line-number-at-pos)) + (add-hook 'helm-after-update-hook 'helm-occur--select-closest-candidate)) + (save-restriction + (let ((helm-sources-using-default-as-input + (unless (> (buffer-size) 2000000) + helm-sources-using-default-as-input)) + def pos) + (when (use-region-p) + ;; When user mark defun with `mark-defun' with intention of + ;; using helm-occur on this region, it is relevant to use the + ;; thing-at-point located at previous position which have been + ;; pushed to `mark-ring', if it's within the active region. + (let ((beg (region-beginning)) + (end (region-end)) + (prev-pos (car mark-ring))) + (when (and prev-pos (>= prev-pos beg) (< prev-pos end)) + (setq def (save-excursion + (goto-char (setq pos prev-pos)) + (helm-aif (thing-at-point 'symbol) (regexp-quote it))))) + (narrow-to-region beg end))) + (unwind-protect + (helm :sources 'helm-source-occur + :buffer "*helm occur*" + :history 'helm-occur-history + :default (or def (helm-aif (thing-at-point 'symbol) + (regexp-quote it))) + :preselect (and (memq 'helm-source-occur + helm-sources-using-default-as-input) + (format "^%d:" (line-number-at-pos + (or pos (point))))) + :truncate-lines helm-occur-truncate-lines) + (deactivate-mark t) + (remove-hook 'helm-after-update-hook 'helm-occur--select-closest-candidate))))) + +;;;###autoload +(defun helm-occur-visible-buffers () + "Run helm-occur on all visible buffers in frame." + (interactive) + (require 'helm-buffers) + (if (or (one-window-p) (region-active-p)) + (call-interactively #'helm-occur) + (let ((buffers (helm-buffers-get-visible-buffers))) + (helm-multi-occur-1 (mapcar 'get-buffer buffers))))) + +(defun helm-occur-transformer (candidates source) + "Return CANDIDATES prefixed with line number." + (cl-loop with buf = (helm-get-attr 'buffer-name source) + for c in candidates + for bfname = (buffer-file-name (get-buffer buf)) + for disp-linum = (when (string-match helm-occur--search-buffer-regexp c) + (let ((linum (match-string 1 c)) + (disp (match-string 2 c))) + (list + linum + (format "%s:%s" + (propertize + linum + 'face 'helm-grep-lineno + 'help-echo bfname + 'helm-grep-fname bfname) + disp)))) + for linum = (car disp-linum) + for disp = (cadr disp-linum) + when (and disp (not (string= disp ""))) + collect (cons disp (string-to-number linum)))) + +(defvar helm-occur--gshorthands nil) +(defun helm-occur-symbol-shorthands-pattern-transformer (pattern buffer gshorthands) + "Maybe transform PATTERN to its `read-symbol-shorthands' counterpart in BUFFER. + +GSHORTHANDS is the concatenation of all `read-symbol-shorthands' value found in +all buffers i.e. `buffer-list'. +When GSHORTHANDS is nil use PATTERN unmodified." + (if gshorthands + (let* ((lshorthands (buffer-local-value 'read-symbol-shorthands buffer)) + (prefix (cl-loop for (k . v) in gshorthands + if (string-match (concat "\\`" k) pattern) + return k + else + if (string-match (concat "\\`" v) pattern) + return v)) + (lgstr (cdr (or (assoc prefix gshorthands) + (rassoc prefix gshorthands))))) + (if (and lgstr lshorthands) + (concat (car (rassoc lgstr lshorthands)) + (replace-regexp-in-string prefix "" pattern)) + pattern)) + pattern)) + +(defclass helm-moccur-class (helm-source-in-buffer) + ((buffer-name :initarg :buffer-name + :initform nil) + (moccur-buffers :initarg :moccur-buffers + :initform nil) + (find-file-target :initform #'helm-occur-quit-an-find-file-fn))) + +(defun helm-occur-build-sources (buffers &optional source-name) + "Build sources for `helm-occur' for each buffer in BUFFERS list." + (require 'helm-grep) + (setq helm-occur--gshorthands nil) + (and helm-occur-match-shorthands + (setq helm-occur--gshorthands + (cl-loop for b in (buffer-list) + for rss = (buffer-local-value + 'read-symbol-shorthands + b) + when rss append rss))) + (let (sources) + (dolist (buf buffers) + (let ((bname (buffer-name buf))) + (push (helm-make-source (or source-name bname) + 'helm-moccur-class + :header-name (lambda (name) + (format "HO [%s]" (if (string= name "Helm occur") + bname name))) + :buffer-name bname + :match-part + (lambda (candidate) + ;; The regexp should match what is in candidate buffer, + ;; not what is displayed in helm-buffer e.g. "12 foo" + ;; and not "12:foo". + (when (string-match helm-occur--search-buffer-regexp + candidate) + (match-string 2 candidate))) + :diacritics helm-occur-ignore-diacritics + :search (lambda (pattern) + (when (string-match "\\`\\^\\(.*\\)" pattern) + (setq pattern (concat "^[0-9]*\\s-" (match-string 1 pattern)))) + (condition-case _err + (re-search-forward pattern nil t) + (invalid-regexp nil))) + :pattern-transformer (lambda (pattern) + (helm-occur-symbol-shorthands-pattern-transformer + pattern buf helm-occur--gshorthands)) + :init (lambda () + (with-current-buffer buf + (let* ((bsfn (or (cdr (assq + major-mode + helm-occur-buffer-substring-fn-for-modes)) + helm-occur-buffer-substring-default-mode)) + (contents (funcall bsfn (point-min) (point-max)))) + (helm-set-attr 'get-line bsfn) + (with-current-buffer (helm-candidate-buffer 'global) + (insert contents) + (goto-char (point-min)) + (let ((linum 1)) + (insert (format "%s " linum)) + (while (re-search-forward "\n" nil t) + (cl-incf linum) + (insert (format "%s " linum)))))))) + :filtered-candidate-transformer 'helm-occur-transformer + :help-message 'helm-moccur-help-message + :nomark t + :migemo t + ;; Needed for resume. + :history 'helm-occur-history + :candidate-number-limit helm-occur-candidate-number-limit + :action (append helm-occur-actions + (helm-make-actions + (lambda () + (when helm-grep-ag-command + (format "%s grep buffer directory" + (upcase (helm-grep--ag-command))))) + 'helm-occur-grep-ag-buffer-directory)) + :requires-pattern 2 + :follow 1 + :group 'helm-occur + :keymap helm-occur-map + :resume 'helm-occur-resume-fn + :moccur-buffers buffers) + sources))) + (nreverse sources))) + +(defun helm-multi-occur-1 (buffers &optional input default) + "Run `helm-occur' on a list of buffers. +Each buffer's result is displayed in a separated source. +Arg INPUT if specified will be inserted as initial input in minibuffer. +Arg DEFAULT if specified will be inserted in minibuffer with M-n. +Arg INPUT takes precedence on DEFAULT if both are specified. +If `helm-source-moccur' is member of `helm-sources-using-default-as-input' +helm-occur will start immediately with DEFAULT as INPUT. +Always prefer using DEFAULT instead of INPUT, they have the same effect but +DEFAULT keep the minibuffer empty, allowing the user to write immediately +without having to delete its contents before." + (let* ((curbuf (get-buffer (if helm-alive-p + ;; We are starting from a helm session listing + ;; buffers, presumably helm-buffers-list or + ;; helm-mini. If we don't check for + ;; helm-alive-p and helm-multi-occur-1 is + ;; launched from e.g. isl or isearch we may + ;; reuse a old helm-current-buffer value from + ;; last helm-session. + helm-current-buffer + (current-buffer)))) + (bufs (if (or helm-occur-always-search-in-current + (memql curbuf buffers)) + (cons curbuf (remove curbuf buffers)) + buffers)) + (helm-sources-using-default-as-input + (unless (cl-loop with total_size = 0 + for b in bufs + do (setq total_size (buffer-size b)) + finally return (> total_size 2000000)) + helm-sources-using-default-as-input)) + (sources (helm-occur-build-sources bufs (and (eql curbuf (car bufs)) + (not (cdr bufs)) + "Helm occur"))) + (helm-maybe-use-default-as-input + (not (null (memq 'helm-source-moccur + helm-sources-using-default-as-input))))) + (helm-set-local-variable 'helm-occur--buffer-list bufs + 'helm-occur--buffer-tick + (cl-loop for b in bufs collect + (buffer-chars-modified-tick + (get-buffer b)))) + (when (and (eql (car bufs) curbuf) + helm-occur-keep-closest-position) + (setq helm-source-occur + (cl-loop for s in sources + when (eql helm-current-buffer + (get-buffer (helm-get-attr 'buffer-name s))) + return s)) + (setq helm-occur--initial-pos (line-number-at-pos)) + (add-hook 'helm-after-update-hook 'helm-occur--select-closest-candidate)) + (unwind-protect + (helm :sources sources + :buffer "*helm moccur*" + :history 'helm-occur-history + :default (or default + (helm-aif (thing-at-point 'symbol) + (regexp-quote it))) + :input input + :truncate-lines helm-occur-truncate-lines) + (remove-hook 'helm-after-update-hook 'helm-occur--select-closest-candidate)))) + +;;; Actions +;; +(defun helm-occur-action (lineno &optional method) + "Jump to line number LINENO with METHOD. +METHOD can be one of buffer, buffer-other-window, buffer-other-frame." + (require 'helm-grep) + (unless method (setq method 'buffer)) + (let ((buf (if (eq major-mode 'helm-occur-mode) + (get-text-property (point) 'buffer-name) + (helm-get-attr 'buffer-name))) + (split-pat (helm-mm-split-pattern helm-input))) + (cl-case method + (buffer (switch-to-buffer buf)) + (buffer-other-window (helm-window-show-buffers (list buf) t)) + (buffer-other-frame (switch-to-buffer-other-frame buf))) + (with-current-buffer buf + (helm-goto-line lineno) + ;; Move point to the nearest matching regexp from bol. + (cl-loop for str in split-pat + for reg = (helm-occur-symbol-shorthands-pattern-transformer + str (get-buffer buf) helm-occur--gshorthands) + when (save-excursion + (condition-case _err + (if helm-migemo-mode + (helm-mm-migemo-forward reg (pos-eol) t) + (re-search-forward reg (pos-eol) t)) + (invalid-regexp nil))) + collect (match-beginning 0) into pos-ls + finally (when pos-ls (goto-char (apply #'min pos-ls))))))) + +(defun helm-occur-goto-line (candidate) + "From multi occur, switch to buffer and CANDIDATE line." + (helm-occur-action + candidate 'buffer)) + +(defun helm-occur-goto-line-ow (candidate) + "Go to CANDIDATE line in other window. +Same as `helm-occur-goto-line' but go in other window." + (helm-occur-action + candidate 'buffer-other-window)) + +(defun helm-occur-goto-line-of (candidate) + "Go to CANDIDATE line in new frame. +Same as `helm-occur-goto-line' but go in new frame." + (helm-occur-action + candidate 'buffer-other-frame)) + +(helm-make-command-from-action helm-occur-run-goto-line-ow + "Run goto line other window action from `helm-occur'." + 'helm-occur-goto-line-ow) + +(helm-make-command-from-action helm-occur-run-goto-line-of + "Run goto line new frame action from `helm-occur'." + 'helm-occur-goto-line-of) + +(helm-make-command-from-action helm-occur-run-default-action + "Goto matching line from helm-occur buffer." + 'helm-occur-goto-line) + +(helm-make-command-from-action helm-occur-run-save-buffer + "Run moccur save results action from `helm-moccur'." + 'helm-occur-save-results) + +(defun helm-occur-right () + "`helm-occur' action for right arrow. +This is used when `helm-occur-use-ioccur-style-keys' is enabled. +If follow is enabled (default) go to next source, otherwise execute +persistent action." + (interactive) + (if (helm-aand (helm-get-attr 'follow) (> it 0)) + (helm-next-source) + (helm-execute-persistent-action))) +(put 'helm-occur-right 'helm-only t) + +(defun helm-occur-quit-an-find-file-fn (source) + (let* ((sel (helm-get-selection nil nil source)) + (occur-fname (helm-aand (numberp sel) + (helm-get-attr 'buffer-name) + (buffer-file-name (get-buffer it))))) + (when (and occur-fname (file-exists-p occur-fname)) + (expand-file-name occur-fname)))) + +(defun helm-occur-grep-ag-buffer-directory (_candidate) + "Start helm-grep-ag in the `default-directory' of currently searched buffer." + (let* ((src (with-helm-buffer + ;; Search from current source or fallback to the first + ;; source if helm-buffer is empty, if only one source + ;; we are right in either cases. + (or (helm-get-current-source) + (car helm-sources)))) + (buf (helm-get-attr 'buffer-name src)) + (directory (with-current-buffer buf + default-directory)) + (input helm-pattern)) + (helm-grep-ag-1 directory nil input))) + +(helm-make-command-from-action helm-run-occur-grep-ag-buffer-directory + "Ag grep buffer directory." 'helm-occur-grep-ag-buffer-directory) + +;;; helm-occur-mode +;; +;; +(defvar helm-occur-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "RET") 'helm-occur-mode-goto-line) + (define-key map (kbd "C-o") 'helm-occur-mode-goto-line-ow) + (define-key map (kbd "") 'helm-occur-mode-goto-line-ow-forward) + (define-key map (kbd "") 'helm-occur-mode-goto-line-ow-backward) + (define-key map (kbd "") 'helm-gm-next-file) + (define-key map (kbd "") 'helm-gm-precedent-file) + (define-key map (kbd "M-n") 'helm-occur-mode-goto-line-ow-forward) + (define-key map (kbd "M-p") 'helm-occur-mode-goto-line-ow-backward) + (define-key map (kbd "M-N") 'helm-gm-next-file) + (define-key map (kbd "M-P") 'helm-gm-precedent-file) + (define-key map (kbd "C-c b") 'helm-occur-mode-resume-session) + map)) + +(defun helm-occur-mode-goto-line () + (interactive) + (setq next-error-last-buffer (current-buffer)) + (setq-local helm-current-error (point-marker)) + (helm-aif (get-text-property (point) 'helm-realvalue) + (progn (helm-occur-goto-line it) (helm-match-line-cleanup-pulse)))) + +(defun helm-occur-mode-goto-line-ow () + (interactive) + (setq next-error-last-buffer (current-buffer)) + (setq-local helm-current-error (point-marker)) + (helm-aif (get-text-property (point) 'helm-realvalue) + (progn (helm-occur-goto-line-ow it) (helm-match-line-cleanup-pulse)))) + +(defun helm-occur-mode-goto-line-ow-forward-1 (arg) + (condition-case nil + (progn + (when (or (eq last-command 'helm-occur-mode-goto-line-ow-forward) + (eq last-command 'helm-occur-mode-goto-line-ow-backward)) + (forward-line arg)) + (save-selected-window + (helm-occur-mode-goto-line-ow) + (recenter))) + (error nil))) + +(defun helm-occur-mode-goto-line-ow-forward (arg) + (interactive "p") + (helm-occur-mode-goto-line-ow-forward-1 arg)) + +(defun helm-occur-mode-goto-line-ow-backward (arg) + (interactive "p") + (helm-occur-mode-goto-line-ow-forward-1 (- arg))) + +(defun helm-occur-save-results (_candidate) + "Save helm moccur results in a `helm-moccur-mode' buffer." + (let ((buf "*hmoccur*") + new-buf) + (when (get-buffer buf) + (setq new-buf (helm-read-string "OccurBufferName: " buf)) + (cl-loop for b in (helm-buffer-list) + when (and (string= new-buf b) + (not (y-or-n-p + (format "Buffer `%s' already exists overwrite? " + new-buf)))) + do (setq new-buf (helm-read-string + "OccurBufferName: " "*hmoccur "))) + (setq buf new-buf)) + (with-current-buffer (get-buffer-create buf) + (kill-all-local-variables) + (setq buffer-read-only t) + (buffer-disable-undo) + (let ((inhibit-read-only t) + (map (make-sparse-keymap)) + buf-name) + (erase-buffer) + (insert "-*- mode: helm-occur -*-\n\n" + (format "Occur Results for `%s':\n\n" helm-input)) + (save-excursion + (insert (with-current-buffer helm-buffer + (goto-char (point-min)) + (forward-line 1) + (buffer-substring (point) (point-max))))) + (save-excursion + (forward-line -2) + (while (not (eobp)) + (if (helm-pos-header-line-p) + (let ((beg (pos-bol)) + (end (pos-eol))) + (set-text-properties beg (1+ end) nil) + (delete-region (1- beg) end)) + (helm-aif (setq buf-name (assoc-default + 'buffer-name + (get-text-property (point) 'helm-cur-source))) + (progn + (insert (propertize (concat it ":") + 'face 'helm-moccur-buffer + 'helm-realvalue (get-text-property (point) 'helm-realvalue))) + (add-text-properties + (pos-bol) (pos-eol) + `(buffer-name ,buf-name)) + (add-text-properties + (pos-bol) (pos-eol) + `(keymap ,map + help-echo ,(concat + (buffer-file-name + (get-buffer buf-name)) + "\nmouse-1: set point\nmouse-2: jump to selection") + mouse-face highlight + invisible nil)) + (define-key map [mouse-1] 'mouse-set-point) + (define-key map [mouse-2] 'helm-occur-mode-mouse-goto-line) + (define-key map [mouse-3] 'ignore)))) + (forward-line 1)))) + (buffer-enable-undo) + (helm-occur-mode)) + (pop-to-buffer buf) + (setq next-error-last-buffer (get-buffer buf)) + (message "Helm occur Results saved in `%s' buffer" buf))) + +(defun helm-occur-mode-mouse-goto-line (event) + (interactive "e") + (let* ((window (posn-window (event-end event))) + (pos (posn-point (event-end event)))) + (with-selected-window window + (when (eq major-mode 'helm-occur-mode) + (goto-char pos) + (helm-occur-mode-goto-line))))) +(put 'helm-moccur-mode-mouse-goto-line 'helm-only t) + +(defun helm-occur-mode-resume-session () + (interactive) + (cl-assert (eq major-mode 'helm-occur-mode) nil "Helm command called in wrong context") + (helm-multi-occur-1 helm-occur--buffer-list helm-occur-mode--last-pattern)) + +(defun helm-occur-buffer-substring-with-linums () + "Return current-buffer contents as a string with all lines +numbered. The property \\='buffer-name is added to the whole string." + (let ((bufstr (buffer-substring-no-properties (point-min) (point-max))) + (bufname (buffer-name))) + (with-temp-buffer + (save-excursion + (insert bufstr)) + (let ((linum 1)) + (insert (format "%s " linum)) + (while (re-search-forward "\n" nil t) + (cl-incf linum) + (insert (format "%s " linum))) + (add-text-properties (point-min) (point-max) `(buffer-name ,bufname))) + (buffer-string)))) + +(defun helm-occur-mode--revert-buffer-function (&optional _ignore-auto _noconfirm) + "The `revert-buffer-function' for `helm-occur-mode'." + (goto-char (point-min)) + (let (pattern) + (when (re-search-forward "^Occur Results for `\\(.*\\)'" nil t) + (setq pattern (match-string 1)) + (forward-line 0) + (when (re-search-forward "^$" nil t) + (forward-line 1)) + (let ((inhibit-read-only t) + (buffer (current-buffer)) + (buflst helm-occur--buffer-list)) + (delete-region (point) (point-max)) + (message "Reverting buffer...") + (save-excursion + (with-temp-buffer + (insert + "\n" + (cl-loop for buf in buflst + for bufstr = (or (and (buffer-live-p (get-buffer buf)) + (with-current-buffer buf + (helm-occur-buffer-substring-with-linums))) + "") + concat bufstr) + "\n") + (goto-char (point-min)) + (cl-loop with linum + with mpart + ;; Bind helm-pattern used by `helm-grep-split-line'. + with helm-pattern = pattern + while (helm-mm-search pattern) ; point is at eol. + ;; Calculate line number (linum) and extract real + ;; part of line (mpart). + do (when (save-excursion + ;; `helm-mm-search' puts point at eol. + (forward-line 0) + (re-search-forward "^\\([0-9]*\\)\\s-\\{1\\}\\(.*\\)$" + (pos-eol) t)) + (setq linum (string-to-number (match-string 1)) + mpart (match-string 2))) + ;; Match part after line number. + when (and mpart (helm-mm-match mpart pattern)) + for line = (format "%s:%d:%s" + (get-text-property (point) 'buffer-name) + linum + mpart) + when line + do (with-current-buffer buffer + (insert + (propertize + (car (helm-occur-filter-one-by-one line)) + 'helm-realvalue linum) + "\n")))) + (when (fboundp 'wgrep-cleanup-overlays) + (wgrep-cleanup-overlays (point-min) (point-max))) + (message "Reverting buffer done") + (when executing-kbd-macro (sit-for 1))))))) + +(defun helm-occur-filter-one-by-one (candidate) + "`filter-one-by-one' function for `helm-source-moccur'." + (require 'helm-grep) + (let* ((split (helm-grep-split-line candidate)) + (buf (car split)) + (lineno (nth 1 split)) + (str (nth 2 split)) + (bfname (buffer-file-name (get-buffer buf)))) + (cons (concat (propertize + buf + 'face 'helm-moccur-buffer + 'help-echo bfname + 'helm-grep-fname bfname + 'buffer-name buf) + ":" + (propertize lineno 'face 'helm-grep-lineno) + ":" + (helm-grep-highlight-match str)) + candidate))) + +(define-derived-mode helm-occur-mode + special-mode "helm-moccur" + "Major mode to provide actions in helm moccur saved buffer. + +Special commands: +\\{helm-occur-mode-map}" + (set (make-local-variable 'helm-occur--buffer-list) + (with-helm-buffer helm-occur--buffer-list)) + (set (make-local-variable 'revert-buffer-function) + #'helm-occur-mode--revert-buffer-function) + (set (make-local-variable 'helm-occur-mode--last-pattern) + helm-input) + (set (make-local-variable 'next-error-function) + #'helm-occur-next-error) + (set (make-local-variable 'helm-current-error) nil)) +(put 'helm-moccur-mode 'helm-only t) + +(defun helm-occur-next-error (&optional argp reset) + "Goto ARGP position from a `helm-occur-mode' buffer. +RESET non-nil means rewind to the first match. +This is the `next-error-function' for `helm-occur-mode'." + (interactive "p") + (goto-char (cond (reset (point-min)) + ((and (< argp 0) helm-current-error) + (line-beginning-position)) + ((and (> argp 0) helm-current-error) + (line-end-position)) + ((point)))) + (let ((fun (if (> argp 0) + #'next-single-property-change + #'previous-single-property-change))) + (helm-aif (funcall fun (point) 'buffer-name) + (progn + (goto-char it) + (forward-line 0) + ;; `helm-current-error' is set in + ;; `helm-occur-mode-goto-line'. + (helm-occur-mode-goto-line)) + (user-error "No more matches")))) + +;;; Resume +;; +(defun helm-occur-resume-fn () + (with-helm-buffer + (let (new-tick-ls buffer-is-modified) + (set (make-local-variable 'helm-occur--buffer-list) + (cl-loop for b in helm-occur--buffer-list + when (buffer-live-p (get-buffer b)) + collect b)) + (setq buffer-is-modified (/= (length helm-occur--buffer-list) + (length (helm-get-attr 'moccur-buffers)))) + (helm-set-attr 'moccur-buffers helm-occur--buffer-list) + (setq new-tick-ls (cl-loop for b in helm-occur--buffer-list + collect (buffer-chars-modified-tick + (get-buffer b)))) + (when buffer-is-modified + (setq helm-occur--buffer-tick new-tick-ls)) + (cl-assert (> (length helm-occur--buffer-list) 0) nil + "helm-resume error: helm-(m)occur buffer list is empty") + (unless (eq helm-occur-auto-update-on-resume 'never) + (when (or buffer-is-modified + (cl-loop for b in helm-occur--buffer-list + for new-tick = (buffer-chars-modified-tick + (get-buffer b)) + for tick in helm-occur--buffer-tick + thereis (/= tick new-tick))) + (helm-aif helm-occur-auto-update-on-resume + (when (or (eq it 'noask) + (y-or-n-p "Helm (m)occur Buffer outdated, update? ")) + (run-with-idle-timer + 0.1 nil (lambda () + (with-helm-buffer + (helm-force-update) + (message "Helm (m)occur Buffer have been udated") + (sit-for 1) (message nil)))) + (unless buffer-is-modified (setq helm-occur--buffer-tick + new-tick-ls))) + (run-with-idle-timer + 0.1 nil + (lambda () + (with-helm-buffer + (let ((ov (make-overlay (save-excursion + (goto-char (point-min)) + (forward-line 1) + (point)) + (point-max)))) + (overlay-put ov 'face 'helm-resume-need-update) + (sit-for 0) + (delete-overlay ov) + (message "[Helm occur Buffer outdated (C-c C-u to update)]"))))) + (unless buffer-is-modified + (with-helm-after-update-hook + (setq helm-occur--buffer-tick new-tick-ls) + (message "Helm (m)occur Buffer have been udated"))))))))) + +;;; Helm occur from isearch +;; +;;;###autoload +(defun helm-occur-from-isearch () + "Invoke `helm-occur' from isearch. + +To use this bind it to a key in `isearch-mode-map'." + (interactive) + (let ((input (if isearch-regexp + isearch-string + (regexp-quote isearch-string))) + (bufs (list (current-buffer))) + ;; Use `helm-occur-always-search-in-current' as a flag for + ;; `helm-occur--select-closest-candidate'. + (helm-occur-always-search-in-current t)) + (isearch-exit) + (helm-multi-occur-1 bufs input))) + +;;;###autoload +(defun helm-multi-occur-from-isearch () + "Invoke `helm-multi-occur' from isearch. + +With a prefix arg, reverse the behavior of +`helm-moccur-always-search-in-current'. +The prefix arg can be set before calling +`helm-multi-occur-from-isearch' or during the buffer selection. + +To use this bind it to a key in `isearch-mode-map'." + (interactive) + (let (buf-list + helm-moccur-always-search-in-current + (input (if isearch-regexp + isearch-string + (regexp-quote isearch-string)))) + (isearch-exit) + (setq buf-list (mapcar 'get-buffer + (helm-comp-read "Buffers: " + (helm-buffer-list) + :name "Occur in buffer(s)" + :marked-candidates t))) + (setq helm-moccur-always-search-in-current + (if (or current-prefix-arg + helm-current-prefix-arg) + (not helm-moccur-always-search-in-current) + helm-moccur-always-search-in-current)) + (helm-multi-occur-1 buf-list input))) + +(provide 'helm-occur) + +;;; helm-occur.el ends here diff --git a/elpa/helm-20260424.1357/helm-packages.el b/elpa/helm-20260424.1357/helm-packages.el new file mode 100644 index 00000000..6ba40142 --- /dev/null +++ b/elpa/helm-20260424.1357/helm-packages.el @@ -0,0 +1,620 @@ +;;; helm-packages.el --- helm interface to manage packages -*- lexical-binding: t; -*- + +;; Copyright (C) 2012 ~ 2026 Thierry Volpiatto + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + + +;;; Code: + +(require 'cl-lib) +(require 'helm) +(require 'package) +(require 'finder) +(require 'helm-utils) ; For with-helm-display-marked-candidates. +(require 'async-package) + +(declare-function dired-async-mode-line-message "ext:dired-async.el") + + +;; Urls for cloning. +(defvar helm-packages-recipes-alist '(("melpa" . "https://melpa.org/packages/elpa-packages.eld") + ("gnu" . "https://elpa.gnu.org/packages/elpa-packages.eld") + ("nongnu" . "https://elpa.nongnu.org/nongnu/elpa-packages.eld")) + "Adresses where to find recipes or urls for packages.") + +;; Caches for recipes (elpa-packages.eld contents). +(defvar helm-packages--gnu-elpa-recipes-cache nil) +(defvar helm-packages--nongnu-elpa-recipes-cache nil) +(defvar helm-packages--melpa-recipes-cache nil) + +;; EmacsMirror +(defvar helm-packages-fallback-url-for-cloning "https://github.com/emacsmirror/%s") + + +(defgroup helm-packages nil + "Helm interface for package.el." + :group 'helm) + +(defclass helm-packages-class (helm-source-in-buffer) + ((coerce :initform #'helm-symbolify) + (find-file-target :initform #'helm-packages-quit-an-find-file) + (filtered-candidate-transformer + :initform + `(helm-packages-transformer + ,(lambda (candidates _source) + (sort candidates #'helm-generic-sort-fn)))) + (update :initform #'helm-packages--refresh-contents)) + "A class to define `helm-packages' sources.") + +(defcustom helm-packages-async t + "Install packages async when non nil." + :type 'boolean) + +(defcustom helm-package-install-upgrade-built-in + (bound-and-true-p package-install-upgrade-built-in) + "Allow upgrading builtin packages when non nil." + :type 'boolean) + +(defcustom helm-packages-isolate-fn (if (fboundp 'package-isolate) + #'package-isolate + #'helm-packages-isolate-1) + "The function to isolate package. +`package-isolate' is available only in emacs-30+." + :type 'function) + +(defcustom helm-packages-default-clone-directory nil + "Default directory where to clone packages." + :type 'string) + +(defcustom helm-packages-clone-after-hook nil + "Hook that run after cloning a package. +It is called with two args respectively PACKAGE as a string and DIRECTORY." + :type 'hook) + +(defcustom helm-packages-default-urls-for-cloning + '(("gnu" . "https://git.sv.gnu.org/git/elpa/gnu.git") + ("nongnu" . "https://git.sv.gnu.org/git/elpa/nongnu.git")) + "Urls used for packages not specifying :url in their recipes. +This is generally the packages maintained directly in Elpa or NonGnu." + :type '(alist :key-type string :value-type string)) + +;;; Actions +;; +;; +(defun helm-packages-upgrade (_candidate) + "Helm action for upgrading marked packages." + (let ((mkd (helm-marked-candidates)) + (error-file (expand-file-name + "helm-packages-upgrade-error.txt" + temporary-file-directory))) + (with-helm-display-marked-candidates + helm-marked-buffer-name + (mapcar #'symbol-name mkd) + (when (y-or-n-p (format "Upgrade %s packages? " (length mkd))) + (if helm-packages-async + (async-package-do-action 'upgrade mkd error-file) + (mapc #'package-upgrade mkd)))))) + +(defun helm-packages-describe (candidate) + "Helm action for describing package CANDIDATE." + (describe-package candidate)) + +(defun helm-packages-get-homepage-url (candidate) + "Get package CANDIDATE home page url." + (let* ((id (package-get-descriptor candidate)) + (extras (package-desc-extras id))) + (and (listp extras) (cdr-safe (assoc :url extras))))) + +(defun helm-packages-visit-homepage (candidate) + "Helm action for visiting package CANDIDATE home page." + (let ((url (helm-packages-get-homepage-url candidate))) + (if (stringp url) + (browse-url url) + (message "Package `%s' has no homepage" candidate)))) + +(defun helm-packages-package-reinstall (_candidate) + "Helm action for reinstalling marked packages." + (let ((mkd (helm-marked-candidates)) + (error-file (expand-file-name + "helm-packages-reinstall-error.txt" + temporary-file-directory))) + (with-helm-display-marked-candidates + helm-marked-buffer-name + (mapcar #'symbol-name mkd) + (when (y-or-n-p (format "Reinstall %s packages? " (length mkd))) + (if helm-packages-async + (async-package-do-action 'reinstall mkd error-file) + (mapc #'package-reinstall mkd)))))) + +(defun helm-packages-delete-1 (packages &optional force) + "Run `package-delete' on PACKAGES. +If FORCE is non nil force deleting packages." + (mapc (lambda (x) + (package-delete (package-get-descriptor x) force)) + packages)) + +(defun helm-packages-uninstall (_candidate) + "Helm action for uninstalling marked packages. +Unlike `helm-packages-delete' this will refuse to delete packages when they are +needed by others packages as dependencies." + (let ((mkd (helm-marked-candidates))) + (with-helm-display-marked-candidates + helm-marked-buffer-name + (mapcar #'symbol-name mkd) + (when (y-or-n-p (format "Uninstall %s packages? " (length mkd))) + (helm-packages-delete-1 mkd))))) + +(defun helm-packages-delete (_candidate) + "Helm action for deleting marked packages. +Unlike `helm-packages-uninstall' this delete packages even when they are needed +as dependencies." + (let ((mkd (helm-marked-candidates))) + (with-helm-display-marked-candidates + helm-marked-buffer-name + (mapcar #'symbol-name mkd) + (when (y-or-n-p (format "Delete %s packages? " (length mkd))) + (helm-packages-delete-1 mkd 'force))))) + +(defun helm-packages-recompile (_candidate) + "Helm action for recompiling marked packages." + (let ((mkd (helm-marked-candidates))) + (with-helm-display-marked-candidates + helm-marked-buffer-name + (mapcar #'symbol-name mkd) + (when (y-or-n-p (format "Recompile %s packages? " (length mkd))) + (mapc #'package-recompile mkd))))) + +(defun helm-packages-install--sync (packages) + (condition-case err + (mapc #'package-install packages) + (error "%S:\n Please refresh package list before installing" err))) + +(defun helm-packages-install (_candidate) + "Helm action for installing marked packages." + (let ((mkd (helm-marked-candidates)) + (error-file (expand-file-name + "helm-packages-install-error.txt" + temporary-file-directory))) + (with-helm-display-marked-candidates + helm-marked-buffer-name + (mapcar #'symbol-name mkd) + (when (y-or-n-p (format "Install %s packages? " (length mkd))) + (if helm-packages-async + (async-package-do-action 'install mkd error-file) + (helm-packages-install--sync mkd)))))) + +(defun helm-packages--get-deps (pkg) + "Recursively find PKG dependencies." + (let ((desc (cadr (assq pkg package-archive-contents)))) + (when desc + (cl-loop for req in (package-desc-reqs desc) ; (foo (1 2 3)) + for sym = (car req) + nconc (cons sym (helm-packages--get-deps sym)) into pkgs + finally return (helm-fast-remove-dups pkgs))))) + +(defun helm-packages-isolate-1 (packages &optional _ignore) + "Start an Emacs with only PACKAGES loaded. +Arg PACKAGES is a list of strings." + (let* ((name (concat "package-isolate-" (mapconcat #'identity packages "_"))) + (deps (cl-loop for p in packages + for sym = (intern p) + nconc (helm-packages--get-deps sym)))) + (apply #'start-process name nil + (list (expand-file-name invocation-name invocation-directory) + "-Q" "--debug-init" + (format "--eval=%S" + `(progn + (require 'package) + (setq package-load-list + ',(append (mapcar (lambda (p) (list (intern p) t)) + packages) + (mapcar (lambda (p) (list p t)) deps)) + package-user-dir ,package-user-dir + package-directory-list ',package-directory-list) + (package-initialize))))))) + +(defun helm-packages-isolate (_candidate) + "Start a new Emacs with only marked packages loaded." + (let* ((mkd (helm-marked-candidates)) + (pkg-names (mapcar #'symbol-name mkd))) + (with-helm-display-marked-candidates + helm-marked-buffer-name + pkg-names + (when (y-or-n-p "Start a new Emacs with only package(s)? ") + (funcall helm-packages-isolate-fn pkg-names helm-current-prefix-arg))))) + +(defun helm-packages-quit-an-find-file (source) + "`find-file-target' function for `helm-packages'." + (let* ((sel (helm-get-selection nil nil source)) + (pkg (package-get-descriptor (intern sel)))) + (if (and pkg (package-installed-p pkg)) + (expand-file-name (package-desc-dir pkg)) + package-user-dir))) + +;;; Cloning packages +;; +(defun helm-packages-fetch-recipe (url) + "Fetch package recipes from URL. +They are generally contained in a file named elpa-packages.eld on remote which +contains the urls needed for cloning packages, each entry is like +\(foo :url \"somewhere\") and may contain as well :branch." + (with-temp-buffer + (url-insert-file-contents url) + (goto-char (point-min)) + (let ((data (read (current-buffer)))) + ;; Recipes do not have the same form depending from + ;; where we fetch them, they may be like + ;; ((foo :url "somewhere") + ;; (bar :url "somewhere")) + ;; or + ;; (((foo :url "somewhere") + ;; (bar :url "somewhere")) + ;; :version "1" :else "") + (if (keywordp (cadr data)) (car data) data)))) + +(defun helm-packages-get-package-url (package provider) + "Get PACKAGE url from PROVIDER's recipe. +Returns a plist like (:url :branch ). +PROVIDER can be one of \"melpa\", \"gnu\" or \"nongnu\"." + (let* ((address (assoc-default provider helm-packages-recipes-alist)) + (cache (helm-acase provider + ("gnu" 'helm-packages--gnu-elpa-recipes-cache) + ("nongnu" 'helm-packages--nongnu-elpa-recipes-cache) + ("melpa" 'helm-packages--melpa-recipes-cache))) + (recipe (or (symbol-value cache) + (set cache (helm-packages-fetch-recipe address)))) + (package-recipe (assq package recipe)) + (core (plist-get (cdr package-recipe) :core)) + (url (or (plist-get (cdr package-recipe) :url) + ;; Assume that when :url = nil the package is maintained in + ;; elpa or nongnu. When recipe is fetched from package-archives + ;; addresses, the url is always specified or the package if not + ;; clonable, not present at all e.g. cond-star. + (assoc-default provider helm-packages-default-urls-for-cloning))) + (branch (plist-get (cdr package-recipe) :branch))) + (cl-assert package-recipe nil (format "Couldn't find package '%s'" package)) + (cl-assert (null core) nil + (format "Package '%s' already provided in Emacs at '%s'" + package core)) + (unless (stringp url) + ;; Sometimes the recipe for a package refers to the same url as another + ;; package by setting :url to the name of this package (symbol) e.g. + ;; In nongnu recipe, we have: + ;; (helm :url "https://...") and (helm-core :url helm) + (setq url (and url (plist-get (cdr (assq url recipe)) :url)))) + `(:url ,url :branch ,branch))) + +(defun helm-packages-get-provider (package) + (let ((desc (assq package package-archive-contents))) + (package-desc-archive (cadr desc)))) + +(defun helm-packages-get-recipe-for-cloning (package) + (let ((provider (helm-packages-get-provider package))) + (helm-packages-get-package-url package provider))) + +(defun helm-packages-clone-package (package) + "Git clone PACKAGE." + (let* ((name (symbol-name package)) + (directory (read-directory-name + "Clone in directory: " + helm-packages-default-clone-directory nil t)) + (recipe (helm-packages-get-recipe-for-cloning package)) + (url (plist-get recipe :url)) + (branch (plist-get recipe :branch)) + ;; In gnu archive all packages maintained on Elpa are pointing to + ;; "https://git.sv.gnu.org/git/emacs/elpa.git", to be able to clone a + ;; package from such url we have to use: + ;; git clone --single-branch -b externals/ URL PACKAGE-NAME. + ;; This create a directory named PACKAGE-NAME with only PACKAGE inside. + ;; If PACKAGE-NAME is ommited this create a repo named elpa which clash if + ;; such a dir already exists. Another case is packages coming either + ;; from nongnu or melpa giving the nongnu url as :url and specifying a + ;; branch, example: + ;; (ws-butler :url "https://git.savannah.gnu.org/git/emacs/nongnu.git" + ;; :branch "elpa/ws-butler") + (switches (append + (if (string-match "\\(elpa\\|nongnu\\|gnu\\)\\.git\\'" url) + `("clone" "--single-branch" + "-b" ,(or branch (format "externals/%s" package))) + (delq nil `("clone" ,(and branch "-b") ,branch))) + `(,url ,name)))) + (cl-assert (not (file-directory-p (expand-file-name name directory))) + nil (format "Package already exists in %s" directory)) + (with-helm-default-directory directory + (let* (process-connection-type + (proc (apply #'start-process + "git" "*helm packages clone*" + "git" switches))) + (save-selected-window + (display-buffer (process-buffer proc) + '(display-buffer-below-selected + (window-height . fit-window-to-buffer) + (preserve-size . (nil . t))))) + (set-process-filter proc #'helm-packages--clone-filter-process) + (set-process-sentinel + proc (lambda (proc event) + (let ((status (process-exit-status proc))) + (if (string= event "finished\n") + (message "Cloning package %s done" package) + (message "Cloning package %s failed" package)) + (when (= status 0) + (quit-window t (get-buffer-window (process-buffer proc))) + (run-hook-with-args + 'helm-packages-clone-after-hook + (symbol-name package) directory))))) + (message "Cloning package %s..." package))))) + +(defun helm-packages--clone-filter-process (proc string) + (when (buffer-live-p (process-buffer proc)) + (with-current-buffer (process-buffer proc) + (erase-buffer) + (insert (car (split-string string " ")))))) + +;;; Transformers +;; +;; +(defun helm-packages-transformer (candidates _source) + "Transformer function for `helm-packages'." + (cl-loop with lgst_arch = (cl-loop for (arch . _) in package-archives + maximize (length arch)) + for c in candidates + for sym = (intern-soft c) + for archive = (assq sym package-archive-contents) + for id = (package-get-descriptor sym) + for provider = (if archive + (package-desc-archive (cadr archive)) + (and (assq sym package--builtins) "emacs")) + for status = (if id + (package-desc-status id) + (and (assq sym package--builtins) "Built-in")) + for version = (if id + (mapconcat #'number-to-string (package-desc-version id) ".") + (or (helm-aand (assq sym package--builtins) + (aref (cdr it) 0) + (package-version-join it)) + "---")) + for description = (if id + (package-desc-summary id) + (helm-aand (assq sym package--builtins) + (aref (cdr it) 2))) + for disp = (format "%s%s%s%s%s%s%s%s%s" + ;; Package name. + (propertize + c + 'face + (helm-acase status + ("dependency" 'font-lock-type-face) + ("disabled" 'default) + (t 'font-lock-keyword-face)) + 'match-part c) + ;; Separator. + (helm-make-separator c) + ;; Package status. + (propertize + (or status "") + 'face (helm-acase status + ("dependency" 'bold-italic) + ("disabled" 'font-lock-property-name-face) + (t 'default))) + ;; Separator. + (helm-make-separator status 10) + ;; Package provider. + (or provider "") + ;; Separator. + (helm-make-separator provider lgst_arch) + ;; Package version. + (or version "") + ;; Separator. + (helm-make-separator version 20) + ;; Package description. + (if description + (propertize description 'face 'font-lock-warning-face) + "")) + collect (cons disp c))) + +(defun helm-packages-transformer-1 (candidates _source) + "Transformer function for `helm-packages' upgrade and delete sources." + (cl-loop for c in candidates + collect (cons (propertize c 'face 'font-lock-keyword-face) c))) + +(defvar helm-packages--updated nil) +(defun helm-packages--refresh-contents () + (unless helm-packages--updated + (setq helm-packages--gnu-elpa-recipes-cache nil + helm-packages--nongnu-elpa-recipes-cache nil + helm-packages--melpa-recipes-cache nil) + (setq package-menu--old-archive-contents package-archive-contents) + (setq package-menu--new-package-list nil) + (package-refresh-contents) + (package-menu--populate-new-package-list)) + (helm-set-local-variable 'helm-packages--updated t)) + +(defun helm-finder--list-matches (key) + (let* ((id (intern key)) + (built-in (gethash id finder-keywords-hash)) + (exts (cl-loop for p in package-archive-contents + for sym = (car p) + when (package--has-keyword-p + (package-get-descriptor sym) + (list key)) + collect sym))) + (unless (or exts built-in) + (error "No packages matching key `%s'" key)) + (nconc exts built-in))) + +(defun helm-finder-packages-from-keyword (candidate) + (if (string-match "\\.el$" candidate) + (finder-commentary candidate) + (helm :sources + (helm-make-source "packages" 'helm-packages-class + :header-name (lambda (name) (format "%s (%s)" name candidate)) + :init (lambda () + (helm-init-candidates-in-buffer + 'global (helm-fast-remove-dups + (helm-finder--list-matches candidate)))) + :filtered-candidate-transformer + `(helm-packages-transformer + ,(lambda (candidates _source) + (sort candidates #'helm-generic-sort-fn))) + :action-transformer + (lambda (actions candidate) + (if (package-installed-p candidate) + actions + (append actions + '(("Install packages(s)" + . helm-packages-install))))) + :action '(("Describe package" . helm-packages-describe) + ("Visit homepage" . helm-packages-visit-homepage) + ("Clone package" . helm-packages-clone-package))) + :buffer "*helm finder results*"))) + +(defun helm-package--upgradeable-packages (&optional include-builtins) + ;; Initialize the package system to get the list of package + ;; symbols for completion. + (package--archives-initialize) + (let ((pkgs (if include-builtins + (append package-alist + (cl-loop for (sym . vec) in package--builtins + when (not (assq sym package-alist)) + nconc (list (list sym (package--from-builtin + (cons sym vec)))))) + package-alist))) + (cl-loop for (sym desc) in pkgs + for pkg = (assq sym package-archive-contents) + for cversion = (and pkg (package-desc-version desc)) + for available = (and pkg (not (package-disabled-p sym cversion)) pkg) + ;; Exclude packages installed with package-vc (issue#2692). + when (and available + (not (package-vc-p desc)) + (or (and include-builtins (not cversion)) + (and cversion + (version-list-< + cversion + (package-desc-version (cadr available)))))) + collect sym))) + +;;;###autoload +(defun helm-packages (&optional arg) + "Helm interface to manage packages. + +With a prefix arg ARG refresh package list. + +When installing or upgrading ensure to refresh the package list +to avoid errors with outdated packages no more availables." + (interactive "P") + (package-initialize) + (when arg (helm-packages--refresh-contents)) + (let ((upgrades (helm-package--upgradeable-packages + helm-package-install-upgrade-built-in)) + (removables (package--removable-packages)) + (standard-actions '(("Describe package" . helm-packages-describe) + ("Visit homepage" . helm-packages-visit-homepage) + ("Install packages(s)" . helm-packages-install) + ("Clone package" . helm-packages-clone-package)))) + (helm :sources (list + (helm-make-source "Availables for upgrade" 'helm-packages-class + :init (lambda () + (helm-init-candidates-in-buffer 'global upgrades)) + :filtered-candidate-transformer #'helm-packages-transformer-1 + :action '(("Upgrade package(s)" + . helm-packages-upgrade))) + (helm-make-source "Packages to delete" 'helm-packages-class + :init (lambda () + (helm-init-candidates-in-buffer 'global removables)) + :filtered-candidate-transformer #'helm-packages-transformer-1 + :action '(("Delete package(s)" . helm-packages-delete))) + (helm-make-source "Installed packages" 'helm-packages-class + :init (lambda () + (helm-init-candidates-in-buffer 'global + (mapcar #'car package-alist))) + :action '(("Describe package" . helm-packages-describe) + ("Visit homepage" . helm-packages-visit-homepage) + ("Reinstall package(s)" + . helm-packages-package-reinstall) + ("Recompile package(s)" . helm-packages-recompile) + ("Uninstall package(s)" . helm-packages-uninstall) + ("Isolate package(s)" . helm-packages-isolate) + ("Clone package" . helm-packages-clone-package))) + (helm-make-source "New packages" 'helm-packages-class + :data (lambda () + (cl-loop for p in package-archive-contents + for sym = (car p) + for id = (package-get-descriptor sym) + for status = (and id (package-desc-status id)) + when (equal status "new") + nconc (list (car p)))) + :action standard-actions) + (helm-make-source "Available external packages" 'helm-packages-class + :data (lambda () + (cl-loop for p in package-archive-contents + for sym = (car p) + for id = (package-get-descriptor sym) + for status = (package-desc-status id) + unless (or (and id (member + status + '("new" "installed" + "dependency" "source"))) + (and id (assoc sym package--builtins))) + nconc (list (car p)))) + :action standard-actions) + (helm-make-source "Available built-in packages" 'helm-packages-class + :data (lambda () + (cl-loop for p in package--builtins + ;; Show only builtins that are available as + ;; well on (m)elpa. Other builtins don't + ;; have a package-descriptor, the format is + ;; (sym . [version reqs summary]). + when (package-desc-p (package-get-descriptor (car p))) + collect (car p))) + :action (remove (assoc "Clone package" standard-actions) + standard-actions))) + :buffer "*helm packages*"))) + +;;;###autoload +(defun helm-finder (&optional arg) + "Helm interface to find packages by keywords with `finder'. +To have more actions on packages, use `helm-packages'." + (interactive "P") + (package-initialize) + (when arg (helm-packages--refresh-contents)) + (helm :sources + (helm-build-in-buffer-source "helm finder" + :data (cl-loop for p in package-archive-contents + for sym = (car p) + for desc = (package-get-descriptor sym) + nconc (copy-sequence (package-desc--keywords desc)) into keywords + finally return (helm-fast-remove-dups keywords :test 'equal)) + :filtered-candidate-transformer + (list + (lambda (candidates _source) + (cl-loop for cand in candidates + for desc = (or (assoc-default (intern-soft cand) finder-known-keywords) + cand) + for sep = (helm-make-separator cand) + for disp = (helm-aand (propertize desc 'face 'font-lock-warning-face) + (propertize " " 'display (concat sep it)) + (concat cand it)) + collect (cons disp cand))) + (lambda (candidates _source) + (sort candidates #'helm-generic-sort-fn))) + :action (helm-make-actions + "Packages from keyword" 'helm-finder-packages-from-keyword) + :persistent-action 'ignore + :persistent-help "Do nothing") + :buffer "*helm finder*")) + +(provide 'helm-packages) + +;;; helm-packages.el ends here diff --git a/elpa/helm-20260424.1357/helm-pkg.el b/elpa/helm-20260424.1357/helm-pkg.el new file mode 100644 index 00000000..f8a30d86 --- /dev/null +++ b/elpa/helm-20260424.1357/helm-pkg.el @@ -0,0 +1,11 @@ +;; -*- no-byte-compile: t; lexical-binding: nil -*- +(define-package "helm" "20260424.1357" + "Helm is an Emacs incremental and narrowing framework." + '((helm-core "4.0.7") + (wfnames "1.2")) + :url "https://emacs-helm.github.io/helm/" + :commit "3cd5097285dc10ac0898cf6f30c9699c3399e421" + :revdesc "3cd5097285dc" + :keywords '("helm" "convenience" "files" "buffers" "grep" "completion" "lisp" "matching" "tools" "help") + :authors '(("Thierry Volpiatto" . "thievol@posteo.net")) + :maintainers '(("Thierry Volpiatto" . "thievol@posteo.net"))) diff --git a/elpa/helm-20260424.1357/helm-regexp.el b/elpa/helm-20260424.1357/helm-regexp.el new file mode 100644 index 00000000..13fb0bd9 --- /dev/null +++ b/elpa/helm-20260424.1357/helm-regexp.el @@ -0,0 +1,132 @@ +;;; helm-regexp.el --- In buffer regexp searching and replacement for helm. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2026 Thierry Volpiatto + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Code: + +(require 'cl-lib) +(require 'helm) +(require 'helm-help) +(require 'helm-utils) + +(declare-function helm-mm-split-pattern "helm-multi-match") + + +(defgroup helm-regexp nil + "Regexp related Applications and libraries for Helm." + :group 'helm) + + + +;; History vars +(defvar helm-build-regexp-history nil) + +(defun helm-query-replace-regexp (_candidate) + "Query replace regexp from `helm-regexp'. +With a prefix arg replace only matches surrounded by word boundaries, +i.e. don't replace inside a word, regexp is surrounded with \\bregexp\\b." + (let ((regexp helm-input)) + (apply 'query-replace-regexp + (helm-query-replace-args regexp)))) + +(defun helm-kill-regexp-as-sexp (_candidate) + "Kill regexp in a format usable in lisp code." + (helm-regexp-kill-new + (prin1-to-string helm-input))) + +(defun helm-kill-regexp (_candidate) + "Kill regexp as it is in `helm-pattern'." + (helm-regexp-kill-new helm-input)) + +(defun helm-query-replace-args (regexp) + "Create arguments of `query-replace-regexp' action in `helm-regexp'." + (let ((region-only (helm-region-active-p))) + (list + regexp + (query-replace-read-to regexp + (format "Query replace %sregexp %s" + (if helm-current-prefix-arg "word " "") + (if region-only "in region " "")) + t) + helm-current-prefix-arg + (when region-only (region-beginning)) + (when region-only (region-end))))) + +(defvar helm-source-regexp + (helm-build-in-buffer-source "Regexp Builder" + :init (lambda () + (helm-init-candidates-in-buffer + 'global (with-temp-buffer + (insert-buffer-substring helm-current-buffer) + (buffer-string)))) + :get-line #'helm-regexp-get-line + :persistent-action #'helm-regexp-persistent-action + :persistent-help "Show this line" + :multiline t + :multimatch nil + :requires-pattern 2 + :group 'helm-regexp + :mode-line "Press TAB to select action." + :action '(("Kill Regexp as sexp" . helm-kill-regexp-as-sexp) + ("Query Replace Regexp (C-u Not inside word.)" + . helm-query-replace-regexp) + ("Kill Regexp" . helm-kill-regexp)))) + +(defun helm-regexp-get-line (s e) + (let ((matches (match-data)) + (line (buffer-substring s e))) + (propertize + (cl-loop with ln = (format "%5d: %s" (1- (line-number-at-pos s)) line) + for i from 0 to (1- (/ (length matches) 2)) + if (match-string i) + concat (format "\n%s%s'%s'" + (make-string 10 ? ) (format "Group %d: " i) it) + into ln1 + finally return (concat ln ln1)) + 'helm-realvalue s))) + +(defun helm-regexp-persistent-action (pt) + (helm-goto-char pt) + (helm-highlight-current-line)) + +(defun helm-regexp-kill-new (input) + (kill-new (substring-no-properties input)) + (message "Killed: %s" input)) + + +;;; Predefined commands +;; +;; + +;;;###autoload +(defun helm-regexp () + "Preconfigured helm to build regexps. +`query-replace-regexp' can be run from there against found regexp." + (interactive) + (save-restriction + (when (and (helm-region-active-p) + ;; Don't narrow to region if buffer is already narrowed. + (not (helm-current-buffer-narrowed-p (current-buffer)))) + (narrow-to-region (region-beginning) (region-end))) + (helm :sources helm-source-regexp + :buffer "*helm regexp*" + :prompt "Regexp: " + :history 'helm-build-regexp-history))) + + +(provide 'helm-regexp) + +;;; helm-regexp.el ends here diff --git a/elpa/helm-20260424.1357/helm-ring.el b/elpa/helm-20260424.1357/helm-ring.el new file mode 100644 index 00000000..d42bd89b --- /dev/null +++ b/elpa/helm-20260424.1357/helm-ring.el @@ -0,0 +1,644 @@ +;;; helm-ring.el --- kill-ring, mark-ring, and register browsers for helm. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2026 Thierry Volpiatto + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Code: + +(require 'cl-lib) +(require 'helm) +(require 'helm-utils) +(require 'helm-help) +(require 'helm-elisp) + +(declare-function undo-tree-restore-state-from-register "ext:undo-tree.el" (register)) +(declare-function kmacro--keys "kmacro.el") +(declare-function frameset-register-p "frameset") + +(defgroup helm-ring nil + "Ring related Applications and libraries for Helm." + :group 'helm) + +(defcustom helm-kill-ring-threshold 3 + "Minimum length of a candidate to be listed by `helm-source-kill-ring'." + :type 'integer + :group 'helm-ring) + +(defcustom helm-kill-ring-max-offset 400 + "Max number of chars displayed per candidate in kill-ring browser. +When `t', don't truncate candidate, show all. +By default it is approximatively the number of bits contained in five lines +of 80 chars each, i.e. 80*5. +Note that if you set this to nil multiline will be disabled, i.e. you +will not have separators between candidates any more." + :type '(choice (const :tag "Disabled" t) + (integer :tag "Max candidate offset")) + :group 'helm-ring) + +(defcustom helm-kill-ring-actions + '(("Yank marked" . helm-kill-ring-action-yank) + ("Delete marked" . helm-kill-ring-action-delete) + ("Search from candidate" . helm-kill-ring-search-from-string)) + "List of actions for kill ring source." + :group 'helm-ring + :type '(alist :key-type string :value-type function)) + +(defcustom helm-kill-ring-separator "\n" + "The separator used to separate marked candidates when yanking." + :group 'helm-ring + :type 'string) + +(defcustom helm-register-max-offset 160 + "Max size of string register entries before truncating." + :group 'helm-ring + :type 'integer) + +;;; Kill ring +;; +;; +(defvar helm-kill-ring-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (define-key map (kbd "M-y") 'helm-next-line) + (define-key map (kbd "M-u") 'helm-previous-line) + (define-key map (kbd "M-D") 'helm-kill-ring-delete) + (define-key map (kbd "C-s") 'helm-kill-ring-run-search-from-string) + (define-key map (kbd "C-]") 'helm-kill-ring-toggle-truncated) + (define-key map (kbd "C-c C-k") 'helm-kill-ring-kill-selection) + (define-key map (kbd "C-c d") 'helm-kill-ring-run-persistent-delete) + map) + "Keymap for `helm-show-kill-ring'.") + +(defvar helm-source-kill-ring + (helm-build-sync-source "Kill Ring" + :init (lambda () + (helm-set-attr 'last-command last-command) + (helm-set-attr 'multiline helm-kill-ring-max-offset)) + :candidates #'helm-kill-ring-candidates + :filtered-candidate-transformer #'helm-kill-ring-transformer + :action 'helm-kill-ring-actions + :persistent-action 'ignore + :help-message 'helm-kill-ring-help-message + :persistent-help "DoNothing" + :keymap helm-kill-ring-map + :migemo t + :multiline 'helm-kill-ring-max-offset + :group 'helm-ring) + "Source for browse and insert contents of kill-ring.") + +(defun helm-kill-ring-candidates () + (cl-loop with cands = (helm-fast-remove-dups kill-ring :test 'equal) + for kill in (if (eq (helm-get-attr 'last-command) 'yank) + (cdr cands) + cands) + unless (or (< (length kill) helm-kill-ring-threshold) + (string-match "\\`[\n[:blank:]]+\\'" kill)) + collect kill)) + +(defun helm-kill-ring-transformer (candidates _source) + "Ensure CANDIDATES are not read-only." + (cl-loop for i in candidates + when (get-text-property 0 'read-only i) + do (set-text-properties 0 (length i) '(read-only nil) i) + collect i)) + +(defvar helm-kill-ring--truncated-flag nil) +(defun helm-kill-ring-toggle-truncated () + "Toggle truncated view of candidates in helm kill-ring browser." + (interactive) + (with-helm-alive-p + (setq helm-kill-ring--truncated-flag (not helm-kill-ring--truncated-flag)) + (let* ((cur-cand (helm-get-selection)) + (presel-fn (lambda () + (helm-kill-ring--preselect-fn cur-cand))) + helm-display-source-at-screen-top) + (helm-set-attr 'multiline + (if helm-kill-ring--truncated-flag + 15000000 + helm-kill-ring-max-offset)) + (helm-update presel-fn)))) +(put 'helm-kill-ring-toggle-truncated 'helm-only t) + +(defun helm-kill-ring-kill-selection () + "Store the real value of candidate in kill-ring. +Same as `helm-kill-selection-and-quit' called with a prefix arg." + (interactive) + (helm-kill-selection-and-quit t)) +(put 'helm-kill-ring-kill-selection 'helm-only t) + +(defun helm-kill-ring--preselect-fn (candidate) + "Internal, used to preselect CANDIDATE when toggling truncated view." + ;; Preselection by regexp may not work if candidate is huge, so walk + ;; the helm buffer until selection is on CANDIDATE. + (helm-awhile (condition-case-unless-debug nil + (and (not (helm-pos-header-line-p)) + (helm-get-selection)) + (error nil)) + (if (string= it candidate) + (cl-return) + (helm-next-line)))) + +(defun helm-kill-ring-action-yank (_str) + "Insert concatenated marked candidates in current-buffer. + +When two prefix args are given prompt to choose separator, otherwise +use `helm-kill-ring-separator' as default." + (let ((marked (helm-marked-candidates)) + (sep (if (equal helm-current-prefix-arg '(16)) + (read-string "Separator: ") + helm-kill-ring-separator))) + (helm-kill-ring-action-yank-1 + (cl-loop for c in (butlast marked) + concat (concat c sep) into str + finally return (concat str (car (last marked))))))) + +(defun helm-kill-ring-action-yank-1 (str) + "Insert STR in `kill-ring' and set STR to the head. + +When called with a prefix arg, point and mark are exchanged +without activating region. +If this action is executed just after `yank', replace with STR as +yanked string." + (let ((yank-fn (lambda (&optional before yank-pop) + (insert-for-yank str) + ;; Set the window start back where it was in + ;; the yank command, if possible. + (when yank-pop + (set-window-start (selected-window) yank-window-start t)) + (when (or (equal helm-current-prefix-arg '(4)) before) + ;; Same as exchange-point-and-mark but without + ;; activating region. + (goto-char (prog1 (mark t) + (set-marker (mark-marker) + (point) + helm-current-buffer))))))) + ;; Prevent inserting and saving highlighted items. + (set-text-properties 0 (length str) nil str) + (with-helm-current-buffer + (unwind-protect + (progn + (setq kill-ring (delete str kill-ring)) + ;; Adding a `delete-selection' property + ;; to `helm-kill-ring-action' is not working + ;; because `this-command' will be `helm-maybe-exit-minibuffer', + ;; so use this workaround (Bug#1520). + (when (and (region-active-p) delete-selection-mode) + (delete-region (region-beginning) (region-end))) + (if (not (eq (helm-get-attr 'last-command helm-source-kill-ring) 'yank)) + (progn + ;; Ensure mark is at beginning of inserted text. + (push-mark) + ;; When yanking in a helm minibuffer we need a small + ;; delay to detect the mark in previous minibuffer. [1] + (run-with-timer 0.01 nil yank-fn)) + ;; from `yank-pop' + (let ((inhibit-read-only t) + (before (< (point) (mark t)))) + (if before + (funcall (or yank-undo-function 'delete-region) (point) (mark t)) + (funcall (or yank-undo-function 'delete-region) (mark t) (point))) + (setq yank-undo-function nil) + (set-marker (mark-marker) (point) helm-current-buffer) + ;; Same as [1] but use the same mark and point as in + ;; the initial yank according to BEFORE even if no + ;; prefix arg is given. + (run-with-timer 0.01 nil yank-fn before 'pop)))) + (kill-new str))))) +(define-obsolete-function-alias 'helm-kill-ring-action 'helm-kill-ring-action-yank "2.4.0") + +(defun helm-kill-ring-search-from-string (candidate) + (let ((str (car (split-string candidate "\n")))) + (helm-multi-occur-1 + (list (current-buffer)) + (regexp-quote (substring-no-properties str))))) + +(helm-make-command-from-action helm-kill-ring-run-search-from-string + "Run helm-occur from kill ring." + 'helm-kill-ring-search-from-string) + +(defun helm-kill-ring-action-delete (_candidate) + "Delete marked candidates from `kill-ring'." + (cl-loop for c in (helm-marked-candidates) + do (setq kill-ring + (delete c kill-ring)))) + +(defun helm-kill-ring-persistent-delete (_candidate) + (unwind-protect + (cl-loop for c in (helm-marked-candidates) + do (progn + (helm-preselect (format "^%s" (regexp-quote c))) + (setq kill-ring (delete c kill-ring)) + (helm-delete-current-selection) + (helm--remove-marked-and-update-mode-line c))) + (with-helm-buffer + (setq helm-marked-candidates nil + helm-visible-mark-overlays nil)) + (helm-force-update (helm-aif (helm-get-selection nil t) (regexp-quote it))))) + +(helm-make-persistent-command-from-action helm-kill-ring-run-persistent-delete + "Delete current candidate without quitting." + 'quick-delete 'helm-kill-ring-persistent-delete) + +(helm-make-command-from-action helm-kill-ring-delete + "Delete marked candidates from `kill-ring'." + 'helm-kill-ring-action-delete) + + +;;;; +;; DO NOT use these sources with other sources use +;; the commands `helm-mark-ring', `helm-global-mark-ring' or +;; `helm-all-mark-rings' instead. + +(defun helm-mark-ring-line-string-at-pos (pos) + "Return line string at position POS." + (save-excursion + (goto-char pos) + (forward-line 0) + (let ((line (car (split-string (thing-at-point 'line) "[\n\r]")))) + (remove-text-properties 0 (length line) '(read-only) line) + (if (string= "" line) + "" + line)))) + +(defun helm-mark-ring-get-candidates () + (with-helm-current-buffer + (cl-loop with marks = (if (mark t) + (cons (mark-marker) mark-ring) + mark-ring) + for marker in marks + with max-line-number = (line-number-at-pos (point-max)) + with width = (length (number-to-string max-line-number)) + for m = (format (concat "%" (number-to-string width) "d: %s") + (line-number-at-pos marker) + (helm-mark-ring-line-string-at-pos marker)) + unless (and recip (assoc m recip)) + collect (cons m marker) into recip + finally return recip))) + +(defun helm-mark-ring-default-action (candidate) + (let ((target (copy-marker candidate))) + (helm-aif (marker-buffer candidate) + (progn + (switch-to-buffer it) + (with-selected-window (get-buffer-window it) + (unless helm-in-persistent-action + (helm-log-run-hook + "helm-mark-ring-default-action" 'helm-goto-line-before-hook)) + (helm-match-line-cleanup) + (unless helm-yank-point (setq helm-yank-point (point))) + (helm-goto-char target) + (helm-highlight-current-line))) + ;; marker points to no buffer, no need to dereference it, just + ;; delete it. + (setq mark-ring (delete target mark-ring)) + (error "Marker points to no buffer")))) + +(defvar helm-source-mark-ring + (helm-build-sync-source "mark-ring" + :candidates #'helm-mark-ring-get-candidates + :action '(("Goto line" . helm-mark-ring-default-action)) + :persistent-help "Show this line" + :group 'helm-ring)) + +;;; Global-mark-ring +(defvar helm-source-global-mark-ring + (helm-build-sync-source "global-mark-ring" + :candidates #'helm-global-mark-ring-get-candidates + :action '(("Goto line" . helm-mark-ring-default-action)) + :persistent-help "Show this line" + :group 'helm-ring)) + +(defun helm-global-mark-ring-format-buffer (marker) + (with-current-buffer (marker-buffer marker) + (goto-char marker) + (forward-line 0) + (let ((line (helm-acase (thing-at-point 'line) + ((guard* (and (stringp it) + (not (string-match-p "\\`\n?\\'" it)))) + (car (split-string it "[\n\r]"))) + (t "")))) + (remove-text-properties 0 (length line) '(read-only) line) + (format "%7d:%s: %s" + (line-number-at-pos) (marker-buffer marker) line)))) + +(defun helm-global-mark-ring-get-candidates () + (let ((marks global-mark-ring)) + (when marks + (cl-loop for marker in marks + for mb = (marker-buffer marker) + for gm = (unless (or (string-match "^ " (format "%s" mb)) + (null mb)) + (helm-global-mark-ring-format-buffer marker)) + when (and gm (not (assoc gm recip))) + collect (cons gm marker) into recip + finally return recip)))) + +;;;; +;;; Insert from register +(defvar helm-source-register + (helm-build-sync-source "Registers" + :candidates #'helm-register-candidates + :action-transformer #'helm-register-action-transformer + :persistent-help "" + :multiline t + :action '(("Delete Register(s)" . + (lambda (_candidate) + (cl-loop for candidate in (helm-marked-candidates) + for register = (car candidate) + do (setq register-alist + (delq (assoc register register-alist) + register-alist)))))) + :group 'helm-ring) + "See (info \"(emacs)Registers\")") + +(defun helm-register-candidates () + "Collecting register contents and appropriate commands." + (require 'frameset) + (cl-loop for (char . rval) in register-alist + for key = (single-key-description char) + for e27 = (registerv-p rval) + for val = (if e27 ; emacs-27 + (registerv-data rval) + rval) + for string-actions = + (cond + ((numberp val) + (list (int-to-string val) + 'insert-register + 'increment-register)) + ((markerp val) + (let ((buf (marker-buffer val))) + (if (null buf) + (list "a marker in no buffer") + (list (concat + "a buffer position:" + (buffer-name buf) + ", position " + (int-to-string (marker-position val))) + 'jump-to-register + 'insert-register)))) + ((and (consp val) (window-configuration-p (car val))) + (list (if (fboundp 'describe-register-1) + (describe-register-1 char) "window configuration.") + 'jump-to-register)) + ((and (vectorp val) + (fboundp 'undo-tree-register-data-p) + (undo-tree-register-data-p (if e27 val (elt val 1)))) + (list + "Undo-tree entry." + 'undo-tree-restore-state-from-register)) + ((or (and (vectorp val) (eq 'registerv (aref val 0))) + (and (consp val) (frame-configuration-p (car val))) + (or (frame-configuration-p val) + (frameset-register-p val))) + (list (if (fboundp 'describe-register-1) + (describe-register-1 char) "Frame configuration") + 'jump-to-register)) + ((and (consp val) (eq (car val) 'file)) + (list (concat "file:" + (prin1-to-string (cdr val)) + ".") + 'jump-to-register)) + ((and (consp val) (eq (car val) 'buffer)) + (list (concat "buffer:" + (prin1-to-string (cdr val)) + ".") + 'jump-to-register)) + ((and (consp val) (eq (car val) 'file-query)) + (list (concat "file:a file-query reference: file " + (car (cdr val)) + ", position " + (int-to-string (car (cdr (cdr val)))) + ".") + 'jump-to-register)) + ((consp val) + (let ((lines (format "%4d" (length val)))) + (list (format "%s: %s\n" lines + (truncate-string-to-width + (mapconcat 'identity (list (car val)) + "^J") + (- (window-width) 15))) + 'insert-register))) + ((stringp val) + (list + (concat (substring-no-properties + val 0 (min (length val) helm-register-max-offset)) + (if (> (length val) helm-register-max-offset) + "[...]" "")) + 'insert-register + 'kill-new + 'append-to-register + 'prepend-to-register))) + unless (null string-actions) ; Fix Bug#1107. + collect (cons (format "Register %3s:\n %s" key (car string-actions)) + (cons char (cdr string-actions))))) + +(defun helm-register-action-transformer (actions register-and-functions) + "Decide actions by the contents of register." + (cl-loop with func-actions = + '((insert-register + "Insert Register" . + (lambda (c) (insert-register (car c)))) + (kill-new + "Kill Register" . + (lambda (c) (with-temp-buffer + (insert-register (car c)) + (kill-new (buffer-string))))) + (jump-to-register + "Jump to Register" . + (lambda (c) (jump-to-register (car c)))) + (append-to-register + "Append Region to Register" . + (lambda (c) (append-to-register + (car c) (region-beginning) (region-end)))) + (prepend-to-register + "Prepend Region to Register" . + (lambda (c) (prepend-to-register + (car c) (region-beginning) (region-end)))) + (increment-register + "Increment Prefix Arg to Register" . + (lambda (c) (increment-register + helm-current-prefix-arg (car c)))) + (undo-tree-restore-state-from-register + "Restore Undo-tree register" . + (lambda (c) (and (fboundp 'undo-tree-restore-state-from-register) + (undo-tree-restore-state-from-register (car c)))))) + for func in (cdr register-and-functions) + when (assq func func-actions) + collect (cdr it) into transformer-actions + finally return (append transformer-actions actions))) + +;;;###autoload +(defun helm-mark-ring () + "Preconfigured `helm' for `helm-source-mark-ring'." + (interactive) + (helm :sources 'helm-source-mark-ring + :resume 'noresume + :buffer "*helm mark*")) + +;;;###autoload +(defun helm-global-mark-ring () + "Preconfigured `helm' for `helm-source-global-mark-ring'." + (interactive) + (helm :sources 'helm-source-global-mark-ring + :resume 'noresume + :buffer "*helm global mark*")) + +;;;###autoload +(defun helm-all-mark-rings () + "Preconfigured `helm' for mark rings. +Source used are `helm-source-global-mark-ring' and +`helm-source-mark-ring'." + (interactive) + (helm :sources '(helm-source-mark-ring + helm-source-global-mark-ring) + :resume 'noresume + :buffer "*helm mark ring*")) + +;;;###autoload +(defun helm-register () + "Preconfigured `helm' for Emacs registers." + (interactive) + (helm :sources 'helm-source-register + :resume 'noresume + :buffer "*helm register*")) + +;;;###autoload +(defun helm-show-kill-ring () + "Preconfigured `helm' for `kill-ring'. +It is drop-in replacement of `yank-pop'. + +First call open the kill-ring browser, next calls move to next line." + (interactive) + (setq helm-kill-ring--truncated-flag nil) + (let ((enable-recursive-minibuffers t)) + (helm :sources helm-source-kill-ring + :buffer "*helm kill ring*" + ;; :display-source-at-screen-top nil + :resume 'noresume + :allow-nest t))) + +;;;###autoload +(defun helm-execute-kmacro () + "Preconfigured helm for keyboard macros. +Define your macros with `f3' and `f4'. +See (info \"(emacs) Keyboard Macros\") for detailed infos." + (interactive) + (let ((helm-quit-if-no-candidate + (lambda () (message "No kbd macro has been defined")))) + (helm :sources + (helm-build-sync-source "Kmacro" + :candidates (lambda () + (delq nil + (helm-fast-remove-dups + (cons (kmacro-ring-head) + kmacro-ring) + :test 'equal))) + + :multiline t + :candidate-transformer + (lambda (candidates) + (cl-loop for c in candidates + for keys = (if (functionp c) + ;; Emacs-29+ (Oclosure). + (kmacro--keys c) + ;; Emacs-28 and below (list). + (car c)) + collect (propertize (help-key-description keys nil) + 'helm-realvalue c))) + :persistent-action 'ignore + :persistent-help "Do nothing" + :help-message 'helm-kmacro-help-message + :action + (helm-make-actions + "Execute kmacro (`C-u ' to execute times)" + 'helm-kbd-macro-execute + "Concat marked macros" + 'helm-kbd-macro-concat-macros + "Delete marked macros" + 'helm-kbd-macro-delete-macro + "Edit marked macro" + 'helm-kbd-macro-edit-macro + "Insert kbd macro" + 'helm-kbd-macro-insert-macro) + :group 'helm-ring) + :buffer "*helm kmacro*"))) + +(defun helm-kbd-macro-make-current (candidate) + "Make CANDIDATE macro the current one." + (setq kmacro-ring (delete candidate kmacro-ring)) + (kmacro-push-ring) + (kmacro-split-ring-element candidate)) + +(defun helm-kbd-macro-insert-macro (candidate) + "Insert macro at point in `helm-current-buffer'." + (let ((desc (read-string "Describe macro briefly: ")) + name key) + (while (fboundp (setq name (intern (read-string "New name for macro: ")))) + (message "Symbol `%s' already exists, choose another name" name) + (sit-for 1.5)) + (helm-kbd-macro-make-current candidate) + (kmacro-name-last-macro name) + (when (y-or-n-p "Bind macro to a new key?") + (helm-awhile (key-binding + (setq key (read-key-sequence-vector "Bind macro to key: "))) + (message "`%s' already run command `%s', choose another one" + (help-key-description key nil) it) + (sit-for 1.5)) + (global-set-key key name)) + (with-helm-current-buffer + (insert (format ";; %s%s\n" + desc + (and key (format " (bound to `%s')" + (help-key-description key nil))))) + (insert-kbd-macro name (not (null key)))))) + +(defun helm-kbd-macro-execute (candidate) + ;; Move candidate on top of list for next use. + (helm-kbd-macro-make-current candidate) + (kmacro-exec-ring-item + candidate helm-current-prefix-arg)) + +(defun helm-kbd-macro-concat-macros (_candidate) + (let ((mkd (helm-marked-candidates))) + (when (cdr mkd) + (kmacro-push-ring) + (setq last-kbd-macro + (cl-loop for km in mkd + for keys = (if (functionp km) + (kmacro--keys km) + (helm-acase (car km) + ((guard* (vectorp it)) it) + ((guard* (stringp it)) + (kmacro--to-vector it)))) + vconcat keys))))) + +(defun helm-kbd-macro-delete-macro (_candidate) + (let ((mkd (helm-marked-candidates)) + (head (kmacro-ring-head))) + (cl-loop for km in mkd + do (setq kmacro-ring (delete km kmacro-ring))) + (when (member head mkd) + (kmacro-delete-ring-head)))) + +(defun helm-kbd-macro-edit-macro (candidate) + (kmacro-push-ring) + (setq kmacro-ring (delete candidate kmacro-ring)) + (kmacro-split-ring-element candidate) + (kmacro-edit-macro)) + +(provide 'helm-ring) + +;;; helm-ring.el ends here diff --git a/elpa/helm-20260424.1357/helm-semantic.el b/elpa/helm-20260424.1357/helm-semantic.el new file mode 100644 index 00000000..025019e9 --- /dev/null +++ b/elpa/helm-20260424.1357/helm-semantic.el @@ -0,0 +1,233 @@ +;;; helm-semantic.el --- Helm interface for Semantic -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2017 Daniel Hackney +;; 2012 ~ 2023 Thierry Volpiatto + +;; Author: Daniel Hackney + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; Uses `candidates-in-buffer' for speed. + +;;; Code: + +(require 'cl-lib) +(require 'semantic) +(require 'helm-help) +(require 'helm-imenu) + +(declare-function pulse-momentary-highlight-one-line "pulse.el" (point &optional face)) + +(defgroup helm-semantic nil + "Semantic tags related libraries and applications for helm." + :group 'helm) + +(defcustom helm-semantic-display-style + '((python-mode . semantic-format-tag-summarize) + (c-mode . semantic-format-tag-concise-prototype-c-mode) + (emacs-lisp-mode . semantic-format-tag-abbreviate-emacs-lisp-mode)) + "Function to present a semantic tag according to `major-mode'. + +It is an alist where the `car' of each element is a `major-mode' and +the `cdr' a `semantic-format-tag-*' function. + +If no function is found for current `major-mode', fall back to +`semantic-format-tag-summarize' default function. + +You can have more or less informations depending of the `semantic-format-tag-*' +function you choose. + +All the supported functions are prefixed with \"semantic-format-tag-\", +you have completion on these functions with `C-M i' in the customize interface." + :group 'helm-semantic + :type '(alist :key-type symbol :value-type symbol)) + +;;; keymap +(defvar helm-semantic-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + map)) + +(defcustom helm-semantic-lynx-style-map nil + "Use Arrow keys to jump to occurences." + :group 'helm-semantic + :type 'boolean + :set (lambda (var val) + (set var val) + (if val + (progn + (define-key helm-semantic-map (kbd "") 'helm-execute-persistent-action) + (define-key helm-semantic-map (kbd "") 'helm-maybe-exit-minibuffer)) + (define-key helm-semantic-map (kbd "") nil) + (define-key helm-semantic-map (kbd "") nil)))) + +;; Internals vars +(defvar helm-semantic--tags-cache nil) + +(defun helm-semantic--fetch-candidates (tags depth &optional class) + "Write the contents of TAGS to the current buffer." + (let ((class class) cur-type + (stylefn (or (with-helm-current-buffer + (assoc-default major-mode helm-semantic-display-style)) + #'semantic-format-tag-summarize))) + (dolist (tag tags) + (when (listp tag) + (cl-case (setq cur-type (semantic-tag-class tag)) + ((function variable type) + (let ((spaces (make-string (* depth 2) ?\s)) + (type-p (eq cur-type 'type))) + (unless (and (> depth 0) (not type-p)) + (setq class nil)) + (insert + (if (and class (not type-p)) + (format "%s%s(%s) " + spaces (if (< depth 2) "" "├►") class) + spaces) + ;; Save the tag for later + (propertize (funcall stylefn tag nil t) + 'semantic-tag tag) + "\n") + (and type-p (setq class (car tag))) + ;; Recurse to children + (unless (eq cur-type 'function) + (helm-semantic--fetch-candidates + (semantic-tag-components tag) (1+ depth) class)))) + + ;; Don't do anything with packages or includes for now + ((package include) + (insert + (propertize (funcall stylefn tag nil t) + 'semantic-tag tag) + "\n") + ) + ;; Catch-all + (t)))))) + +(defun helm-semantic-default-action (_candidate &optional persistent) + ;; By default, helm doesn't pass on the text properties of the selection. + ;; Fix this. + (helm-log-run-hook "helm-semantic-default-action" + 'helm-goto-line-before-hook) + (with-current-buffer helm-buffer + (when (looking-at " ") + (goto-char (next-single-property-change + (pos-bol) 'semantic-tag nil (pos-eol)))) + (let ((tag (get-text-property (point) 'semantic-tag))) + (semantic-go-to-tag tag) + (unless persistent + (pulse-momentary-highlight-one-line (point)))))) + +(defun helm-semantic--maybe-set-needs-update () + (with-helm-current-buffer + (when (semantic-parse-tree-needs-update-p) + (semantic-parse-tree-set-needs-update)))) + +(defvar helm-source-semantic nil) + +(defclass helm-semantic-source (helm-source-in-buffer) + ((init :initform (lambda () + (helm-semantic--maybe-set-needs-update) + (setq helm-semantic--tags-cache (semantic-fetch-tags)) + (with-current-buffer (helm-candidate-buffer 'global) + (let ((major-mode (with-helm-current-buffer major-mode))) + (helm-semantic--fetch-candidates helm-semantic--tags-cache 0))))) + (get-line :initform 'buffer-substring) + (persistent-help :initform "Show this entry") + (keymap :initform 'helm-semantic-map) + (help-message :initform 'helm-semantic-help-message) + (persistent-action :initform (lambda (elm) + (helm-semantic-default-action elm t) + (helm-highlight-current-line))) + (action :initform 'helm-semantic-default-action))) + +(defcustom helm-semantic-fuzzy-match nil + "Enable fuzzy matching in `helm-source-semantic'." + :group 'helm-semantic + :type 'boolean + :set (lambda (var val) + (set var val) + (setq helm-source-semantic + (helm-make-source "Semantic Tags" 'helm-semantic-source + :fuzzy-match helm-semantic-fuzzy-match)))) + +;;;###autoload +(defun helm-semantic (arg) + "Preconfigured `helm' for `semantic'. +If ARG is supplied, pre-select symbol at point instead of current." + (interactive "P") + (let ((tag (helm-aif (car (semantic-current-tag-parent)) + (let ((curtag (car (semantic-current-tag)))) + (if (string= it curtag) + (format "\\_<%s\\_>" curtag) + (cons (format "\\_<%s\\_>" it) + (format "\\_<%s\\_>" curtag)))) + (format "\\_<%s\\_>" (car (semantic-current-tag))))) + (helm-highlight-matches-around-point-max-lines 'never)) + (unless helm-source-semantic + (setq helm-source-semantic + (helm-make-source "Semantic Tags" 'helm-semantic-source + :fuzzy-match helm-semantic-fuzzy-match))) + (helm :sources 'helm-source-semantic + :candidate-number-limit 9999 + :preselect (if arg + (thing-at-point 'symbol) + tag) + :buffer "*helm semantic*"))) + +;;;###autoload +(defun helm-semantic-or-imenu (arg) + "Preconfigured helm for `semantic' or `imenu'. +If ARG is supplied, pre-select symbol at point instead of current +semantic tag in scope. + +If `semantic-mode' is active in the current buffer, then use +semantic for generating tags, otherwise fall back to `imenu'. +Fill in the symbol at point by default." + (interactive "P") + (unless helm-source-semantic + (setq helm-source-semantic + (helm-make-source "Semantic Tags" 'helm-semantic-source + :fuzzy-match helm-semantic-fuzzy-match))) + (unless helm-source-imenu + (setq helm-source-imenu + (helm-make-source "Imenu" 'helm-imenu-source + :fuzzy-match helm-imenu-fuzzy-match))) + (let* ((source (if (semantic-active-p) + 'helm-source-semantic + 'helm-source-imenu)) + (helm-highlight-matches-around-point-max-lines 'never) + (imenu-p (eq source 'helm-source-imenu)) + (imenu-auto-rescan imenu-p) + (str (thing-at-point 'symbol)) + (helm-execute-action-at-once-if-one + (and imenu-p + helm-imenu-execute-action-at-once-if-one)) + (tag (helm-aif (car (semantic-current-tag-parent)) + (let ((curtag (car (semantic-current-tag)))) + (if (string= it curtag) + (format "\\_<%s\\_>" curtag) + (cons (format "\\_<%s\\_>" it) + (format "\\_<%s\\_>" curtag)))) + (format "\\_<%s\\_>" (car (semantic-current-tag)))))) + (helm :sources source + :candidate-number-limit 9999 + :default (and imenu-p (list (concat "\\_<" (and str (regexp-quote str)) "\\_>") str)) + :preselect (if (or arg imenu-p) str tag) + :buffer "*helm semantic/imenu*"))) + +(provide 'helm-semantic) + +;;; helm-semantic.el ends here diff --git a/elpa/helm-20260424.1357/helm-sys.el b/elpa/helm-20260424.1357/helm-sys.el new file mode 100644 index 00000000..6d12f9a3 --- /dev/null +++ b/elpa/helm-20260424.1357/helm-sys.el @@ -0,0 +1,476 @@ +;;; helm-sys.el --- System related functions for helm. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2026 Thierry Volpiatto + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Code: + +(require 'cl-lib) +(require 'helm) +(require 'helm-help) +(require 'helm-utils) + +(declare-function helm-comp-read "helm-mode") + + +(defgroup helm-sys nil + "System related helm library." + :group 'helm) + +(defface helm-top-columns + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :inherit helm-header)) + "Face for helm help string in minibuffer." + :group 'helm-sys) + + +(defcustom helm-top-command + (cl-case system-type + (darwin "env COLUMNS=%s ps -axo pid,user,pri,nice,ucomm,tty,start_time,vsz,%%cpu,%%mem,etime,command") + (t "env COLUMNS=%s top -b -n 1")) + "Top command used to display output of top. +A format string where %s will be replaced with `frame-width'. + +To use top command, a version supporting batch mode (-b option) +is needed. On Mac OSX top command doesn't support this, so the +ps command is used instead by default. + +Normally top command output have 12 columns, but in some +versions you may have less than this, so you can either customize +top to use 12 columns with the interactives f and W commands +of top, or modify `helm-top-sort-columns-alist' to fit with the +number of columns your top command is using. + +If you modify ps command be sure that pid comes in first and +\"env COLUMNS=%s\" is specified at beginning of command. Ensure +also that no elements contain spaces (e.g., use start_time and +not start). Same as for top: you can customize +`helm-top-sort-columns-alist' to make sort commands working +properly according to your settings." + :group 'helm-sys + :type 'string) + +(defcustom helm-top-sort-columns-alist '((com . 11) + (mem . 9) + (cpu . 8) + (user . 1)) + "Allow defining which column to use when sorting output of top/ps command. +Only com, mem, cpu and user are sorted, so no need to put something +else there,it will have no effect. +Note that column numbers are counted from zero, i.e. column 1 is the +nth 0 column." + :group 'helm-sys + :type '(alist :key-type symbol :value-type (integer :tag "Column number"))) + +(defcustom helm-top-poll-delay 1.5 + "Helm top poll after this delay when `helm-top-poll-mode' is enabled. +The minimal delay allowed is 1.5, if less than this helm-top will use 1.5." + :group 'helm-sys + :type 'float) + +(defcustom helm-top-poll-delay-post-command 1.0 + "Helm top stop polling during this delay. +This delay is added to `helm-top-poll-delay' after Emacs stops +being idle." + :group 'helm-sys + :type 'float) + +(defcustom helm-top-poll-preselection 'linum + "Stay on same line or follow candidate when `helm-top-poll' updates display. +Possible values are \\='candidate or \\='linum. +This affects also sorting functions in the same way." + :group'helm-sys + :type '(radio :tag "Preferred preselection action for helm-top" + (const :tag "Follow candidate" candidate) + (const :tag "Stay on same line" linum))) + +;;; Top (process) +;; +;; +(defvar helm-top-sort-fn nil) +(defvar helm-top-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (define-key map (kbd "M-P") 'helm-top-run-sort-by-cpu) + (define-key map (kbd "M-C") 'helm-top-run-sort-by-com) + (define-key map (kbd "M-M") 'helm-top-run-sort-by-mem) + (define-key map (kbd "M-U") 'helm-top-run-sort-by-user) + map)) + +(defvar helm-top-after-init-hook nil + "Local hook for helm-top.") + +(defvar helm-top--poll-timer nil) + +(defun helm-top-poll (&optional no-update delay) + (when helm-top--poll-timer + (cancel-timer helm-top--poll-timer)) + (condition-case nil + (progn + (when (and (helm--alive-p) (null no-update) + (null helm-suspend-update-flag)) + ;; Fix quitting while process is running + ;; by binding `with-local-quit' in init function + ;; Bug#1521. + (helm-force-update + (cl-ecase helm-top-poll-preselection + (candidate (replace-regexp-in-string + "[0-9]+" "[0-9]+" + (regexp-quote (helm-get-selection nil t)))) + (linum `(lambda () + (goto-char (point-min)) + (forward-line ,(helm-candidate-number-at-point))))))) + (setq helm-top--poll-timer + (run-with-idle-timer + (helm-aif (current-idle-time) + (time-add it (seconds-to-time + (or delay (helm-top--poll-delay)))) + (or delay (helm-top--poll-delay))) + nil + 'helm-top-poll))) + (quit (cancel-timer helm-top--poll-timer)))) + +(defun helm-top--poll-delay () + (max 1.5 helm-top-poll-delay)) + +(defun helm-top-poll-no-update () + (helm-top-poll t (+ (helm-top--poll-delay) + helm-top-poll-delay-post-command))) + +(defun helm-top-initialize-poll-hooks () + ;; When Emacs is idle during say 20s + ;; the idle timer will run in 20+1.5 s. + ;; This is fine when Emacs stays idle, because the next timer + ;; will run at 21.5+1.5 etc... so the display will be updated + ;; at every 1.5 seconds. + ;; But as soon as emacs looses its idleness, the next update + ;; will occur at say 21+1.5 s, so we have to reinitialize + ;; the timer at 0+1.5. + (add-hook 'post-command-hook 'helm-top-poll-no-update) + (add-hook 'focus-in-hook 'helm-top-poll-no-update)) + +;;;###autoload +(define-minor-mode helm-top-poll-mode + "Refresh automatically helm top buffer once enabled." + :group 'helm-top + :global t + (if helm-top-poll-mode + (progn + (add-hook 'helm-top-after-init-hook 'helm-top-poll-no-update) + (add-hook 'helm-top-after-init-hook 'helm-top-initialize-poll-hooks)) + (remove-hook 'helm-top-after-init-hook 'helm-top-poll-no-update) + (remove-hook 'helm-top-after-init-hook 'helm-top-initialize-poll-hooks))) + +(defvar helm-source-top + (helm-build-in-buffer-source "Top" + :header-name (lambda (name) + (concat name (if helm-top-poll-mode + " (auto updating)" + " (Press C-c C-u to refresh)"))) + :init #'helm-top-init + :after-init-hook 'helm-top-after-init-hook + :cleanup (lambda () + (when helm-top--poll-timer + (cancel-timer helm-top--poll-timer)) + (remove-hook 'post-command-hook 'helm-top-poll-no-update) + (remove-hook 'focus-in-hook 'helm-top-poll-no-update)) + :display-to-real #'helm-top-display-to-real + :persistent-action '(helm-top-sh-persistent-action . never-split) + :persistent-help "SIGTERM" + :help-message 'helm-top-help-message + :mode-line 'helm-top-mode-line + :follow 'never + :keymap helm-top-map + :filtered-candidate-transformer #'helm-top-sort-transformer + :action-transformer #'helm-top-action-transformer + :group 'helm-sys)) + +(defvar helm-top--line nil) +(defun helm-top-transformer (candidates _source) + "Transformer for `helm-top'. +Return empty string for non--valid candidates." + (cl-loop for disp in candidates collect + (cond ((string-match "^ *[0-9]+" disp) disp) + ((string-match "^ *PID" disp) + (setq helm-top--line (cons (propertize disp 'face 'helm-top-columns) ""))) + (t (cons disp ""))) + into lst + finally return (or (member helm-top--line lst) + (cons helm-top--line lst)))) + +(defun helm-top--skip-top-line () + (let ((src (helm-get-current-source))) + (when (helm-aand (assoc-default 'name src) + (string= it "Top") + (helm-get-selection nil t src) + (string-match-p "^ *PID" it)) + (helm-next-line)))) + +(defun helm-top-action-transformer (actions _candidate) + "Action transformer for `top'. +Show actions only on line starting by a PID." + (let ((disp (helm-get-selection nil t))) + (cond ((string-match "\\` *[0-9]+" disp) + `(("kill (SIGTERM)" . ,(lambda (_pid) + (helm-top-sh "TERM" (helm-top--marked-pids)))) + ("kill (SIGKILL)" . ,(lambda (_pid) + (helm-top-sh "KILL" (helm-top--marked-pids)))) + ("kill (SIGINT)" . ,(lambda (_pid) + (helm-top-sh "INT" (helm-top--marked-pids)))) + ("kill (Choose signal)" + . ,(lambda (_pid) + (let ((pids (helm-top--marked-pids))) + (helm-top-sh + (helm-comp-read (format "Kill %d pids with signal: " + (length pids)) + '("ALRM" "HUP" "INT" "KILL" "PIPE" "POLL" + "PROF" "TERM" "USR1" "USR2" "VTALRM" + "STKFLT" "PWR" "WINCH" "CHLD" "URG" + "TSTP" "TTIN" "TTOU" "STOP" "CONT" + "ABRT" "FPE" "ILL" "QUIT" "SEGV" + "TRAP" "SYS" "EMT" "BUS" "XCPU" "XFSZ") + :must-match t) + pids)))))) + (t actions)))) + +(defun helm-top--marked-pids () + (helm-remove-if-not-match "\\`[0-9]+\\'" (helm-marked-candidates))) + +(defun helm-top-sh (sig pids) + "Run kill shell command with signal SIG on PIDS for `helm-top'." + (message "kill -%s %s exited with status %s" + sig (mapconcat 'identity pids " ") + (apply #'call-process + "kill" nil nil nil (format "-%s" sig) pids))) + +(defun helm-top-sh-persistent-action (pid) + (helm-top-sh "TERM" (list pid)) + (helm-delete-current-selection)) + +(defun helm-top-init () + "Insert output of top command in candidate buffer." + (with-local-quit + (unless helm-top-sort-fn (helm-top-set-mode-line "CPU")) + (with-current-buffer (helm-candidate-buffer 'global) + (call-process-shell-command + (format helm-top-command (frame-width)) + nil (current-buffer))))) + +(defun helm-top-display-to-real (line) + "Return pid only from LINE." + (car (split-string line))) + +;; Sort top command + +(defun helm-top-set-mode-line (str) + (if (string-match "Sort:\\[\\(.*\\)\\] " helm-top-mode-line) + (setq helm-top-mode-line (replace-match str nil nil helm-top-mode-line 1)) + (setq helm-top-mode-line (concat (format "Sort:[%s] " str) helm-top-mode-line)))) + +(defun helm-top-sort-transformer (candidates source) + (helm-top-transformer + (if helm-top-sort-fn + (cl-loop for c in candidates + if (string-match "^ *[0-9]+" c) + collect c into pid-cands + else collect c into header-cands + finally return (append + header-cands + (sort pid-cands helm-top-sort-fn))) + candidates) + source)) + +(defun helm-top-sort-by-com (s1 s2) + (let* ((split-1 (split-string s1)) + (split-2 (split-string s2)) + (col (cdr (assq 'com helm-top-sort-columns-alist))) + (com-1 (nth col split-1)) + (com-2 (nth col split-2))) + (string< com-1 com-2))) + +(defun helm-top-sort-by-mem (s1 s2) + (let* ((split-1 (split-string s1)) + (split-2 (split-string s2)) + (col (cdr (assq 'mem helm-top-sort-columns-alist))) + (mem-1 (string-to-number (nth col split-1))) + (mem-2 (string-to-number (nth col split-2)))) + (> mem-1 mem-2))) + +(defun helm-top-sort-by-cpu (s1 s2) + (let* ((split-1 (split-string s1)) + (split-2 (split-string s2)) + (col (cdr (assq 'cpu helm-top-sort-columns-alist))) + (cpu-1 (string-to-number (nth col split-1))) + (cpu-2 (string-to-number (nth col split-2)))) + (> cpu-1 cpu-2))) + +(defun helm-top-sort-by-user (s1 s2) + (let* ((split-1 (split-string s1)) + (split-2 (split-string s2)) + (col (cdr (assq 'user helm-top-sort-columns-alist))) + (user-1 (nth col split-1)) + (user-2 (nth col split-2))) + (string< user-1 user-2))) + +(defun helm-top--preselect-fn () + (if (eq helm-top-poll-preselection 'linum) + `(lambda () + (goto-char (point-min)) + (forward-line ,(helm-candidate-number-at-point))) + (replace-regexp-in-string + "[0-9]+" "[0-9]+" + (regexp-quote (helm-get-selection nil t))))) + +(defun helm-top-run-sort-by-com () + (interactive) + (helm-top-set-mode-line "COM") + (setq helm-top-sort-fn 'helm-top-sort-by-com) + (helm-update (helm-top--preselect-fn))) + +(defun helm-top-run-sort-by-cpu () + (interactive) + (helm-top-set-mode-line "CPU") + ;; Force sorting by CPU even if some versions of top are using by + ;; default CPU sorting (Bug#1908). + (setq helm-top-sort-fn 'helm-top-sort-by-cpu) + (helm-update (helm-top--preselect-fn))) + +(defun helm-top-run-sort-by-mem () + (interactive) + (helm-top-set-mode-line "MEM") + (setq helm-top-sort-fn 'helm-top-sort-by-mem) + (helm-update (helm-top--preselect-fn))) + +(defun helm-top-run-sort-by-user () + (interactive) + (helm-top-set-mode-line "USER") + (setq helm-top-sort-fn 'helm-top-sort-by-user) + (helm-update (helm-top--preselect-fn))) + + +;;; X RandR resolution change +;; +;; +;;; FIXME I do not care multi-display. + +(defun helm-xrandr-info () + "Return a pair with current X screen number and current X display name." + (with-temp-buffer + (call-process "xrandr" nil (current-buffer) nil + "--current") + (let (screen output) + (goto-char (point-min)) + (save-excursion + (when (re-search-forward "\\(^Screen \\)\\([0-9]\\):" nil t) + (setq screen (match-string 2)))) + (when (re-search-forward "^\\(.*\\) connected" nil t) + (setq output (match-string 1))) + (list screen output)))) + +(defun helm-xrandr-screen () + "Return current X screen number." + (car (helm-xrandr-info))) + +(defun helm-xrandr-output () + "Return current X display name." + (cadr (helm-xrandr-info))) + +(defvar helm-source-xrandr-change-resolution + (helm-build-sync-source "Change Resolution" + :candidates + (lambda () + (with-temp-buffer + (call-process "xrandr" nil (current-buffer) nil + "--screen" (helm-xrandr-screen) "-q") + (goto-char 1) + (cl-loop while (re-search-forward " \\([0-9]+x[0-9]+\\)" nil t) + for mode = (match-string 1) + unless (member mode modes) + collect mode into modes + finally return modes))) + :action + (helm-make-actions "Change Resolution" + (lambda (mode) + (call-process "xrandr" nil nil nil + "--screen" (helm-xrandr-screen) + "--output" (helm-xrandr-output) + "--mode" mode))))) + + +;;; Emacs process +;; +;; +(defvar helm-source-emacs-process + (helm-build-sync-source "Emacs Process" + :init (lambda () + (let (tabulated-list-use-header-line) + (list-processes--refresh))) + :candidates (lambda () (mapcar #'process-name (process-list))) + :candidate-transformer + (lambda (candidates) + (cl-loop for c in candidates + for command = (mapconcat + 'identity + (process-command (get-process c)) " ") + if (and command (not (string= command ""))) collect + (cons (concat c " --> " + (mapconcat 'identity + (process-command (get-process c)) " ")) + c) + else collect c)) + :multiline t + :persistent-action (lambda (elm) + (delete-process (get-process elm)) + (helm-delete-current-selection)) + :persistent-help "Kill Process" + :action (helm-make-actions "Kill Process" + (lambda (_elm) + (cl-loop for p in (helm-marked-candidates) + do (delete-process (get-process p))))))) + + +;;;###autoload +(defun helm-top (&optional arg) + "Preconfigured `helm' for top command. +When prefix arg ARG is non nil toggle auto updating mode `helm-top-poll-mode'." + (interactive "P") + (when arg (helm-top-poll-mode 'toggle)) + (add-hook 'helm-after-update-hook 'helm-top--skip-top-line) + (unwind-protect + (helm :sources 'helm-source-top + :buffer "*helm top*" :full-frame t + :candidate-number-limit 9999 + :preselect "^\\s-*[0-9]+" + :truncate-lines helm-show-action-window-other-window) + (remove-hook 'helm-after-update-hook 'helm-top--skip-top-line))) + +;;;###autoload +(defun helm-list-emacs-process () + "Preconfigured `helm' for Emacs process." + (interactive) + (helm :sources 'helm-source-emacs-process + :truncate-lines t + :buffer "*helm process*")) + +;;;###autoload +(defun helm-xrandr-set () + "Preconfigured helm for xrandr." + (interactive) + (helm :sources 'helm-source-xrandr-change-resolution + :buffer "*helm xrandr*")) + +(provide 'helm-sys) + +;;; helm-sys.el ends here diff --git a/elpa/helm-20260424.1357/helm-tags.el b/elpa/helm-20260424.1357/helm-tags.el new file mode 100644 index 00000000..3e685f83 --- /dev/null +++ b/elpa/helm-20260424.1357/helm-tags.el @@ -0,0 +1,336 @@ +;;; helm-tags.el --- Helm for Etags. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2026 Thierry Volpiatto + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Code: + +(require 'cl-lib) +(require 'helm) +(require 'helm-help) +(require 'helm-utils) +(require 'helm-grep) + +(defvar helm-etags-fuzzy-match) +(declare-function xref-push-marker-stack "xref") + + +(defgroup helm-tags nil + "Tags related Applications and libraries for Helm." + :group 'helm) + +(defcustom helm-etags-tag-file-name "TAGS" + "Etags tag file name." + :type 'string) + +(defcustom helm-etags-tag-file-search-limit 10 + "The limit level of directory to search tag file. +Don't search tag file deeply if outside this value." + :type 'number) + +(defcustom helm-etags-match-part-only 'tag + "Allow choosing the tag part of CANDIDATE in `helm-source-etags-select'. +A tag looks like this: + filename: (defun foo +You can choose matching against the tag part (i.e \"(defun foo\"), +or against the whole candidate (i.e \"(filename:5:(defun foo\")." + :type '(choice + (const :tag "Match only tag" tag) + (const :tag "Match all file+tag" all))) + +(defcustom helm-etags-execute-action-at-once-if-one t + "Whether to jump straight to the selected tag if there's only +one match." + :type 'boolean) + + +(defgroup helm-tags-faces nil + "Customize the appearance of helm-tags faces." + :prefix "helm-" + :group 'helm-tags + :group 'helm-faces) + +(defface helm-etags-file + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :foreground "Lightgoldenrod4" + :underline t)) + "Face used to highlight etags filenames." + :group 'helm-tags-faces) + + +;;; Etags +;; +;; +(defun helm-etags-find-file (candidate) + "Find file CANDIDATE from helm etags buffer." + (helm-etags-action-goto 'find-file candidate)) + +(defun helm-etags-find-file-other-window (candidate) + "Find file other window from helm etags buffer." + (helm-etags-action-goto 'find-file-other-window candidate)) + +(defun helm-etags-find-file-other-frame (candidate) + "Find file other frame from helm etags buffer." + (helm-etags-action-goto 'find-file-other-frame candidate)) + +(helm-make-command-from-action helm-etags-run-switch-other-window + "Run switch to other window action from `helm-source-etags-select'." + 'helm-etags-find-file-other-window) + +(helm-make-command-from-action helm-etags-run-switch-other-frame + "Run switch to other frame action from `helm-source-etags-select'." + 'helm-etags-find-file-other-frame) + +(defvar helm-etags-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (define-key map (kbd "M-") 'helm-goto-next-file) + (define-key map (kbd "M-") 'helm-goto-precedent-file) + (define-key map (kbd "C-c o") 'helm-etags-run-switch-other-window) + (define-key map (kbd "C-c C-o") 'helm-etags-run-switch-other-frame) + map) + "Keymap used in Etags.") + +(defvar helm-etags-mtime-alist nil + "Store the last modification time of etags files here.") +(defvar helm-etags-cache (make-hash-table :test 'equal) + "Cache content of etags files used here for faster access.") + +(defun helm-etags-get-tag-file (&optional directory) + "Return the path of etags file if found in DIRECTORY. +Look recursively in parents directorys for a +`helm-etags-tag-file-name' file." + ;; Get tag file from `default-directory' or upper directory. + (let ((current-dir (helm-etags-find-tag-file-directory + (or directory default-directory)))) + ;; Return nil if not find tag file. + (when current-dir + (expand-file-name helm-etags-tag-file-name current-dir)))) + +(defun helm-etags-all-tag-files () + "Find Etags files. +Return files from the following sources: + 1) An automatically located file in the parent directories, + by `helm-etags-get-tag-file'. + 2) `tags-file-name', which is commonly set by `find-tag' command. + 3) `tags-table-list' which is commonly set by `visit-tags-table' command." + (helm-fast-remove-dups + (delq nil + (append (list (helm-etags-get-tag-file) + tags-file-name) + tags-table-list)) + :test 'equal)) + +(defun helm-etags-find-tag-file-directory (current-dir) + "Try to find the directory containing tag file. +If not found in CURRENT-DIR search in upper directory." + (let ((file-exists? (lambda (dir) + (let ((tag-path (expand-file-name + helm-etags-tag-file-name dir))) + (and (stringp tag-path) + (file-regular-p tag-path) + (file-readable-p tag-path)))))) + (cl-loop with count = 0 + until (funcall file-exists? current-dir) + ;; Return nil if outside the value of + ;; `helm-etags-tag-file-search-limit'. + if (= count helm-etags-tag-file-search-limit) + do (cl-return nil) + ;; Or search upper directories. + else + do (cl-incf count) + (setq current-dir (expand-file-name (concat current-dir "../"))) + finally return current-dir))) + +(defun helm-etags-get-header-name (_x) + "Create header name for this helm etags session." + (concat "Etags in " + (with-helm-current-buffer + (helm-etags-get-tag-file)))) + +(defun helm-etags-create-buffer (file) + "Create the `helm-buffer' based on contents of etags tag FILE." + (let* (max + (split (with-temp-buffer + (insert-file-contents file) + (prog1 + (split-string (buffer-string) "\n" 'omit-nulls) + (setq max (line-number-at-pos (point-max)))))) + (progress-reporter (make-progress-reporter "Loading tag file..." 0 max))) + (cl-loop + with fname + with cand + for i in split for count from 0 + for elm = (unless (string-match "^\x0c" i) ;; "^L" + (helm-aif (string-match "\177" i) ;; "^?" + (substring i 0 it) + i)) + for linum = (when (string-match "[0-9]+,?[0-9]*$" i) + (car (split-string (match-string 0 i) ","))) + do (cond ((and elm (string-match "^\\([^,]+\\),[0-9]+$" elm)) + (setq fname (propertize (match-string 1 elm) + 'face 'helm-etags-file))) + (elm (setq cand (format "%s:%s:%s" fname linum elm))) + (t (setq cand nil))) + when cand do (progn + (insert (propertize (concat cand "\n") 'linum linum)) + (progress-reporter-update progress-reporter count))))) + +(defun helm-etags-init () + "Feed `helm-buffer' using `helm-etags-cache' or tag file. +If there is no entry in cache, create one." + (let ((tagfiles (helm-etags-all-tag-files))) + (when tagfiles + (with-current-buffer (helm-candidate-buffer 'global) + (dolist (f tagfiles) + (helm-aif (gethash f helm-etags-cache) + ;; An entry is present in cache, insert it. + (insert it) + ;; No entry, create a new buffer using content of tag file (slower). + (helm-etags-create-buffer f) + ;; Store content of buffer in cache. + (puthash f (buffer-string) helm-etags-cache) + ;; Store or set the last modification of tag file. + (helm-aif (assoc f helm-etags-mtime-alist) + ;; If an entry exists modify it. + (setcdr it (helm-etags-mtime f)) + ;; No entry create a new one. + (cl-pushnew (cons f (helm-etags-mtime f)) + helm-etags-mtime-alist + :test 'equal)))))))) + +(defvar helm-source-etags-select nil + "Helm source for Etags.") + +(defun helm-etags-build-source () + (helm-build-in-buffer-source "Etags" + :header-name 'helm-etags-get-header-name + :init 'helm-etags-init + :get-line 'buffer-substring + :match-part (lambda (candidate) + ;; Match only the tag part of CANDIDATE + ;; and not the filename. + (cl-case helm-etags-match-part-only + (tag (cl-caddr (helm-grep-split-line candidate))) + (t candidate))) + :fuzzy-match helm-etags-fuzzy-match + :help-message 'helm-etags-help-message + :keymap helm-etags-map + :action '(("Go to tag" . helm-etags-find-file) + ("Go to tag in other window" . helm-etags-find-file-other-window) + ("Go to tag in other frame" . helm-etags-find-file-other-frame)) + :group 'helm-tags + :persistent-help "Go to line" + :persistent-action (lambda (candidate) + (helm-etags-action-goto 'find-file candidate) + (helm-highlight-current-line)))) + +(defcustom helm-etags-fuzzy-match nil + "Use fuzzy matching in `helm-etags-select'." + :group 'helm-tags + :type 'boolean + :set (lambda (var val) + (set var val) + (setq helm-source-etags-select + (helm-etags-build-source)))) + +(defsubst helm-etags--file-from-tag (fname) + (cl-loop for ext in + (cons "" (remove "" tags-compression-info-list)) + for file = (concat fname ext) + when (file-exists-p file) + return file)) + +(defun helm-etags-action-goto (switcher candidate) + "Helm default action to jump to an etags entry in other window." + (require 'etags) + (deactivate-mark t) + (helm-log-run-hook "helm-etags-action-goto " 'helm-goto-line-before-hook) + (let* ((split (helm-grep-split-line candidate)) + (fname (cl-loop for tagf being the hash-keys of helm-etags-cache + for f = (expand-file-name + (car split) (file-name-directory tagf)) + ;; Try to find an existing file, possibly compressed. + when (helm-etags--file-from-tag f) + return it)) + (elm (cl-caddr split)) + (linum (string-to-number (cadr split)))) + (if (null fname) + (error "file %s not found" fname) + (xref-push-marker-stack) + (funcall switcher fname) + (helm-goto-line linum t) + (when (search-forward elm nil t) + (goto-char (match-beginning 0)))))) + +(defun helm-etags-mtime (file) + "Last modification time of etags tag FILE." + (cadr (nth 5 (file-attributes file)))) + +(defun helm-etags-file-modified-p (file) + "Check if tag FILE have been modified in this session. +If FILE is nil return nil." + (let ((last-modif (and file + (assoc-default file helm-etags-mtime-alist)))) + (and last-modif + (/= last-modif (helm-etags-mtime file))))) + +;;;###autoload +(defun helm-etags-select (reinit) + "Preconfigured helm for etags. +If called with a prefix argument REINIT +or if any of the tag files have been modified, reinitialize cache. + +This function aggregates three sources of tag files: + + 1) An automatically located file in the parent directories, + by `helm-etags-get-tag-file'. + 2) `tags-file-name', which is commonly set by `find-tag' command. + 3) `tags-table-list' which is commonly set by `visit-tags-table' command." + (interactive "P") + (let ((tag-files (helm-etags-all-tag-files)) + (helm-execute-action-at-once-if-one + helm-etags-execute-action-at-once-if-one) + (str (if (region-active-p) + (buffer-substring-no-properties + (region-beginning) (region-end)) + (thing-at-point 'symbol)))) + (cl-assert (cl-loop for f in tag-files thereis (file-exists-p f)) + nil "No TAGS file found") + (cl-loop for k being the hash-keys of helm-etags-cache + unless (member k tag-files) + do (remhash k helm-etags-cache)) + (mapc (lambda (f) + (when (or (equal reinit '(4)) + (and helm-etags-mtime-alist + (helm-etags-file-modified-p f))) + (remhash f helm-etags-cache))) + tag-files) + (unless helm-source-etags-select + (setq helm-source-etags-select + (helm-etags-build-source))) + (helm :sources 'helm-source-etags-select + :keymap helm-etags-map + :default (and (stringp str) + (if (or helm-etags-fuzzy-match + (and (eq major-mode 'haskell-mode) + (string-match "[']\\'" str))) + str + (list (concat "\\_<" str "\\_>") str))) + :buffer "*helm etags*"))) + +(provide 'helm-tags) + +;;; helm-tags.el ends here diff --git a/elpa/helm-20260424.1357/helm-types.el b/elpa/helm-20260424.1357/helm-types.el new file mode 100644 index 00000000..f0ed16db --- /dev/null +++ b/elpa/helm-20260424.1357/helm-types.el @@ -0,0 +1,342 @@ +;;; helm-types.el --- Helm types classes and methods. -*- lexical-binding: t -*- + +;; Copyright (C) 2015 ~ 2026 Thierry Volpiatto + +;; Author: Thierry Volpiatto +;; URL: http://github.com/emacs-helm/helm + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + + +;;; Code: + +(require 'cl-lib) +(require 'eieio) +(eval-when-compile (require 'helm-source)) + +(defvar helm-map) +(defvar helm-mode-line-string) +(defvar helm-bookmark-map) +(declare-function helm-make-actions "helm-lib") +(declare-function helm-ediff-marked-buffers "helm-buffers") +(declare-function helm-make-type "helm-source") +(declare-function helm-marked-candidates "helm-core") + +;; Files +(defclass helm-type-file (helm-source) + ((completing-file-name + :initarg :completing-file-name :initform t + :documentation "Flag to notify we are completing filenames.")) + "A class to define helm type file.") + +(cl-defmethod helm-source-get-action-from-type ((object helm-type-file)) + (slot-value object 'action)) + +(defun helm-actions-from-type-file () + (let ((source (make-instance 'helm-type-file))) + (helm--setup-source source) + (helm-source-get-action-from-type source))) + +(defvar helm-generic-files-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (define-key map (kbd "C-]") 'helm-ff-run-toggle-basename) + (define-key map (kbd "C-s") 'helm-ff-run-grep) + (define-key map (kbd "M-g s") 'helm-ff-run-grep) + (define-key map (kbd "M-g z") 'helm-ff-run-zgrep) + (define-key map (kbd "M-g p") 'helm-ff-run-pdfgrep) + (define-key map (kbd "M-R") 'helm-ff-run-rename-file) + (define-key map (kbd "M-C") 'helm-ff-run-copy-file) + (define-key map (kbd "M-B") 'helm-ff-run-byte-compile-file) + (define-key map (kbd "M-L") 'helm-ff-run-load-file) + (define-key map (kbd "M-S") 'helm-ff-run-symlink-file) + (define-key map (kbd "M-H") 'helm-ff-run-hardlink-file) + (define-key map (kbd "M-D") 'helm-ff-run-delete-file) + (define-key map (kbd "C-=") 'helm-ff-run-ediff-file) + (define-key map (kbd "C-c =") 'helm-ff-run-ediff-merge-file) + (define-key map (kbd "C-c o") 'helm-ff-run-switch-other-window) + (define-key map (kbd "C-c r") 'helm-ff-run-find-file-as-root) + (define-key map (kbd "C-c C-o") 'helm-ff-run-switch-other-frame) + (define-key map (kbd "M-i") 'helm-ff-properties-persistent) + (define-key map (kbd "C-c C-x") 'helm-ff-run-open-file-externally) + (define-key map (kbd "C-c X") 'helm-ff-run-open-file-with-default-tool) + (define-key map (kbd "C-c @") 'helm-ff-run-insert-org-link) + (define-key map (kbd "C-x C-q") 'helm-ff-run-edit-marked-files) + (define-key map (kbd "C-c C-a") 'helm-ff-run-mail-attach-files) + map) + "Generic Keymap for files.") + +(defcustom helm-type-file-actions + (helm-make-actions + "Find file" 'helm-find-file-or-marked + "Find file as root" 'helm-find-file-as-root + "Find file other window" 'helm-find-files-other-window + "Find file other frame" 'find-file-other-frame + "Open dired in file's directory" 'helm-open-dired + "Attach file(s) to mail buffer `C-c C-a'" 'helm-ff-mail-attach-files + "Edit marked files `C-x C-q'" 'helm-ff-edit-marked-files + "Grep File(s) `C-u recurse'" 'helm-find-files-grep + "Zgrep File(s) `C-u Recurse'" 'helm-ff-zgrep + "Pdfgrep File(s)" 'helm-ff-pdfgrep + "Insert as org link" 'helm-files-insert-as-org-link + "Checksum File" 'helm-ff-checksum + "Ediff File" 'helm-find-files-ediff-files + "Ediff Merge File" 'helm-find-files-ediff-merge-files + "View file" 'view-file + "Insert file" 'insert-file + "Add marked files to file-cache" 'helm-ff-cache-add-file + "Delete file(s)" 'helm-ff-delete-files + "Copy file(s) `M-C, C-u to follow'" 'helm-find-files-copy + "Rename file(s) `M-R, C-u to follow'" 'helm-find-files-rename + "Symlink files(s) `M-S, C-u to follow'" 'helm-find-files-symlink + "Relsymlink file(s) `C-u to follow'" 'helm-find-files-relsymlink + "Hardlink file(s) `M-H, C-u to follow'" 'helm-find-files-hardlink + "Open file externally (C-u to choose)" 'helm-open-file-externally + "Open file with default tool" 'helm-open-file-with-default-tool + "Find file in hex dump" 'hexl-find-file) + "Default actions for type files." + :group 'helm-files + :type '(alist :key-type string :value-type function)) + +(cl-defmethod helm--setup-source ((_source helm-type-file))) + +(cl-defmethod helm--setup-source :before ((source helm-type-file)) + (setf (slot-value source 'action) 'helm-type-file-actions) + (setf (slot-value source 'persistent-help) "Show this file") + (setf (slot-value source 'action-transformer) + '(helm-transform-file-load-el + helm-transform-file-browse-url + helm-transform-file-cache)) + (setf (slot-value source 'candidate-transformer) + '(helm-skip-boring-files + helm-w32-pathname-transformer)) + (setf (slot-value source 'filtered-candidate-transformer) + 'helm-highlight-files) + (setf (slot-value source 'help-message) 'helm-generic-file-help-message) + (setf (slot-value source 'mode-line) (list "File(s)" helm-mode-line-string)) + (setf (slot-value source 'keymap) helm-generic-files-map) + (setf (slot-value source 'group) 'helm-files)) + + +;; Bookmarks +(defclass helm-type-bookmark (helm-source) () + "A class to define type bookmarks.") + +(defcustom helm-type-bookmark-actions + (helm-make-actions + "Jump to bookmark" 'helm-bookmark-jump + "Jump to BM other window" 'helm-bookmark-jump-other-window + "Jump to BM other frame" 'helm-bookmark-jump-other-frame + "Jump to BM other tab" 'helm-bookmark-jump-other-tab + "Show bookmark annotation" 'helm-bookmark-show-annotation + "Bookmark edit annotation" 'bookmark-edit-annotation + "Delete marked bookmark(s)" 'helm-delete-marked-bookmarks + "Edit Bookmark" 'helm-bookmark-edit-bookmark + "Reset Bookmark to current pos" 'bookmark-set + "Rename marked bookmark(s)" 'helm-bookmark-rename-marked + "Relocate bookmark" 'bookmark-relocate) + "Default actions for type bookmarks." + :group 'helm-bookmark + :type '(alist :key-type string + :value-type function)) + +(cl-defmethod helm-source-get-action-from-type ((object helm-type-bookmark)) + (slot-value object 'action)) + +(cl-defmethod helm--setup-source ((_source helm-type-bookmark))) + +(cl-defmethod helm--setup-source :before ((source helm-type-bookmark)) + (setf (slot-value source 'action) 'helm-type-bookmark-actions) + (setf (slot-value source 'keymap) helm-bookmark-map) + (setf (slot-value source 'mode-line) (list "Bookmark(s)" helm-mode-line-string)) + (setf (slot-value source 'help-message) 'helm-bookmark-help-message) + (setf (slot-value source 'migemo) t) + (setf (slot-value source 'follow) 'never) + (setf (slot-value source 'group) 'helm-bookmark)) + + +;; Buffers +(defclass helm-type-buffer (helm-source) () + "A class to define type buffer.") + +(defcustom helm-type-buffer-actions + (helm-make-actions + "Switch to buffer(s)" 'helm-buffer-switch-buffers + "Switch to buffer(s) other window `C-c o'" + 'helm-buffer-switch-buffers-other-window + "Switch to buffer(s) other frame `C-c C-o'" + 'helm-buffer-switch-to-buffer-other-frame + "Raise buffer frame maybe" + 'helm-buffers-maybe-raise-buffer-frame + (lambda () (and (fboundp 'tab-bar-mode) + "Switch to buffer(s) other tab `C-c C-t'")) + 'helm-buffers-switch-buffers-in-tab + "Switch to buffer at line number" + 'helm-switch-to-buffer-at-linum + "Browse project `C-x C-d'" + 'helm-buffers-browse-project + "Switch to shell" + 'helm-buffer-switch-to-shell + "Query replace regexp `C-M-%'" + 'helm-buffer-query-replace-regexp + "Query replace `M-%'" 'helm-buffer-query-replace + "View buffer" 'view-buffer + "Display buffer" 'display-buffer + "Rename buffer `M-R'" 'helm-buffers-rename-buffer + "Grep buffer(s) `M-g s' (C-u grep all buffers)" + 'helm-zgrep-buffers + "Multi occur buffer(s) `C-s (C-u search also in current)'" + 'helm-multi-occur-as-action + "Revert buffer(s) `M-G'" 'helm-revert-marked-buffers + "Insert buffer" 'insert-buffer + "Kill buffer(s) `M-D'" 'helm-kill-marked-buffers + "Diff with file `C-='" 'diff-buffer-with-file + "Ediff Marked buffers `C-c ='" 'helm-ediff-marked-buffers + "Ediff Merge marked buffers `M-='" + (lambda (candidate) + (helm-ediff-marked-buffers candidate t))) + "Default actions for type buffers." + :group 'helm-buffers + :type '(alist :key-type string :value-type function)) + +(cl-defmethod helm-source-get-action-from-type ((object helm-type-buffer)) + (slot-value object 'action)) + +(cl-defmethod helm--setup-source ((_source helm-type-buffer))) + +(cl-defmethod helm--setup-source :before ((source helm-type-buffer)) + (setf (slot-value source 'action) 'helm-type-buffer-actions) + (setf (slot-value source 'persistent-help) "Show this buffer") + (setf (slot-value source 'mode-line) + ;; Use default-value of `helm-mode-line-string' in case user + ;; starts with a helm buffer as current-buffer otherwise the + ;; local value of this helm buffer is used (bug#1517, bug#2377). + (list "Buffer(s)" (default-value 'helm-mode-line-string))) + (setf (slot-value source 'filtered-candidate-transformer) + '(helm-skip-boring-buffers + helm-buffers-sort-transformer + helm-highlight-buffers)) + (setf (slot-value source 'group) 'helm-buffers)) + +;; Functions +(defclass helm-type-function (helm-source) () + "A class to define helm type function.") + +(defcustom helm-type-function-actions + (helm-make-actions + "Describe function" 'helm-describe-function + "Find function (C-u for source)" 'helm-find-function + "Info lookup" 'helm-info-lookup-symbol + "Debug on entry" 'debug-on-entry + "Cancel debug on entry" 'cancel-debug-on-entry + "Trace function" 'trace-function + "Trace function (background)" 'trace-function-background + "Untrace function" 'untrace-function) + "Default actions for type functions." + :group 'helm-elisp + ;; Use symbol as value type because some functions may not be + ;; autoloaded (like untrace-function). + :type '(alist :key-type string :value-type symbol)) + +(cl-defmethod helm-source-get-action-from-type ((object helm-type-function)) + (slot-value object 'action)) + +(defun helm-actions-from-type-function () + (let ((source (make-instance 'helm-type-function))) + (helm--setup-source source) + (helm-source-get-action-from-type source))) + +(cl-defmethod helm--setup-source ((_source helm-type-function))) + +(cl-defmethod helm--setup-source :before ((source helm-type-function)) + (setf (slot-value source 'action) 'helm-type-function-actions) + (setf (slot-value source 'action-transformer) + 'helm-transform-function-call-interactively) + (setf (slot-value source 'candidate-transformer) + 'helm-mark-interactive-functions) + (setf (slot-value source 'coerce) 'helm-symbolify)) + + +;; Commands +(defclass helm-type-command (helm-source) () + "A class to define helm type command.") + +(defun helm-actions-from-type-command () + (let ((source (make-instance 'helm-type-command))) + (helm--setup-source source) + (helm-source-get-action-from-type source))) + +(defcustom helm-type-command-actions + (append (helm-make-actions + "Execute command" 'helm-M-x-execute-command) + (symbol-value + (helm-actions-from-type-function))) + "Default actions for type command." + :group 'helm-command + :type '(alist :key-type string :value-type symbol)) + +(cl-defmethod helm--setup-source ((_source helm-type-command))) + +(cl-defmethod helm--setup-source :before ((source helm-type-command)) + (setf (slot-value source 'action) 'helm-type-command-actions) + (setf (slot-value source 'coerce) 'helm-symbolify) + (setf (slot-value source 'persistent-action) 'helm-M-x-persistent-action) + (setf (slot-value source 'persistent-help) "Describe this command") + (setf (slot-value source 'group) 'helm-command)) + +;; Timers +(defclass helm-type-timers (helm-source) () + "A class to define helm type timers.") + +(defcustom helm-type-timers-actions + `(("Cancel Timer" . ,(lambda (_timer) + (let ((mkd (helm-marked-candidates))) + (cl-loop for timer in mkd + do (cancel-timer timer))))) + ("Describe Function" . ,(lambda (tm) + (describe-function (timer--function tm)))) + ("Find Function" . ,(lambda (tm) + (helm-aif (timer--function tm) + (if (or (byte-code-function-p it) + (helm-subr-native-elisp-p it)) + (message "Can't find anonymous function `%s'" it) + (find-function it)))))) + "Default actions for type timers." + :group 'helm-elisp + :type '(alist :key-type string :value-type function)) + +(cl-defmethod helm--setup-source ((_source helm-type-timers))) + +(cl-defmethod helm--setup-source :before ((source helm-type-timers)) + (setf (slot-value source 'action) 'helm-type-timers-actions) + (setf (slot-value source 'persistent-action) + (lambda (tm) + (describe-function (timer--function tm)))) + (setf (slot-value source 'persistent-help) "Describe Function") + (setf (slot-value source 'group) 'helm-elisp)) + +;; Builders. +(defun helm-build-type-file () + (helm-make-type 'helm-type-file)) +(make-obsolete 'helm-build-type-file 'helm-make-source "4.0.3") +(defun helm-build-type-function () + (helm-make-type 'helm-type-function)) +(make-obsolete 'helm-build-type-function 'helm-make-source "4.0.3") +(defun helm-build-type-command () + (helm-make-type 'helm-type-command)) +(make-obsolete 'helm-build-type-command 'helm-make-source "4.0.3") + +(provide 'helm-types) + +;;; helm-types.el ends here diff --git a/elpa/helm-20260424.1357/helm-utils.el b/elpa/helm-20260424.1357/helm-utils.el new file mode 100644 index 00000000..19c3e52f --- /dev/null +++ b/elpa/helm-20260424.1357/helm-utils.el @@ -0,0 +1,1232 @@ +;;; helm-utils.el --- Utilities Functions for helm. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2026 Thierry Volpiatto + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Code: + +(require 'cl-lib) +(require 'helm) +(require 'helm-help) + +(declare-function helm-find-files-1 "helm-files" (fname &optional preselect)) +(declare-function helm-grep-split-line "helm-grep" (line)) +(declare-function markdown-show-entry "ext:markdown-mode.el") +(declare-function outline-show-subtree "outline") +(declare-function org-reveal "org") +(declare-function hs-show-block "hideshow.el") +(declare-function hs-show-all "hideshow.el") +(declare-function tab-bar-tabs "tab-bar") +(declare-function tab-bar-select-tab "tab-bar") +(declare-function dired-goto-file "dired") +(declare-function bookmark-get-filename "bookmark") +(declare-function package-installed-p "package") +(declare-function package-desc-dir "package") + +(defvar hs-minor-mode) +(defvar hs-show-hook) +(defvar org-directory) +(defvar winner-boring-buffers) +(defvar bookmark-alist) +(defvar dired-buffers) +(defvar helm-show-completion-overlay) +(defvar helm-buffers-maybe-switch-to-tab) +(defvar helm-ff-transformer-show-only-basename) +(defvar helm-popup-tip-mode) +(defvar helm-ff-last-expanded-candidate-regexp) +(defvar helm-mode-find-file-target-alist) + +(defgroup helm-utils nil + "Utilities routines for Helm." + :group 'helm) + +(defcustom helm-su-or-sudo "sudo" + "What command to use for root access." + :type 'string + :group 'helm-utils) + +(defcustom helm-default-kbsize 1024.0 + "Default Kbsize to use for showing files size. +It is a float, usually 1024.0 but could be 1000.0 on some systems." + :group 'helm-utils + :type 'float) + +(define-obsolete-variable-alias + 'helm-highlight-number-lines-around-point + 'helm-highlight-matches-around-point-max-lines + "20160119") + +(defcustom helm-highlight-matches-around-point-max-lines '(15 . 15) + "Number of lines around point where matched items are highlighted. + +Possible value are: +- A cons cell (x . y) + Match x lines before point and y lines after point. +- An integer + Positive means this number lines after point. + Negative means this number lines before point. + A zero value means highlight only inside matched lines. +- The symbol never + Means do not highlight matched items. " + :group 'helm-utils + :type '(choice (cons (integer :tag "Match before") + (integer :tag "Match after")) + (const :tag "Match in line only" 0) + (integer :tag "Match after or before (+/-)") + (const :tag "Never match" never))) + +(defcustom helm-highlight-only-all-matches nil + "Highlight only when all items match on the line when non nil. +See `helm-highlight-current-line'." + :group 'helm-utils + :type 'boolean) + +(defcustom helm-buffers-to-resize-on-pa nil + "A list of helm buffers where the helm-window should be reduced on PA. +Where PA means persistent action." + :group 'helm-utils + :type '(repeat (choice string))) + +(defcustom helm-resize-on-pa-text-height 12 + "The size of the helm-window when resizing on persistent action." + :group 'helm-utils + :type 'integer) + +(defcustom helm-html-decode-entities-function #'helm-html-decode-entities-string + "Function used to decode HTML entities in HTML bookmarks. +Helm comes by default with `helm-html-decode-entities-string', if +you need something more sophisticated you can use +`w3m-decode-entities-string' if available. + +In Emacs itself org-entities seem broken and `xml-substitute-numeric-entities' +supports only numeric entities." + :group 'helm-utils + :type 'function) + + +(defvar helm-goto-line-before-hook '(helm-save-current-pos-to-mark-ring) + "Run before jumping to line. +This hook runs when jumping from `helm-goto-line', `helm-etags-default-action', +`helm-imenu-default-action' and `helm-mark-ring-default-action' itself. +This allows you to retrieve a previous position after using the different helm +tools for searching or retrieving a position (etags, grep, gid, (m)occur etc...). +By default positions are added to `mark-ring'. + +You can also add to register by using (or adding) +`helm-save-pos-to-register-before-jump' instead. In this case +last position is added to the register `helm-save-pos-before-jump-register'. +Note that when using a register only one position is saved globally to registers +whereas when using `mark-ring' all positions are saved locally in each buffer.") + +(defvar helm-save-pos-before-jump-register ?_ + "The register where `helm-save-pos-to-register-before-jump' saves position.") + +(defconst helm-html-entities-alist + '((""" . 34) ;; " + (">" . 62) ;; > + ("<" . 60) ;; < + ("&" . 38) ;; & + ("€" . 8364) ;; € + ("Ÿ" . 89) ;; Y + ("¡" . 161) ;; ¡ + ("¢" . 162) ;; ¢ + ("£" . 163) ;; £ + ("¤" . 164) ;; ¤ + ("¥" . 165) ;; Â¥ + ("¦" . 166) ;; ¦ + ("§" . 167) ;; § + ("¨" . 32) ;; SPC + (" " . 160) ;;   (non breaking space) + ("©" . 169) ;; © + ("ª" . 97) ;; a + ("«" . 171) ;; « + ("¬" . 172) ;; ¬ + ("&masr;" . 174) ;; ® + ("°" . 176) ;; ° + ("±" . 177) ;; ± + ("²" . 50) ;; 2 + ("³" . 51) ;; 3 + ("´" . 39) ;; ' + ("µ" . 956) ;; μ + ("¶" . 182) ;; ¶ + ("·" . 183) ;; · + ("¸" . 32) ;; SPC + ("¹" . 49) ;; 1 + ("º" . 111) ;; o + ("»" . 187) ;; » + ("¼" . 49) ;; 1 + ("½" . 49) ;; 1 + ("¾" . 51) ;; 3 + ("¿" . 191) ;; ¿ + ("À" . 192) ;; À + ("Á" . 193) ;; Á + ("Â" . 194) ;;  + ("Ã" . 195) ;; à + ("Ä" . 196) ;; Ä + ("Å" . 197) ;; Å + ("&Aelig" . 198) ;; Æ + ("Ç" . 199) ;; Ç + ("È" . 200) ;; È + ("É" . 201) ;; É + ("Ê" . 202) ;; Ê + ("Ë" . 203) ;; Ë + ("Ì" . 204) ;; Ì + ("Í" . 205) ;; Í + ("Î" . 206) ;; Î + ("Ï" . 207) ;; Ï + ("ð" . 208) ;; Ð + ("Ñ" . 209) ;; Ñ + ("Ò" . 210) ;; Ò + ("Ó" . 211) ;; Ó + ("Ô" . 212) ;; Ô + ("Õ" . 213) ;; Õ + ("Ö" . 214) ;; Ö + ("×" . 215) ;; × + ("Ø" . 216) ;; Ø + ("Ù" . 217) ;; Ù + ("Ú" . 218) ;; Ú + ("Û" . 219) ;; Û + ("Ü" . 220) ;; Ü + ("Ý" . 221) ;; Ý + ("þ" . 222) ;; Þ + ("ß" . 223) ;; ß + ("à" . 224) ;; à + ("á" . 225) ;; á + ("â" . 226) ;; â + ("ã" . 227) ;; ã + ("ä" . 228) ;; ä + ("å" . 229) ;; Ã¥ + ("æ" . 230) ;; æ + ("ç" . 231) ;; ç + ("è" . 232) ;; è + ("é" . 233) ;; é + ("ê" . 234) ;; ê + ("ë" . 235) ;; ë + ("ì" . 236) ;; ì + ("í" . 237) ;; í + ("î" . 238) ;; î + ("ï" . 239) ;; ï + ("ð" . 240) ;; ð + ("ñ" . 241) ;; ñ + ("ò" . 242) ;; ò + ("ó" . 243) ;; ó + ("ô" . 244) ;; ô + ("õ" . 245) ;; õ + ("ö" . 246) ;; ö + ("÷" . 247) ;; ÷ + ("ø" . 248) ;; ø + ("ù" . 249) ;; ù + ("ú" . 250) ;; ú + ("û" . 251) ;; û + ("ü" . 252) ;; ü + ("ý" . 253) ;; ý + ("þ" . 254) ;; þ + ("ÿ" . 255) ;; ÿ + ("®" . 174) ;; ® + ("­" . 173)) ;; ­ + + "Table of html character entities and values. +See https://www.freeformatter.com/html-entities.html") + +(defvar helm-find-many-files-after-hook nil + "Hook that runs at end of `helm-find-many-files'.") + +(defvar helm-marked-buffer-name "*helm marked*") + +;;; Faces. +;; +(defface helm-selection-line + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :inherit highlight :distant-foreground "black")) + "Face used in the `helm-current-buffer' when jumping to a candidate." + :group 'helm-faces) + +(defface helm-match-item + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :inherit isearch)) + "Face used to highlight the item matched in a selected line." + :group 'helm-faces) + + +;;; Utils functions +;; +;; +(defcustom helm-window-prefer-horizontal-split nil + "Maybe switch to other window vertically when non nil. + +Possible values are t, nil and `decide'. + +When t switch vertically. +When nil switch horizontally. +When `decide' try to guess if it is possible to switch vertically +according to the setting of `split-width-threshold' and the size of +the window from where splitting is done. + +Note that when using `decide' and `split-width-threshold' is nil, the +behavior is the same as with a nil value." + :group 'helm-utils + :type '(choice + (const :tag "Split window vertically" t) + (const :tag "Split window horizontally" nil) + (symbol :tag "Guess how to split window" 'decide))) + +(defcustom helm-window-show-buffers-function #'helm-window-decide-split-fn + "The default function to use when opening several buffers at once. +It is typically used to rearrange windows." + :group 'helm-utils + :type '(choice + (function :tag "Decide how to split according to number of candidates" + helm-window-decide-split-fn) + (function :tag "Split windows vertically or horizontally" + helm-window-default-split-fn) + (function :tag "Split in alternate windows" + helm-window-alternate-split-fn) + (function :tag "Split windows in mosaic" + helm-window-mosaic-fn))) + +(defun helm-window-show-buffers (buffers &optional other-window) + "Show BUFFERS. + +With more than one buffer marked switch to these buffers in separate windows. +If OTHER-WINDOW is non-nil, keep current buffer and switch to other buffers +in separate windows. +If a prefix arg is given split windows vertically." + (let ((initial-ow-fn (if (cdr (window-list)) + #'switch-to-buffer-other-window + #'helm-window-other-window))) + (if (cdr buffers) + (funcall helm-window-show-buffers-function buffers + (and other-window initial-ow-fn)) + (if other-window + (funcall initial-ow-fn (car buffers)) + (helm-buffers-switch-to-buffer-or-tab (car buffers)))))) + +(defvar tab-bar-tab-name-function) +(declare-function tab-bar-switch-to-tab "tab-bar.el") +(declare-function tab-bar-tab-name-all "tab-bar.el") + +(defun helm-buffers-maybe-switch-to-buffer-in-tab (buffer fallback-fn) + "Switch to BUFFER in its tab if possible, otherwise call FALLBACK-FN." + (let* (;; Normally `helm-buffers-maybe-switch-to-tab' custom set function + ;; bounded `tab-bar-tab-name-function' to `tab-bar-tab-name-all' + ;; but in case user bounded this with setq ensure it works + ;; at least partially by let-bounding it here. + (tab-bar-tab-name-function #'tab-bar-tab-name-all) + (tabs (tab-bar-tabs)) + (tab-names (mapcar (lambda (tab) + (cdr (assq 'name tab))) + tabs)) + (bname (buffer-name (get-buffer buffer))) + (tab (helm-buffers--get-tab-from-name bname tabs))) + (if (helm-buffers--buffer-in-tab-p bname tab-names) + (progn + (tab-bar-switch-to-tab (alist-get 'name tab)) + (select-window (get-buffer-window bname))) + (funcall fallback-fn buffer)))) + +(defun helm-buffers-switch-to-buffer-or-tab (buffer) + "Switch to BUFFER in its tab if some." + (if (and (fboundp 'tab-bar-mode) + helm-buffers-maybe-switch-to-tab + tab-bar-mode) + (helm-buffers-maybe-switch-to-buffer-in-tab + buffer #'switch-to-buffer) + (switch-to-buffer buffer))) + +(defun helm-buffers--get-tab-from-name (tab-name tabs) + "Return tab from TABS when it contains TAB-NAME." + (cl-loop for tab in tabs + when (member tab-name (split-string (cdr (assq 'name tab)) ", " t)) + return tab)) + +(defun helm-buffers-switch-buffers-in-tab-1 (buffers) + "Display BUFFERS in a new tab. +If only one buffer in BUFFERS, try to switch to it in its +tab if some, otherwise, display it in a new tab. +When a double prefix arg is given (C-u C-u), display each buffer of BUFFERS in +new tabs. When a single buffer is given, a single prefix arg will force +displaying buffer in a new tab even if it is already present in a tab. +When there is more than one buffer in BUFFERS a single prefix arg display the +buffers vertically according to `helm-window-show-buffers-function'." + (when (fboundp 'switch-to-buffer-other-tab) + (if (cdr buffers) + (if (equal helm-current-prefix-arg '(16)) + (cl-loop for b in buffers + do (switch-to-buffer-other-tab b)) + (switch-to-buffer-other-tab (car buffers)) + (helm-window-show-buffers buffers)) + (if helm-current-prefix-arg + (switch-to-buffer-other-tab (car buffers)) + (helm-buffers-maybe-switch-to-buffer-in-tab + (car buffers) #'switch-to-buffer-other-tab))))) + +(defun helm--get-tab-names () + (let ((tab-bar-tab-name-function #'tab-bar-tab-name-all)) + (mapcar (lambda (tab) + (cdr (assq 'name tab))) + (tab-bar-tabs)))) + +(defun helm-buffers--buffer-in-tab-p (buffer-name &optional tab-names) + "Check if BUFFER-NAME is in TAB-NAMES list." + (cl-loop for name in (or tab-names (helm--get-tab-names)) + ;; Buf names are separated with "," in TAB-NAMES + ;; e.g. '("tab-bar.el" "*scratch*, helm-buffers.el"). + thereis (member buffer-name (split-string name ", " t)))) + +(defun helm-window-decide-split-fn (candidates &optional other-window-fn) + "Try to find the best split window fn according to the number of CANDIDATES." + (let ((fn (cond (;; 4 or more. + (>= (length candidates) + (if other-window-fn 3 4)) + #'helm-window-mosaic-fn) + ;; 3 only. + ((= (length candidates) + (if other-window-fn 2 3)) + #'helm-window-alternate-split-fn) + ;; 2 or less. + (t #'helm-window-default-split-fn)))) + (funcall fn candidates other-window-fn))) + +(defun helm-window-default-split-fn (candidates &optional other-window-fn) + "Split windows in one direction and balance them. + +Direction can be controlled via `helm-window-prefer-horizontal-split'. +If a prefix arg is given split windows the other direction. +This function is suitable for `helm-window-show-buffers-function'." + (if other-window-fn + (funcall other-window-fn (car candidates)) + (switch-to-buffer (car candidates))) + (save-selected-window + (cl-loop with nosplit + for b in (cdr candidates) + when nosplit return + (message "Too many buffers to visit simultaneously") + do (condition-case _err + (helm-window-other-window b 'balance) + (error (setq nosplit t) nil))))) + +(defun helm-window-alternate-split-fn (candidates &optional other-window-fn) + "Split windows horizontally and vertically in alternate fashion. + +Direction can be controlled via `helm-window-prefer-horizontal-split'. +If a prefix arg is given split windows the other direction. +This function is suitable for `helm-window-show-buffers-function'." + (if other-window-fn + (funcall other-window-fn (car candidates)) + (switch-to-buffer (car candidates))) + (let (right-side) + (save-selected-window + (cl-loop with nosplit + for b in (cdr candidates) + when nosplit return + (message "Too many buffers to visit simultaneously") + do (condition-case _err + (let ((helm-current-prefix-arg right-side)) + (helm-window-other-window b) + (setq right-side (not right-side))) + (error (setq nosplit t) nil)))))) + +(defun helm-window-mosaic-fn (candidates &optional other-window-fn) + "Make an as-square-as-possible window mosaic of the CANDIDATES buffers. + +If rectangular, the long side is in the direction given by +`helm-window-prefer-horizontal-split': if non-nil, it is horizontal, vertical +otherwise. +If OTHER-WINDOW-FN is non-nil, current windows are included in the mosaic. +This function is suitable for `helm-window-show-buffers-function'." + (when other-window-fn + (setq candidates (append (mapcar 'window-buffer (window-list)) candidates))) + (delete-other-windows) + (let* ((helm-window-prefer-horizontal-split + (if (eq helm-window-prefer-horizontal-split 'decide) + (and (numberp split-width-threshold) + (>= (window-width (selected-window)) + split-width-threshold)) + helm-window-prefer-horizontal-split)) + mosaic-length-tile-count + mosaic-width-tile-count + mosaic-length-tile-size + mosaic-width-tile-size + next-window) + ;; If 4 tiles, make 2x2 mosaic. + ;; If 5-6 tiles, make 2x3 mosaic with direction depending on `helm-window-prefer-horizontal-split'. + ;; If 7-9 tiles, make 3x3 mosaic. And so on. + (setq mosaic-length-tile-count (ceiling (sqrt (length candidates)))) + (setq mosaic-width-tile-count + (if (<= (length candidates) (* mosaic-length-tile-count (1- mosaic-length-tile-count))) + (1- mosaic-length-tile-count) + mosaic-length-tile-count)) + ;; We lower-bound the tile size, otherwise the function would + ;; fail during the first inner split. + ;; There is consequently no need to check for errors when + ;; splitting. + (let ((frame-mosaic-length-direction-size (frame-height)) + (frame-mosaic-width-direction-size (frame-width)) + (window-mosaic-length-direction-min-size window-min-height) + (window-mosaic-width-direction-min-size window-min-width)) + (if helm-window-prefer-horizontal-split + (setq frame-mosaic-length-direction-size (frame-width) + frame-mosaic-width-direction-size (frame-height) + window-mosaic-length-direction-min-size window-min-width + window-mosaic-width-direction-min-size window-min-height)) + (setq mosaic-length-tile-size (max + (/ frame-mosaic-length-direction-size mosaic-length-tile-count) + window-mosaic-length-direction-min-size) + mosaic-width-tile-size (max + (/ frame-mosaic-width-direction-size mosaic-width-tile-count) + window-mosaic-width-direction-min-size)) + ;; Shorten `candidates' to `max-tiles' elements. + (let ((max-tiles (* (/ frame-mosaic-length-direction-size mosaic-length-tile-size) + (/ frame-mosaic-width-direction-size mosaic-width-tile-size)))) + (when (> (length candidates) max-tiles) + (message "Too many buffers to visit simultaneously") + (setcdr (nthcdr (- max-tiles 1) candidates) nil)))) + ;; Make the mosaic. + (while candidates + (when (> (length candidates) mosaic-length-tile-count) + (setq next-window (split-window nil + mosaic-width-tile-size + (not helm-window-prefer-horizontal-split)))) + (switch-to-buffer (pop candidates)) + (dotimes (_ (min (1- mosaic-length-tile-count) (length candidates))) + (select-window (split-window nil + mosaic-length-tile-size + helm-window-prefer-horizontal-split)) + (switch-to-buffer (pop candidates))) + (when next-window + (select-window next-window))))) + +(defun helm-window-other-window (buffer-or-name &optional balance) + "Switch to BUFFER-OR-NAME in other window. +Direction can be controlled via `helm-window-prefer-horizontal-split'. +If a prefix arg is given split windows the other direction. +When argument BALANCE is provided `balance-windows'." + (let* ((helm-window-prefer-horizontal-split + (if (eq helm-window-prefer-horizontal-split 'decide) + (and (numberp split-width-threshold) + (>= (window-width (selected-window)) + split-width-threshold)) + helm-window-prefer-horizontal-split)) + (right-side (if helm-window-prefer-horizontal-split + (not helm-current-prefix-arg) + helm-current-prefix-arg))) + (select-window (split-window nil nil right-side)) + (and balance (balance-windows)) + (switch-to-buffer buffer-or-name))) + +(cl-defun helm-current-buffer-narrowed-p (&optional + (buffer helm-current-buffer)) + "Check if BUFFER is narrowed. +Default is `helm-current-buffer'." + (with-current-buffer buffer + (let ((beg (point-min)) + (end (point-max)) + (total (buffer-size))) + (or (/= beg 1) (/= end (1+ total)))))) + +(defun helm-goto-char (loc) + "Go to char, revealing if necessary." + (goto-char loc) + (let ((fn (cond ((eq major-mode 'org-mode) + ;; On some old Emacs versions org may not be loaded. + (require 'org) + #'org-reveal) + ((and (boundp 'outline-minor-mode) + outline-minor-mode) + #'outline-show-subtree) + ((and (boundp 'hs-minor-mode) + hs-minor-mode) + #'hs-show-all) + ((and (boundp 'markdown-mode-map) + (derived-mode-p 'markdown-mode)) + #'markdown-show-entry))) + (hs-show-hook (list (lambda () (goto-char loc))))) + ;; outline may fail in some conditions e.g. with markdown enabled + ;; (Bug#1919). + (condition-case-unless-debug nil + (and fn (funcall fn)) + (error nil)))) + +(defun helm-goto-line (lineno &optional noanim) + "Goto LINENO opening only outline headline if needed. +Animation is used unless NOANIM is non--nil." + (helm-log-run-hook "helm-goto-line" + 'helm-goto-line-before-hook) + (helm-match-line-cleanup) + (unless helm-alive-p + (with-helm-current-buffer + (unless helm-yank-point (setq helm-yank-point (point))))) + (goto-char (point-min)) + (helm-goto-char (pos-bol lineno)) + (unless noanim + (helm-highlight-current-line))) + +(defun helm-save-pos-to-register-before-jump () + "Save current buffer position to `helm-save-pos-before-jump-register'. +To use this add it to `helm-goto-line-before-hook'." + (point-to-register helm-save-pos-before-jump-register)) + +(defun helm-save-current-pos-to-mark-ring () + "Save current buffer position to mark ring. +To use this add it to `helm-goto-line-before-hook'." + (set-marker (mark-marker) (point)) + (push-mark (point) 'nomsg)) + +(defun helm-displaying-source-names () + "Return the list of sources name for this helm session." + (with-current-buffer helm-buffer + (goto-char (point-min)) + (cl-loop with pos + while (setq pos (next-single-property-change (point) 'helm-header)) + do (goto-char pos) + collect (buffer-substring-no-properties (pos-bol)(pos-eol)) + do (forward-line 1)))) + +(defun helm-handle-winner-boring-buffers () + "Add `helm-buffer' to `winner-boring-buffers' when quitting/exiting helm. +Add this function to `helm-cleanup-hook' when you don't want to see helm buffers +after running winner-undo/redo." + (require 'winner) + (cl-pushnew helm-buffer winner-boring-buffers :test 'equal)) +(add-hook 'helm-cleanup-hook #'helm-handle-winner-boring-buffers) + +(defun helm-quit-and-find-file-1 () + "Drop into `helm-find-files' from `helm'. +If current selection is a buffer or a file, `helm-find-files' +from its directory." + (with-helm-alive-p + (require 'helm-grep) + (require 'helm-elisp) + (require 'bookmark) ; For bookmark-alist + (let ((src (helm-get-current-source))) + (helm-run-after-exit + (lambda (f) + ;; Ensure specifics `helm-execute-action-at-once-if-one' + ;; fns don't run here. + (let (helm-execute-action-at-once-if-one + helm-actions-inherit-frame-settings) ; use this-command + (if (file-exists-p f) + (helm-find-files-1 (file-name-directory f) + (format + helm-ff-last-expanded-candidate-regexp + (regexp-quote + (if helm-ff-transformer-show-only-basename + (helm-basename f) f)))) + (helm-find-files-1 f)))) + (helm--quit-and-find-file-default-file src))))) + +(defun helm--quit-and-find-file-default-file (source) + (let ((target-fn (or (helm-get-attr 'find-file-target source) + (assoc-default (helm-get-attr 'name source) + helm-mode-find-file-target-alist)))) + ;; target-fn function may return nil, in this case fallback to default. + (helm-aif (and target-fn (funcall target-fn source)) + it + (let* ((sel (helm-get-selection nil nil source)) + (default-preselection (or (helm-default-directory) + (buffer-file-name helm-current-buffer) + default-directory))) + (cond + ((and (stringp sel) (or (file-remote-p sel) + (file-exists-p sel))) + (expand-file-name sel)) + ;; Url. + ((and (stringp sel) + helm--url-regexp + (string-match helm--url-regexp sel)) + sel) + ;; Exit brutally from a `with-helm-show-completion' + ((and helm-show-completion-overlay + (overlayp helm-show-completion-overlay)) + (delete-overlay helm-show-completion-overlay) + (remove-hook 'helm-move-selection-after-hook 'helm-show-completion) + (expand-file-name default-preselection)) + ;; Default. + (t (expand-file-name default-preselection))))))) + +(defun helm-generic-sort-fn (s1 s2) + "Sort predicate function for helm candidates. +Args S1 and S2 can be single or (display . real) candidates, +that is sorting is done against real value of candidate." + (let* ((qpattern (regexp-quote helm-pattern)) + (reg1 (concat "\\_<" qpattern "\\_>")) + (reg2 (concat "\\_<" qpattern)) + (reg3 helm-pattern) + (split (helm-remove-if-match + "\\`!" (helm-mm-split-pattern helm-pattern))) + (str1 (if (consp s1) (cdr s1) s1)) + (str2 (if (consp s2) (cdr s2) s2)) + (score (lambda (str r1 r2 r3 lst) + (condition-case nil + (+ (if (string-match (concat "\\`" qpattern) str) 1 0) + (cond ((string-match r1 str) 5) + ((and (string-match " " qpattern) + (car lst) + (string-match + (concat "\\_<" (regexp-quote (car lst))) str) + (cl-loop for r in (cdr lst) + always (string-match r str))) + 4) + ((and (string-match " " qpattern) + (cl-loop for r in lst + always (string-match r str))) + 3) + ((string-match r2 str) 2) + ((string-match r3 str) 1) + (t 0))) + (invalid-regexp 0)))) + (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)) + ((= sc3 sc4) + (< (length str1) (length str2))) + (t (> sc3 sc4))))) + +(defun helm-file-human-size (size &optional kbsize) + "Return a string showing SIZE of a file in human readable form. +SIZE can be an integer or a float depending on it's value. +`file-attributes' will take care of that to avoid overflow error. +KBSIZE is a floating point number, defaulting to `helm-default-kbsize'." + (unless kbsize (setq kbsize helm-default-kbsize)) + (cl-loop with result = (cons "B" size) + for i in '("k" "M" "G" "T" "P" "E" "Z" "Y") + while (>= (cdr result) kbsize) + do (setq result (cons i (/ (cdr result) kbsize))) + finally return + (helm-acase (car result) + ("B" (format "%s" size)) + (t (format "%.1f%s" (cdr result) it))))) + +(defun helm-directory-size (directory &optional recursive human) + "Return the resulting size of the sum of all files in DIRECTORY. + +If RECURSIVE is non nil return the size of all files in DIRECTORY and +its subdirectories. With arg HUMAN format the size in a human +readable format,see `helm-file-human-size'." + (cl-loop with files = (if recursive + (helm-walk-directory + directory + :path 'full + :directories t) + (directory-files + directory t + directory-files-no-dot-files-regexp)) + for file in files + sum (nth 7 (file-attributes file)) into total + finally return (if human + (helm-file-human-size total) + total))) + +(defun helm-format-time-string (time) + "Format the time value TIME. +If year of TIME is inferior to current year +use \"%b %e %Y\" otherwise use \"%b %e %H:%M\"." + (let ((current-year (nth 5 (decode-time))) + (year (nth 5 (decode-time time))) + (fmt-opt '("%b %e %H:%M" + "%b %e %Y"))) + (if (< year current-year) + (format-time-string (nth 1 fmt-opt) time) + (format-time-string (nth 0 fmt-opt) time)))) + +(cl-defun helm-file-attributes + (file &key type links uid gid access-time modif-time + status size mode gid-change inode device-num dired human-size + mode-type mode-owner mode-group mode-other octal (string t)) + "Return `file-attributes' elements of FILE separately according to key value. +Availables keys are: +- TYPE: Same as nth 0 `files-attributes' if STRING is nil + otherwise return either symlink, directory or file (default). +- LINKS: See nth 1 `files-attributes'. +- UID: See nth 2 `files-attributes'. +- GID: See nth 3 `files-attributes'. +- ACCESS-TIME: See nth 4 `files-attributes', however format time + when STRING is non--nil (the default). +- MODIF-TIME: See nth 5 `files-attributes', same as above. +- STATUS: See nth 6 `files-attributes', same as above. +- SIZE: See nth 7 `files-attributes'. +- MODE: See nth 8 `files-attributes'. +- GID-CHANGE: See nth 9 `files-attributes'. +- INODE: See nth 10 `files-attributes'. +- DEVICE-NUM: See nth 11 `files-attributes'. +- DIRED: A line similar to what \\='ls -l' return. +- HUMAN-SIZE: The size in human form, see `helm-file-human-size'. +- MODE-TYPE, mode-owner,mode-group, mode-other: Split what + nth 8 `files-attributes' return in four categories. +- OCTAL: The octal value of MODE-OWNER+MODE-GROUP+MODE-OTHER. +- STRING: When non--nil (default) `helm-file-attributes' return + more friendly values. +If you want the same behavior as `files-attributes' , +\(but with return values in proplist) use a nil value for STRING. +However when STRING is non--nil, time and type value are different from what +you have in `file-attributes'." + (helm-aif (file-attributes file string) + (let* ((all (cl-destructuring-bind + (type links uid gid access-time modif-time + status size mode gid-change inode device-num) + it + (list :type (if string + (cond ((stringp type) "symlink") ; fname + (type "directory") ; t + (t "file")) ; nil + type) + :links links + :uid uid + :gid gid + :access-time (if string + (helm-format-time-string access-time) + access-time) + :modif-time (if string + (helm-format-time-string modif-time) + modif-time) + :status (if string + (format-time-string + "%Y-%m-%d %R" status) + status) + :size size + :mode mode + :gid-change gid-change + :inode inode + :device-num device-num))) + (perms (cl-getf all :mode)) + (modes (helm-split-mode-file-attributes perms nil t))) + (cond (type (cl-getf all :type)) + (links (cl-getf all :links)) + (uid (cl-getf all :uid)) + (gid (cl-getf all :gid)) + (access-time (cl-getf all :access-time)) + (modif-time (cl-getf all :modif-time)) + (status (cl-getf all :status)) + (size (cl-getf all :size)) + (mode perms) + (gid-change (cl-getf all :gid-change)) + (inode (cl-getf all :inode)) + (device-num (cl-getf all :device-num)) + (dired (helm-file-attributes-dired-line + all human-size octal)) + (human-size (helm-file-human-size (cl-getf all :size))) + (mode-type (cl-getf modes :mode-type)) + (mode-owner (cl-getf modes :user)) + (mode-group (cl-getf modes :group)) + (mode-other (cl-getf modes :other)) + (octal (cl-getf modes :octal)) + (t (append all modes)))))) + +(defun helm-file-attributes-dired-line (all &optional human-size show-octal) + (format "%s %s %s:%s %s %s" + (helm-split-mode-file-attributes + (cl-getf all :mode) t show-octal) + (number-to-string (cl-getf all :links)) + (cl-getf all :uid) + (cl-getf all :gid) + (if human-size + (helm-file-human-size (cl-getf all :size)) + (int-to-string (cl-getf all :size))) + (cl-getf all :modif-time))) + +(defun helm-split-mode-file-attributes (modes &optional string show-octal) + "Split MODES in a list of modes. +MODES is same as what (nth 8 (file-attributes \"foo\")) would return." + (if (string-match "\\`\\(.\\)\\(...\\)\\(...\\)\\(...\\)\\'" modes) + (let* ((type (match-string 1 modes)) + (user (match-string 2 modes)) + (group (match-string 3 modes)) + (other (match-string 4 modes)) + (octal (and show-octal + (helm-ff-numeric-permissions + (list user group other))))) + (if string + (mapconcat 'identity (list type user group other (or octal "")) "") + (list :mode-type type :user user + :group group :other other + :octal octal))) + (error "Wrong modes specification for %s" modes))) + +(defun helm-ff-numeric-permissions (perms) + "Return the numeric representation of PERMS. +PERMS is the list of permissions for owner, group and others." + ;; `file-modes-symbolic-to-number' interpret its MODES argument as what would + ;; result when calling such mode on a file with chmod, BTW we have to remove + ;; all "-" like read-file-modes does. + (helm-aand (listp perms) + (apply 'format "u=%s,g=%s,o=%s" perms) + (replace-regexp-in-string "-" "" it) + (format "%o" (file-modes-symbolic-to-number it)))) + +(defun helm-format-columns-of-files (files) + "Same as `dired-format-columns-of-files'. +Inlined here for compatibility." + (let ((beg (point))) + (completion--insert-strings files) + (put-text-property beg (point) 'mouse-face nil))) + +(defmacro with-helm-display-marked-candidates (buffer-or-name candidates &rest body) + (declare (indent 0) (debug t)) + (helm-with-gensyms (buffer window winconf) + `(let* ((,buffer (temp-buffer-window-setup ,buffer-or-name)) + (,winconf helm-last-frame-or-window-configuration) + (helm-always-two-windows t) + (helm-split-window-default-side + (if (eq helm-split-window-default-side 'same) + 'below helm-split-window-default-side)) + helm-split-window-inside-p + helm-reuse-last-window-split-state + ,window) + (with-current-buffer ,buffer + (helm-format-columns-of-files ,candidates)) + (unwind-protect + (with-selected-window + (setq ,window (temp-buffer-window-show + ,buffer + '(display-buffer-below-selected + (window-height . fit-window-to-buffer)))) + (progn ,@body)) + (quit-window 'kill ,window) + (and ,winconf (set-window-configuration ,winconf)))))) + +;;; Persistent Action Helpers +;; +;; +;; Internal +(defvar helm-match-line-overlay nil) +(defvar helm--match-item-overlays nil) + +(defun helm-highlight-current-line (&optional start end buf face) + "Highlight current line and all matching items around it. + +The number of lines around matched line where the matching items are +highlighted are defined by `helm-highlight-matches-around-point-max-lines'. +When the variable `helm-highlight-only-all-matches' is non nil only +the lines containing all matches (in case of multi match) are highlighted. + +Optional arguments START, END and FACE are only here for debugging purpose." + (catch 'never + (let* ((start (or start (line-beginning-position))) + (end (or end (1+ (line-end-position)))) + start-match end-match + (args (list start end buf)) + (case-fold-search (if helm-alive-p + (helm-set-case-fold-search) + case-fold-search))) + ;; Highlight the current line. + (if (not helm-match-line-overlay) + (setq helm-match-line-overlay (apply 'make-overlay args)) + (apply 'move-overlay helm-match-line-overlay args)) + (overlay-put helm-match-line-overlay + 'face (or face 'helm-selection-line)) + ;; Now highlight matches only if we are in helm session, we are + ;; maybe coming from helm-grep-mode or helm-moccur-mode buffers. + (when helm-alive-p + (helm-acase helm-highlight-matches-around-point-max-lines + ;; Next 2 clauses must precede others otherwise + ;; `helm-highlight-matches-around-point-max-lines' is + ;; compared as a number by other clauses and return an error. + (never (throw 'never nil)) + ((dst* (x . y)) + (setq start-match (save-excursion (forward-line (- x)) (pos-bol)) + end-match (save-excursion (forward-line y) (pos-bol)))) + ((guard* (or (null it) (zerop it))) + (setq start-match start + end-match end)) + ((guard* (< it 0)) + (setq start-match (save-excursion (forward-line it) (pos-bol)) + end-match start)) + ((guard* (> it 0)) + (setq start-match start + end-match (save-excursion (forward-line it) (pos-bol))))) + (catch 'empty-line + (let* ((regex-list (helm-remove-if-match + "\\`!" (helm-mm-split-pattern + (if (with-helm-buffer + ;; Needed for highlighting AG matches. + (assq 'pcre (helm-get-current-source))) + (helm--translate-pcre-to-elisp helm-input) + helm-input)))) + (num-regex (length regex-list))) + (save-excursion + (goto-char start-match) + (while (< (point) end-match) + (let* ((start-line (line-beginning-position)) + (end-line (line-end-position)) + all-matches) + (dolist (r regex-list) + (let ((match-list '())) + (save-excursion + (goto-char start-line) + (while (condition-case _err + (and (not (= start-line end-line)) + (if helm-migemo-mode + (helm-mm-migemo-forward r end-line t) + (re-search-forward r end-line t))) + (invalid-regexp nil)) + (let ((s (match-beginning 0)) + (e (match-end 0))) + (if (= s e) + (throw 'empty-line nil) + (push (cons s e) match-list))))) + (when match-list + (push match-list all-matches)))) + (when (and all-matches + (or (not helm-highlight-only-all-matches) + (eql (length all-matches) num-regex))) + (cl-loop for ml in all-matches + do (cl-loop for (s . e) in ml + for ov = (make-overlay s e) + do (progn + (push ov helm--match-item-overlays) + (overlay-put ov 'face 'helm-match-item) + (overlay-put ov 'priority 1)))))) + (forward-line 1)))))) + (recenter)))) + +(defun helm--translate-pcre-to-elisp (regexp) + "Should translate pcre REGEXP to elisp regexp. +Assume regexp is a pcre based regexp." + (with-temp-buffer + (insert " " regexp " ") + (goto-char (point-min)) + (save-excursion + ;; match (){}| unquoted + (helm-awhile (and (re-search-forward "\\([(){}|]\\)" nil t) + (match-string 1)) + (let ((pos (match-beginning 1))) + (if (eql (char-before pos) ?\\) + (delete-region pos (1- pos)) + (replace-match (concat "\\" it) t t nil 1))))) + ;; match \s or \S + (helm-awhile (and (re-search-forward "\\S\\?\\(\\s\\[sS]\\)[^-]" nil t) + (match-string 1)) + (replace-match (concat it "-") t t nil 1)) + (buffer-substring (1+ (point-min)) (1- (point-max))))) + +(defun helm-match-line-cleanup () + (when helm-match-line-overlay + (delete-overlay helm-match-line-overlay) + (setq helm-match-line-overlay nil)) + (when helm--match-item-overlays + (mapc 'delete-overlay helm--match-item-overlays))) + +(defun helm-match-line-cleanup-maybe () + (when (helm-empty-buffer-p) + (helm-match-line-cleanup))) + +(defun helm-match-line-update () + (when helm--match-item-overlays + (mapc 'delete-overlay helm--match-item-overlays)) + (when helm-match-line-overlay + (delete-overlay helm-match-line-overlay) + (helm-highlight-current-line))) + +(defun helm-persistent-autoresize-hook () + (when (and helm-buffers-to-resize-on-pa + (member helm-buffer helm-buffers-to-resize-on-pa) + (eq helm-split-window-state 'vertical)) + (set-window-text-height (helm-window) helm-resize-on-pa-text-height))) + +(defun helm-match-line-cleanup-pulse () + (run-with-timer 0.3 nil #'helm-match-line-cleanup)) + +(add-hook 'helm-after-update-hook 'helm-match-line-cleanup-maybe) +(add-hook 'helm-after-persistent-action-hook 'helm-persistent-autoresize-hook) +(add-hook 'helm-cleanup-hook 'helm-match-line-cleanup) +(add-hook 'helm-after-action-hook 'helm-match-line-cleanup-pulse) +(add-hook 'helm-after-persistent-action-hook 'helm-match-line-update) + +;;; Popup-info +;; +(defvar helm--show-popup-info-timer nil) +(defvar helm--maybe-show-popup-info-overlay nil) +(defface helm-tooltip + '((((type tty pc)) + :background "yellow" :foreground "black") + (t :background "goldenrod" :foreground "black")) + "Face used by `helm-popup-tip-show'." + :group 'helm-grep-faces) + +(defun helm-cancel-popup-tip-timer () + (when helm--show-popup-info-timer + (cancel-timer helm--show-popup-info-timer) + (setq helm--show-popup-info-timer nil)) + (when helm--maybe-show-popup-info-overlay + (delete-overlay helm--maybe-show-popup-info-overlay) + (setq helm--maybe-show-popup-info-overlay nil))) + +(defun helm-popup-tip-show (text pos) + "Display TEXT at POS in an overlay." + (setq helm--maybe-show-popup-info-overlay + (make-overlay pos (1+ pos))) + (overlay-put helm--maybe-show-popup-info-overlay + 'display + (propertize + (concat text "\n") + 'face 'helm-tooltip))) + +(defun helm-maybe-show-popup-tip-info () + (when helm--maybe-show-popup-info-overlay + (delete-overlay helm--maybe-show-popup-info-overlay)) + (let* ((src (helm-get-current-source)) + (popup-info-fn (assoc-default 'popup-info src))) + (when (and helm-alive-p + helm-popup-tip-mode + popup-info-fn) + (unless (timerp helm--show-popup-info-timer) + (setq helm--show-popup-info-timer + (run-with-idle-timer + 1 nil + (lambda () + (cancel-timer helm--show-popup-info-timer) + (setq helm--show-popup-info-timer nil) + ;; We may have an error (wrong-type-argument window-live-p nil) + ;; when switching to help window, the error may occur in the + ;; small lap of time where the helm-window is deleted and the + ;; help buffer not already displayed. + (ignore-error wrong-type-argument + (save-selected-window + (with-helm-window + (let ((pos (save-excursion (end-of-visual-line) (point))) + (str (and popup-info-fn + (funcall popup-info-fn (helm-get-selection))))) + (when (and str (not (string= str ""))) + (helm-popup-tip-show + (concat " " str) + pos))))))))))))) + +;;;###autoload +(define-minor-mode helm-popup-tip-mode + "Show additional informations in a popup tip at end of line. + +When the mode is enabled, popup showup when the source +has a `popup-info' attribute which define a specific function for +this source to fetch infos on candidate." + :global t + (if helm-popup-tip-mode + (progn + (add-hook 'helm-move-selection-after-hook 'helm-maybe-show-popup-tip-info) + (add-hook 'helm-help-mode-after-hook 'helm-maybe-show-popup-tip-info) + (add-hook 'helm-cleanup-hook 'helm-cancel-popup-tip-timer)) + (remove-hook 'helm-move-selection-after-hook 'helm-maybe-show-popup-tip-info) + (remove-hook 'helm-help-mode-after-hook 'helm-maybe-show-popup-tip-info) + (remove-hook 'helm-cleanup-hook 'helm-cancel-popup-tip-timer))) + +(defun helm-open-file-with-default-tool (file) + "Open FILE with the default tool on this platform." + (let (process-connection-type) + (if (eq system-type 'windows-nt) + (helm-w32-shell-execute-open-file file) + (start-process "helm-open-file-with-default-tool" + nil + (helm-acase system-type + (gnu/linux "xdg-open") + ((darwin macos) "open") + (cygwin "cygstart")) + file)))) + +(defun helm-open-dired (file) + "Open a dired buffer in FILE's directory. +If FILE is a directory, open this directory." + (require 'dired) + (if (file-directory-p file) + (dired file) + (dired (file-name-directory file)) + (dired-goto-file file))) + +(defun helm-find-file-as-root (candidate) + (let* ((buf (helm-basename candidate)) + (host (file-remote-p candidate 'host)) + (remote-path (format "/%s:%s:%s" + helm-su-or-sudo + (or host "") + (expand-file-name + (if host + (file-remote-p candidate 'localname) + candidate)))) + non-essential) + (if (buffer-live-p (get-buffer buf)) + (progn + (set-buffer buf) + (find-alternate-file remote-path)) + (find-file remote-path)))) + +(defun helm-find-many-files (_ignore) + "Simple action that run `find-file' on marked candidates. +Run `helm-find-many-files-after-hook' at end." + (let ((helm--reading-passwd-or-string t)) + (mapc 'find-file (helm-marked-candidates)) + (helm-log-run-hook "helm-find-many-files" + 'helm-find-many-files-after-hook))) + +(defun helm-read-repeat-string (prompt &optional count) + "Prompt as many time PROMPT is not empty. +If COUNT is non--nil add a number after each prompt. +Return the list of strings entered in each prompt." + (cl-loop with prt = prompt + with elm + while (not (string= elm "")) + for n from 1 + do (when count + (setq prt (format "%s (%s): " + (replace-regexp-in-string + ": " "" prompt) + (int-to-string n)))) + collect (setq elm (helm-read-string prt)) into lis + finally return (remove "" lis))) + +(defun helm-html-bookmarks-to-alist (file url-regexp bmk-regexp) + "Parse HTML bookmark FILE and return an alist with (title . url) as elements." + (let (bookmarks-alist url title) + (with-temp-buffer + (insert-file-contents file) + (goto-char (point-min)) + (while (re-search-forward "href=\\|^ *
. + +;;; Commentary: + +;;; Code: + +(require 'helm-for-files) + + +;;; List of files gleaned from every dired buffer +;; +;; +(defvar dired-buffers) +(defvar directory-files-no-dot-files-regexp) +(defun helm-files-in-all-dired-candidates () + "Return a list of files from live `dired' buffers." + (save-excursion + (cl-loop for (f . b) in dired-buffers + when (buffer-live-p b) + append (let ((dir (with-current-buffer b dired-directory))) + (if (listp dir) (cdr dir) + (directory-files f t directory-files-no-dot-files-regexp)))))) + +;; (dired '("~/" "~/.emacs.d/.emacs-custom.el" "~/.emacs.d/.emacs.bmk")) + +(defclass helm-files-dired-source (helm-source-sync helm-type-file) + ((candidates :initform #'helm-files-in-all-dired-candidates))) + +(defvar helm-source-files-in-all-dired + (helm-make-source "Files in all dired buffer." 'helm-files-dired-source)) + +;;; session.el files +;; +;; session (http://emacs-session.sourceforge.net/) is an alternative to +;; recentf that saves recent file history and much more. +(defvar session-file-alist) +(defclass helm-source-session-class (helm-source-sync) + ((candidates :initform (lambda () + (cl-delete-if-not + (lambda (f) + (or (string-match helm-tramp-file-name-regexp f) + (file-exists-p f))) + (mapcar 'car session-file-alist)))) + (keymap :initform 'helm-generic-files-map) + (help-message :initform 'helm-generic-file-help-message) + (action :initform 'helm-type-file-actions))) + +(defvar helm-source-session nil + "File list from emacs-session.") + +(defcustom helm-session-fuzzy-match nil + "Enable fuzzy matching in `helm-source-session' when non--nil." + :group 'helm-files + :type 'boolean + :set (lambda (var val) + (set var val) + (setq helm-source-session + (helm-make-source "Session" 'helm-source-session-class + :fuzzy-match val)))) + + +;;; External searching file tools. +;; +;; Tracker desktop search + +(defun helm-source-tracker-transformer (candidates _source) + "Return file names from tracker CANDIDATES." + ;; loop through tracker candidates selecting out file:// lines + ;; then select part after file:// and url decode to get straight filenames + (cl-loop for cand in candidates + when (and (stringp cand) + (string-match "\\`[[:space:]]*file://\\(.*\\)" cand)) + collect (url-unhex-string (match-string 1 cand)))) + +(defvar helm-source-tracker-search + (helm-build-async-source "Tracker Search" + :candidates-process + (lambda () + ;; the tracker-search command has been deprecated, now invoke via tracker + ;; also, disable the contextual snippets which we don't currently use + (start-process "tracker-search-process" nil + "tracker" "search" + "--disable-snippets" + "--disable-color" + "--limit=512" + helm-pattern)) + ;; new simplified transformer of tracker search results + :filtered-candidate-transformer #'helm-source-tracker-transformer + ;;(multiline) ; https://github.com/emacs-helm/helm/issues/529 + :keymap helm-generic-files-map + :action 'helm-type-file-actions + :action-transformer '(helm-transform-file-load-el + helm-transform-file-browse-url) + :requires-pattern 3) + "Source for the Tracker desktop search engine.") + +;; Spotlight (MacOS X desktop search) +(defclass helm-mac-spotlight-source (helm-source-async helm-type-file) + ((candidates-process :initform + (lambda () + (start-process + "mdfind-process" nil "mdfind" helm-pattern))) + (requires-pattern :initform 3))) + +(defvar helm-source-mac-spotlight + (helm-make-source "mdfind" 'helm-mac-spotlight-source) + "Source for retrieving files via Spotlight's command line utility mdfind.") + +(provide 'helm-x-files) + +;;; helm-x-files.el ends here diff --git a/elpa/helm-20260424.1357/helm-x-icons.el b/elpa/helm-20260424.1357/helm-x-icons.el new file mode 100644 index 00000000..c8d2bc52 --- /dev/null +++ b/elpa/helm-20260424.1357/helm-x-icons.el @@ -0,0 +1,168 @@ +;;; helm-x-icons.el --- Provide compatibility between icons providers -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2026 Thierry Volpiatto + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Code: + +(require 'helm-lib) + +(defgroup helm-x-icons nil + "Compatibility functions between icons provider packages." + :group 'helm) + +(defcustom helm-x-icons-provider (if (display-graphic-p) + 'all-the-icons 'nerd-icons) + "The icons provider package. +The currently supported providers are `all-the-icons' and `nerd-icons'. +Do not use setq to set this variable but customize." + :type '(choice + (const :tag "Use `all-the-icons' package" all-the-icons) + (const :tag "Use `nerd-icons' package" nerd-icons)) + :set (lambda (var val) + (when val (setq val (require val nil t))) + (set var val))) + +(defun helm-x-icons-match-to-alist (file type) + "Match FILE against an entry in ALIST using `string-match-p'. +Supported TYPE are ext, regexp, mode, url and dir." + (cl-loop with alist = (helm-x-icons-resolve-alist type) + for (elm . rest) in alist + for target = (if (eq type 'url) file (helm-basename file)) + when (string-match-p (helm-stringify elm) target) + return rest)) + +(defun helm-x-icons-resolve-alist (type) + "Return the icon alist corresponding to TYPE. +The returned alist is computed according to `helm-x-icons-provider'." + (let* ((provider-name (symbol-name helm-x-icons-provider)) + (alist-name (helm-acase type + (ext "extension-icon-alist") + (regexp "regexp-icon-alist") + (dir "dir-icon-alist") + (url "url-alist") + (mode "mode-icon-alist")))) + (symbol-value + (intern-soft (concat provider-name "-" alist-name))))) + +(defun helm-x-icons-icon-for-file (&rest args) + "Compatibility function for `*-icon-for-file'." + (let ((fn (helm-acase helm-x-icons-provider + (all-the-icons 'all-the-icons-icon-for-file) + (nerd-icons 'nerd-icons-icon-for-file))) + icon) + (when fn + (setq icon (apply fn args)) + (add-text-properties 0 1 `(icon ,(length icon)) icon) + icon))) + +(defvar helm-x-icons-nerd-icons-compat-alist + '(("file-symlink-directory" . (nerd-icons-codicon . "nf-cod-file_symlink_directory")) + ("file-directory" . (nerd-icons-sucicon . "nf-custom-folder_oct")) + ("star" . (nerd-icons-mdicon . "nf-md-star")) + ("mail-read" . (nerd-icons-codicon . "nf-cod-mail_read")) + ("info" . (nerd-icons-faicon . "nf-fa-info")) + ("link-external" . (nerd-icons-faicon . "nf-fa-external_link")) + ("mail" . (nerd-icons-mdicon . "nf-md-email")) + ("note_add" . (nerd-icons-codicon . "nf-cod-new_file")) + ("create_new_folder" . (nerd-icons-codicon . "nf-cod-new_folder")) + ("firefox" . (nerd-icons-faicon . "nf-fa-firefox")) + ("globe" . (nerd-icons-faicon . "nf-fa-globe")) + ("man-page" . (nerd-icons-octicon . "nf-oct-command_palette")) + ("crop" . (nerd-icons-faicon . "nf-fa-crop")) + ("package" . (nerd-icons-octicon . "nf-oct-package")) + ("color_lens" . (nerd-icons-mdicon . "nf-md-color_lens")) + ("cube" . (nerd-icons-mdicon . "nf-md-cube")) + ("three-bars" . (nerd-icons-codicon . "nf-code-three_bars")) + ("cog" . (nerd-icons-mdicon . "nf-md-cog")) + ("lightning" . (nerd-icons-mdicon . "nf-md-lightning_bolt")) + ("file" . (nerd-icons-mdicon . "nf-md-file")) + ("folder" . (nerd-icons-mdicon . "nf-md-folder")) + ("key" . (nerd-icons-faicon . "nf-fa-key")) + ("angle-double-right" . (nerd-icons-faicon . "nf-fa-angle-double-right")) + ("calculator" . (nerd-icons-mdicon . "nf-md-calculator")) + ("book" . (nerd-icons-codicon . "nf-cod-book")) + ("border_style" . (nerd-icons-mdicon . "nf-md-border_style")) + ("text_fields" . (nerd-icons-mdicon . "nf-md-text")) + ("code" . (nerd-icons-faicon . "nf-fa-code")) + ("bar-chart" . (nerd-icons-faicon . "nf-fa-bar_chart")) + ("clone" . (nerd-icons-faicon . "nf-fa-clone"))) + "The `nerd-icons' counterpart for icon names. +The `helm-x-icons-generic' function uses this alist to find `nerd-icons' +functions and names to display icons. +To each icon added here, its all-the-icons counterpart have to be added in +`helm-x-icons-all-the-icons-compat-alist'.") + +(defvar helm-x-icons-all-the-icons-compat-alist + '(("file-symlink-directory" . (all-the-icons-octicon . "file-symlink-directory")) + ("file-directory" . (all-the-icons-octicon . "file-directory")) + ("star" . (all-the-icons-octicon . "star")) + ("mail-read" . (all-the-icons-octicon . "mail-read")) + ("info" . (all-the-icons-octicon . "info")) + ("link-external" . (all-the-icons-octicon . "link-external")) + ("mail" . (all-the-icons-octicon . "mail")) + ("note_add" . (all-the-icons-material . "note_add")) + ("create_new_folder" . (all-the-icons-material . "create_new_folder")) + ("firefox" . (all-the-icons-faicon . "firefox")) + ("globe" . (all-the-icons-faicon . "globe")) + ("man-page" . (all-the-icons-fileicon . "man-page")) + ("crop" . (all-the-icons-material . "crop")) + ("package" . (all-the-icons-octicon . "package")) + ("color_lens" . (all-the-icons-material . "color_lens")) + ("cube" . (all-the-icons-faicon . "cube")) + ("three-bars" . (all-the-icons-octicon . "three-bars")) + ("cog" . (all-the-icons-faicon . "cog")) + ("lightning" . (all-the-icons-wicon . "lightning")) + ("file" . (all-the-icons-faicon . "file")) + ("folder" . (all-the-icons-faicon . "folder")) + ("key" . (all-the-icons-octicon . "key")) + ("angle-double-right" . (all-the-icons-faicon . "angle-double-right")) + ("calculator" . (all-the-icons-faicon . "calculator")) + ("book" . (all-the-icons-octicon . "book")) + ("border_style" . (all-the-icons-material . "border_style")) + ("text_fields" . (all-the-icons-material . "text_fields")) + ("code" . (all-the-icons-material . "code")) + ("bar-chart" . (all-the-icons-faicon . "bar-chart")) + ("clone" . (all-the-icons-faicon . "clone"))) + "The `all-the-icons' counterpart for icon names. +The `helm-x-icons-generic' function uses this alist to find `all-the-icons' +functions and names to display icons. +To each icon added here, its all-the-icons counterpart have to be added in +`helm-x-icons-nerd-icons-compat-alist'.") + +(defun helm-x-icons-generic (icon-name &rest args) + "Compatibility function for icons. +Run an `all-the-icons' or `nerd-icons' function according to +`helm-x-icons-provider'and ICON-NAME. +Functions and icon names are found in `helm-x-icons-all-the-icons-compat-alist' +and `helm-x-icons-nerd-icons-compat-alist'." + (let (fn icon) + (helm-acase helm-x-icons-provider + (nerd-icons + (helm-acase (assoc-default icon-name helm-x-icons-nerd-icons-compat-alist) + ((dst* (sym . name)) + (setq fn sym icon-name name)))) + (all-the-icons + (helm-acase (assoc-default icon-name helm-x-icons-all-the-icons-compat-alist) + ((dst* (sym . name)) + (setq fn sym icon-name name))))) + (when fn + (setq icon (apply fn icon-name args)) + (add-text-properties 0 1 `(icon ,(length icon)) icon) + icon))) + +(provide 'helm-x-icons) + +;;; helm-x-icons.el ends here diff --git a/elpa/helm-20260424.1357/helm.el b/elpa/helm-20260424.1357/helm.el new file mode 100644 index 00000000..5ef4111b --- /dev/null +++ b/elpa/helm-20260424.1357/helm.el @@ -0,0 +1,54 @@ +;;; helm.el --- Helm is an Emacs incremental and narrowing framework -*- lexical-binding: t -*- + +;; Copyright (C) 2007 Tamas Patrovics +;; 2008 ~ 2011 rubikitch +;; 2011 ~ 2026 Thierry Volpiatto + +;; This is a fork of anything.el wrote by Tamas Patrovics. + +;; Authors of anything.el: Tamas Patrovics +;; rubikitch +;; Thierry Volpiatto + +;; Author: Thierry Volpiatto +;; Package-Version: 20260424.1357 +;; Package-Revision: 3cd5097285dc +;; URL: https://emacs-helm.github.io/helm/ +;; Package-Requires: ((helm-core "4.0.7") (wfnames "1.2")) +;; Keywords: helm, convenience, files, buffers, grep, completion, lisp, matching, tools, help + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; This is just a wrapper for helm-core.el and a place holder we +;; currently use only to hold the package's metadata in the header. + +;;; Code: + +(require 'helm-core) +(require 'helm-global-bindings) + +;; Build info sources and commands once called (bug #2608). We need to autoload +;; only these commands which are bound in helm-global-bindings, if we add more +;; helm-info* commands to helm-global-bindings we will have to autoload them +;; here. Requiring helm-info here instead will make recursive require to helm so +;; don't do that. +(autoload 'helm-info-emacs "helm-info" nil t) +(autoload 'helm-info-gnus "helm-info" nil t) +(autoload 'helm-info-at-point "helm-info" nil t) + +(provide 'helm) + +;;; helm.el ends here diff --git a/elpa/helm-core-20251211.709/helm-core-autoloads.el b/elpa/helm-core-20251211.709/helm-core-autoloads.el deleted file mode 100644 index 175f9bd9..00000000 --- a/elpa/helm-core-20251211.709/helm-core-autoloads.el +++ /dev/null @@ -1,263 +0,0 @@ -;;; helm-core-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*- -;; Generated by the `loaddefs-generate' function. - -;; This file is part of GNU Emacs. - -;;; Code: - -(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path))) - - - -;;; Generated autoloads from helm-core.el - -(autoload 'helm-define-multi-key "helm-core" "\ -In KEYMAP, define key sequence KEY for function list FUNCTIONS. -Each function runs sequentially for each KEY press. -If DELAY is specified, switch back to initial function of FUNCTIONS list -after DELAY seconds. -The functions in FUNCTIONS list take no args. -E.g. - (defun foo () - (interactive) - (message \"Run foo\")) - (defun bar () - (interactive) - (message \"Run bar\")) - (defun baz () - (interactive) - (message \"Run baz\")) - -(helm-define-multi-key global-map (kbd \" q\") \\='(foo bar baz) 2) - -Each time \" q\" is pressed, the next function is executed. -Waiting more than 2 seconds between key presses switches back to -executing the first function on the next hit. - -(fn KEYMAP KEY FUNCTIONS &optional DELAY)") -(autoload 'helm-multi-key-defun "helm-core" "\ -Define NAME as a multi-key command running FUNS. -After DELAY seconds, the FUNS list is reinitialized. -See `helm-define-multi-key'. - -(fn NAME DOCSTRING FUNS &optional DELAY)" nil t) -(function-put 'helm-multi-key-defun 'lisp-indent-function 2) -(function-put 'helm-multi-key-defun 'doc-string-elt 2) -(autoload 'helm-define-key-with-subkeys "helm-core" "\ -Define in MAP a KEY and SUBKEY to COMMAND. - -This allows typing KEY to call COMMAND the first time and -type only SUBKEY on subsequent calls. - -Arg MAP is the keymap to use, SUBKEY is the initial short -key binding to call COMMAND. - -Arg OTHER-SUBKEYS is an alist specifying other short key bindings -to use once started, e.g.: - - (helm-define-key-with-subkeys global-map - (kbd \"C-x v n\") ?n \\='git-gutter:next-hunk - \\='((?p . git-gutter:previous-hunk))) - -In this example, `C-x v n' will run `git-gutter:next-hunk' -subsequent \"n\" will run this command again and subsequent \"p\" -will run `git-gutter:previous-hunk'. - -If specified PROMPT can be displayed in minibuffer to describe -SUBKEY and OTHER-SUBKEYS. Arg EXIT-FN specifies a function to run -on exit. - -For any other key pressed, run their assigned command as defined -in MAP and then exit the loop running EXIT-FN, if specified. - -If DELAY is specified the command expires after DELAY seconds. - -NOTE: SUBKEY and OTHER-SUBKEYS bindings support only char syntax -and vectors, so don't use strings to define them. While defining -or executing a kbd macro no SUBKEY or OTHER-SUBKEYS are provided, -i.e. the loop is not entered after running COMMAND. - -(fn MAP KEY SUBKEY COMMAND &optional OTHER-SUBKEYS PROMPT EXIT-FN DELAY DOCSTRING)") -(function-put 'helm-define-key-with-subkeys 'lisp-indent-function 1) -(autoload 'helm-configuration "helm-core" "\ -Customize Helm." t) -(autoload 'helm-debug-open-last-log "helm-core" "\ -Open Helm log file or buffer of last Helm session." t) -(autoload 'helm "helm-core" "\ -Main function to execute helm sources. - -PLIST is a list like - -(:key1 val1 :key2 val2 ...) - - or - -(&optional sources input prompt resume preselect - buffer keymap default history allow-nest). - -** Keywords - -Keywords supported: - -- :sources -- :input -- :prompt -- :resume -- :preselect -- :buffer -- :keymap -- :default -- :history -- :allow-nest - -Extra LOCAL-VARS keywords are supported, see the \"** Other -keywords\" section below. - -Basic keywords are the following: - -*** :sources - -One of the following: - -- List of sources -- Symbol whose value is a list of sources -- Alist representing a Helm source. - - In this case the source has no name and is referenced in - `helm-sources' as a whole alist. - -*** :input - -Initial input of minibuffer (temporary value of `helm-pattern') - -*** :prompt - -Minibuffer prompt. Default value is `helm--prompt'. - -*** :resume - -If t, allow resumption of the previous session of this Helm -command, skipping initialization. - -If \\='noresume, this instance of `helm' cannot be resumed. - -*** :preselect - -Initially selected candidate (string or regexp). - -*** :buffer - -Buffer name for this Helm session. `helm-buffer' will take this value. - -*** :keymap - -[Obsolete] - -Keymap used at the start of this Helm session. - -It is overridden by keymaps specified in sources, and is kept -only for backward compatibility. - -Keymaps should be specified in sources using the :keymap slot -instead. See `helm-source'. - -This keymap is not restored by `helm-resume'. - -*** :default - -Default value inserted into the minibuffer with -\\\\[next-history-element]. - -It can be a string or a list of strings, in this case -\\\\[next-history-element] cycles through -the list items, starting with the first. - -If nil, `thing-at-point' is used. - -If `helm-maybe-use-default-as-input' is non-nil, display is -updated using this value if this value matches, otherwise it is -ignored. If :input is specified, it takes precedence on :default. - -*** :history - -Minibuffer input, by default, is pushed to `minibuffer-history'. - -When an argument HISTORY is provided, input is pushed to -HISTORY. HISTORY should be a valid symbol. - -*** :allow-nest - -Allow running this Helm command in a running Helm session. - -** Other keywords - -Other keywords are interpreted as local variables of this Helm -session. The `helm-' prefix can be omitted. For example, - -(helm :sources \\='helm-source-buffers-list - :buffer \"*helm buffers*\" - :candidate-number-limit 10) - -Starts a Helm session with the variable -`helm-candidate-number-limit' set to 10. - -** Backward compatibility - -For backward compatibility, positional parameters are -supported: - -(helm sources input prompt resume preselect - buffer keymap default history allow-nest) - -However, the use of non-keyword args is deprecated. - -(fn &key SOURCES INPUT PROMPT RESUME PRESELECT BUFFER KEYMAP DEFAULT HISTORY ALLOW-NEST OTHER-LOCAL-VARS)") -(autoload 'helm-cycle-resume "helm-core" "\ -Cycle in `helm-buffers' list and resume when waiting more than 1.2s." t) -(autoload 'helm-other-buffer "helm-core" "\ -Simplified Helm interface with other `helm-buffer'. -Call `helm' only with SOURCES and BUFFER as args. - -(fn SOURCES BUFFER)") -(register-definition-prefixes "helm-core" '("helm-" "with-helm-")) - - -;;; Generated autoloads from helm-lib.el - -(autoload 'helm-add-to-list "helm-lib" "\ -Add or move ELM to the value of VAR at INDEX unless already here. - -If ELM is member of var value and at index INDEX, return var value -unchanged, if INDEX value is different move ELM at this `nth' INDEX value. -If ELM is not present in list add it at `nth' INDEX. - -If REPLACE is non nil replace element at INDEX by ELM. - -Do not use this function in helm code, use `helm-append-at-nth' -instead. It is meant to be used in config files only. - -(fn VAR ELM INDEX &optional REPLACE)") -(register-definition-prefixes "helm-lib" '("helm-" "with-helm-")) - - -;;; Generated autoloads from helm-multi-match.el - -(register-definition-prefixes "helm-multi-match" '("helm-m")) - - -;;; Generated autoloads from helm-source.el - -(register-definition-prefixes "helm-source" '("helm-")) - -;;; End of scraped data - -(provide 'helm-core-autoloads) - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; no-native-compile: t -;; coding: utf-8-emacs-unix -;; End: - -;;; helm-core-autoloads.el ends here diff --git a/elpa/helm-core-20251211.709/helm-core-pkg.el b/elpa/helm-core-20251211.709/helm-core-pkg.el deleted file mode 100644 index dab0ad61..00000000 --- a/elpa/helm-core-20251211.709/helm-core-pkg.el +++ /dev/null @@ -1,10 +0,0 @@ -;; -*- no-byte-compile: t; lexical-binding: nil -*- -(define-package "helm-core" "20251211.709" - "Development files for Helm." - '((emacs "25.1") - (async "1.9.9")) - :url "https://emacs-helm.github.io/helm/" - :commit "c9a6c2542e5ec48700d1a72632cef009e5ee3253" - :revdesc "c9a6c2542e5e" - :authors '(("Thierry Volpiatto" . "thievol@posteo.net")) - :maintainers '(("Thierry Volpiatto" . "thievol@posteo.net"))) diff --git a/elpa/helm-core-20251211.709/helm-core.el b/elpa/helm-core-20251211.709/helm-core.el deleted file mode 100644 index 8bdd2cbf..00000000 --- a/elpa/helm-core-20251211.709/helm-core.el +++ /dev/null @@ -1,8384 +0,0 @@ -;;; helm-core.el --- Development files for Helm -*- lexical-binding: t -*- - -;; Copyright (C) 2022 ~ 2025 Thierry Volpiatto - -;; Author: Thierry Volpiatto -;; URL: https://emacs-helm.github.io/helm/ -;; Package-Version: 20251211.709 -;; Package-Revision: c9a6c2542e5e -;; Package-Requires: ((emacs "25.1") (async "1.9.9")) - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Commentary: - -;; Contains the main code for Helm. -;; As a package helm-core provides the files helm-core.el, helm-lib.el, -;; helm-source.el and helm-multi-match.el. - -;;; Code: - -(require 'cl-lib) -(require 'async) -(require 'helm-lib) -(require 'helm-multi-match) -(require 'helm-source) - -(defun helm-acase-extra-fontifications () - (font-lock-add-keywords nil '(("\\<\\(guard\\|dst\\)\\>\\*" . font-lock-type-face)))) -(add-hook 'emacs-lisp-mode-hook #'helm-acase-extra-fontifications) - -;; 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") -(declare-function helm-quit-and-find-file-1 "helm-utils.el") -(declare-function linum-mode "linum.el") -(declare-function minibuffer-depth-setup "mb-depth.el") -(declare-function transient--delete-window "ext:transient" ()) -(declare-function transient--preserve-window-p "ext:transient" - (&optional nohide)) -(declare-function helm-maybe-show-popup-tip-info "helm-utils") - -(defvar helm-marked-buffer-name) -(defvar display-buffer-function) -(defvar minibuffer-follows-selected-frame) -(defvar minibuffer-depth-indicate-mode) - - -;;; Internal Variables -;; -;; -(defvar helm-source-filter nil - "A list of source names to be displayed. -Other sources won't appear in the search results. -If nil, no filtering is done. -Don't set this directly, use `helm-set-source-filter' during a -Helm session to modify it.") -(defvar helm-saved-action nil - "Saved value of the currently selected action by key.") -(defvar helm-saved-current-source nil - "Value of the current source when the action list is shown.") -(defvar helm-in-persistent-action nil - "Flag whether in persistent-action or not.") -(defvar helm-last-buffer nil - "`helm-buffer' of a previous Helm session.") -(defvar helm-saved-selection nil - "Value of the currently selected object when the action list is shown.") -(defvar helm-sources nil - "[INTERNAL] Value of current sources in use, a list of alists. -The list of sources (symbols or alists) is normalized to alists -in `helm-initialize'.") -(defvar helm-buffer-file-name nil - "Variable `buffer-file-name' when Helm is invoked.") -(defvar helm-candidate-cache (make-hash-table :test 'equal) - "Holds the available candidate within a single Helm invocation.") -(defvar helm--candidate-buffer-alist nil) -(defvar helm-input "" - "The input typed in the candidates panel.") -(defvar helm-input-local nil - "Internal, store locally `helm-pattern' value for later use in `helm-resume'.") -(defvar helm--source-name nil) -(defvar helm-current-source nil) -(defvar helm-issued-errors nil) -(defvar helm--last-log-file nil - "The name of the log file of the last Helm session.") -(defvar helm--local-variables nil) -(defvar helm-split-window-state nil) -(defvar helm--window-side-state nil) -(defvar helm-selection-point nil - "The value of point at selection.") -(defvar helm-alive-p nil) -(defvar helm-visible-mark-overlays nil) -(defvar helm--force-updating-p nil - "[INTERNAL] Don't use this in your programs.") -(defvar helm-exit-status 0 - "Flag to inform if Helm did exit or quit. -0 means Helm did exit when executing an action. -1 means Helm did quit with \\[keyboard-quit] -Knowing this exit-status could help restore a window config when -Helm aborts in some special circumstances. See -`helm-exit-minibuffer' and `helm-keyboard-quit'.") -(defvar helm-minibuffer-confirm-state nil) -(defvar helm--quit nil) -(defvar helm-buffers nil - "Helm buffers listed in order of most recently used.") -(defvar helm-current-position nil - "Cons of (point . window-start) when Helm is invoked. -`helm-current-buffer' uses this to restore position after -`helm-keyboard-quit'") -(defvar helm-last-frame-or-window-configuration nil - "Used to store window or frame configuration at Helm start.") -(defvar helm-onewindow-p nil) -(defvar helm-types nil) -(defvar helm--mode-line-string-real nil) ; The string to display in mode-line. -(defvar helm-persistent-action-display-window nil) -(defvar helm-marked-candidates nil - "Marked candidates. List of (source . real) pair.") -(defvar helm--mode-line-display-prefarg nil) -(defvar helm--temp-follow-flag nil - "[INTERNAL] A simple flag to notify persistent action we are following.") -(defvar helm--reading-passwd-or-string nil) -(defvar helm--in-update nil) -(defvar helm--in-fuzzy nil) -(defvar helm-maybe-use-default-as-input nil - "Flag to notify the use of use-default-as-input. -Use only in let-bindings. -Use :default arg of `helm' as input to update display. -Note that if also :input is specified as `helm' arg, it will take -precedence on :default.") -(defvar helm--temp-hooks nil - "Store temporary hooks added by `with-helm-temp-hook'.") -(defvar helm--prompt nil) -(defvar helm--file-completion-sources - '("Find Files" "Read File Name" "New file or directory") - "Sources that use the *find-files mechanism can be added here. -Sources generated by `helm-mode' don't need to be added here -because they are automatically added. - -You should not modify this yourself unless you know what you are -doing.") -(defvar helm--completing-file-name nil - "Non nil when `helm-read-file-name' is running. -Used for `helm-file-completion-source-p'.") -;; Same as `ffap-url-regexp' but keep it here to ensure `ffap-url-regexp' is not nil. -(defvar helm--url-regexp "\\`\\(news\\(post\\)?:\\|mailto:\\|file:\\|\\(ftp\\|https?\\|telnet\\|gopher\\|www\\|wais\\)://\\)") -(defvar helm--ignore-errors nil - "Flag to prevent Helm popping up errors in candidates functions. -Should be set in candidates functions if needed, and will be -restored at end of session.") -(defvar helm--action-prompt "Select action: ") -(defvar helm--cycle-resume-iterator nil) -(defvar helm--buffer-in-new-frame-p nil) -(defvar helm-initial-frame nil - "[INTERNAL] The selected frame before starting Helm. -Helm use this internally to know in which frame it started, don't -modify this yourself.") -(defvar helm-popup-frame nil - "The frame where Helm is displayed. - -This is only used when Helm is using -`helm-display-buffer-in-own-frame' as `helm-display-function' and -`helm-display-buffer-reuse-frame' is non nil.") -(defvar helm--nested nil) -(defconst helm--frame-default-attributes - '(width height tool-bar-lines left top - title undecorated vertical-scroll-bars - visibility fullscreen menu-bar-lines undecorated - alpha foreground-color background-color) - "Frame parameters to save in `helm--last-frame-parameters'.") -(defvar helm--last-frame-parameters nil - "Frame parameters to save for later resuming. -Local to `helm-buffer'.") -(defvar helm--executing-helm-action nil - "Non nil when action is triggering a new helm-session. -This may be let bounded in other places to notify the display -function to reuse the same frame parameters as the previous Helm -session just like resume would do.") -(defvar helm--current-buffer-narrowed nil) -(defvar helm--suspend-update-interactive-flag nil) -(defvar helm-persistent-action-window-buffer nil - "[INTERNAL] Store the buffer where helm is started. -It is generally `helm-current-buffer', but when this one is displayed -in a dedicated buffer, helm can't start in this window and use another -window handling a buffer, it is this one we store.") -(defvar helm--tramp-archive-maybe-loaded nil) -(defvar helm--original-dedicated-windows-alist nil - "[INTERNAL] Store all dedicated windows with their dedicated state on startup") -(defvar helm--deleting-minibuffer-contents-from nil - "[INTERNAL] Recenter when deleting minibuffer-contents and preselecting. -This is a flag used internally.") -(defvar helm--minibuffer-completing-file-name nil - "[INTERNAL] A flag notifying Helm is in file completion. -It is let-bounded in `helm-read-file-name'. Same as -`minibuffer-completing-file-name' but doesn't affect `file-directory-p' when -called on remote files. -WARN: Use this only in `helm-read-file-name'.") - -;;; Multi keys -;; -;; -;;;###autoload -(defun helm-define-multi-key (keymap key functions &optional delay) - "In KEYMAP, define key sequence KEY for function list FUNCTIONS. -Each function runs sequentially for each KEY press. -If DELAY is specified, switch back to initial function of FUNCTIONS list -after DELAY seconds. -The functions in FUNCTIONS list take no args. -E.g. - (defun foo () - (interactive) - (message \"Run foo\")) - (defun bar () - (interactive) - (message \"Run bar\")) - (defun baz () - (interactive) - (message \"Run baz\")) - -\(helm-define-multi-key global-map (kbd \" q\") \\='(foo bar baz) 2) - -Each time \" q\" is pressed, the next function is executed. -Waiting more than 2 seconds between key presses switches back to -executing the first function on the next hit." - (define-key keymap key (helm-make-multi-command functions delay))) - -;;;###autoload -(defmacro helm-multi-key-defun (name docstring funs &optional delay) - "Define NAME as a multi-key command running FUNS. -After DELAY seconds, the FUNS list is reinitialized. -See `helm-define-multi-key'." - (declare (indent 2) (doc-string 2)) - (setq docstring (if docstring (concat docstring "\n\n") - "This is a helm-ish multi-key command.")) - `(defalias (quote ,name) (helm-make-multi-command ,funs ,delay) ,docstring)) - -(defun helm-make-multi-command (functions &optional delay) - "Return an anonymous multi-key command running FUNCTIONS. -Run each function in the FUNCTIONS list in turn when called within -DELAY seconds." - (declare (indent 1)) - (let ((funs functions) - (iter (list nil)) ; ref-cell[1]. - (timeout delay)) - (lambda () - (interactive) - (helm-run-multi-key-command funs iter timeout)))) - -(defun helm-run-multi-key-command (functions iterator delay) - (let ((fn (lambda () - (cl-loop for count from 1 to (length functions) - collect count))) - next) - ;; By passing a list containing a single 'nil' element [1] as ITERATOR we - ;; avoid using a global var. - (unless (and (car iterator) - ;; Reset iterator when another key is pressed. - (eq this-command real-last-command)) - (setcar iterator (helm-iter-circular (funcall fn)))) - (setq next (helm-iter-next (car iterator))) - (and next (car iterator) - (call-interactively (nth (1- next) functions))) - (when delay (run-with-idle-timer - delay nil (lambda () - (setcar iterator nil)))))) - -(defun helm-command-with-subkeys (map subkey command - &optional other-subkeys prompt exit-fn delay) - "Build a command that run COMMAND when SUBKEY is read. - -The command runs a loop reading keys and exit when user stops typing after DELAY -seconds. After this DELAY EXIT-FN run if specified. - -Arg OTHER-SUBKEYS should be an alist composed of (command . short-key) where -command is another command than COMMAND bound to short-key. - -A PROMPT can be used to describe bindings of COMMAND and OTHER-SUBKEYS. - -Return an anonymous interactive command to use with -`helm-define-key-with-subkeys'." - (lambda () - (interactive) - (let (timer) - (call-interactively command) - (unless (or defining-kbd-macro executing-kbd-macro) - (unwind-protect - (progn - (when delay - (setq timer (run-with-idle-timer - delay nil (lambda () (keyboard-quit))))) - (while (let ((input (read-key prompt)) other kb com) - (setq last-command-event input) - (cond - ((eq input subkey) - (call-interactively command) - (setq last-command command) - t) - ((setq other (assoc input other-subkeys)) - (call-interactively (cdr other)) - (setq last-command (cdr other)) - t) - (t - (setq kb (vector last-command-event)) - (setq com (lookup-key map kb)) - (if (commandp com) - (call-interactively com) - (setq unread-command-events - (nconc (mapcar #'identity kb) - unread-command-events))) - nil))))) - (when timer (cancel-timer timer)) - (and exit-fn (funcall exit-fn))))))) - -;;;###autoload -(defun helm-define-key-with-subkeys (map key subkey command - &optional other-subkeys - prompt exit-fn delay - docstring) - "Define in MAP a KEY and SUBKEY to COMMAND. - -This allows typing KEY to call COMMAND the first time and -type only SUBKEY on subsequent calls. - -Arg MAP is the keymap to use, SUBKEY is the initial short -key binding to call COMMAND. - -Arg OTHER-SUBKEYS is an alist specifying other short key bindings -to use once started, e.g.: - - (helm-define-key-with-subkeys global-map - (kbd \"C-x v n\") ?n \\='git-gutter:next-hunk - \\='((?p . git-gutter:previous-hunk))) - -In this example, `C-x v n' will run `git-gutter:next-hunk' -subsequent \"n\" will run this command again and subsequent \"p\" -will run `git-gutter:previous-hunk'. - -If specified PROMPT can be displayed in minibuffer to describe -SUBKEY and OTHER-SUBKEYS. Arg EXIT-FN specifies a function to run -on exit. - -For any other key pressed, run their assigned command as defined -in MAP and then exit the loop running EXIT-FN, if specified. - -If DELAY is specified the command expires after DELAY seconds. - -NOTE: SUBKEY and OTHER-SUBKEYS bindings support only char syntax -and vectors, so don't use strings to define them. While defining -or executing a kbd macro no SUBKEY or OTHER-SUBKEYS are provided, -i.e. the loop is not entered after running COMMAND." - (declare (indent 1)) - (let ((fn (helm-command-with-subkeys - map subkey command other-subkeys prompt exit-fn delay)) - (com (intern (format "helm-%s-with-subkeys" - (symbol-name command))))) - (defalias com fn - (or docstring - ;; When no DOCSTRING, generate a basic one specifying - ;; COMMAND, SUBKEY and OTHER-SUBKEYS. - (concat - (format "Run `%s' and bound it to `%s' for subsequent calls." - command (if (numberp subkey) (single-key-description subkey) subkey)) - (if other-subkeys - (helm-basic-docstring-from-alist other-subkeys) - "")))) - (define-key map key com))) - -(defun helm-basic-docstring-from-alist (alist) - (let* ((len (length alist)) - (osk (cl-loop for (k . v) in alist - for count from 1 - for sep = (cond ((and (= count len) (> len 1)) - " and ") - ((> count 1) ",") - (t "")) - for key = (if (numberp k) (single-key-description k) k) - concat (format "%s`%s'" sep key) into ks - concat (format "%s`%s'" sep v) into kv - finally return (list ks kv)))) - (format "\nBound as well %s to %s%s." - (car osk) (if (> len 1) "respectively " "") (cadr osk)))) - -;;; Keymap -;; -;; -(defvar helm-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map minibuffer-local-map) - (define-key map (kbd "") #'helm-next-line) - (define-key map (kbd "") #'helm-previous-line) - (define-key map (kbd "C-n") #'helm-next-line) - (define-key map (kbd "C-p") #'helm-previous-line) - (define-key map (kbd "") #'helm-follow-action-forward) - (define-key map (kbd "") #'helm-follow-action-backward) - (define-key map (kbd "") #'helm-previous-page) - (define-key map (kbd "") #'helm-next-page) - (define-key map (kbd "M-v") #'helm-scroll-up) - (define-key map (kbd "C-v") #'helm-scroll-down) - (define-key map (kbd "M-<") #'helm-beginning-of-buffer) - (define-key map (kbd "M->") #'helm-end-of-buffer) - (define-key map (kbd "C-g") #'helm-keyboard-quit) - (define-key map (kbd "") #'helm-maybe-exit-minibuffer) - (define-key map (kbd "C-i") #'helm-select-action) - (define-key map (kbd "C-j") #'helm-execute-persistent-action) - (define-key map (kbd "C-o") #'helm-next-source) - (define-key map (kbd "M-o") #'helm-previous-source) - (define-key map (kbd "") #'helm-next-source) - (define-key map (kbd "") #'helm-previous-source) - (define-key map (kbd "C-l") #'helm-recenter-top-bottom-other-window) - (define-key map (kbd "M-C-l") #'helm-reposition-window-other-window) - (define-key map (kbd "C-M-v") #'helm-scroll-other-window) - (define-key map (kbd "M-") #'helm-scroll-other-window) - (define-key map (kbd "C-M-y") #'helm-scroll-other-window-down) - (define-key map (kbd "C-M-S-v") #'helm-scroll-other-window-down) - (define-key map (kbd "M-") #'helm-scroll-other-window-down) - (define-key map (kbd "") #'helm-scroll-other-window) - (define-key map (kbd "") #'helm-scroll-other-window-down) - (define-key map (kbd "C-@") #'helm-toggle-visible-mark) - (define-key map (kbd "C-SPC") #'helm-toggle-visible-mark-forward) - (define-key map (kbd "M-SPC") #'helm-toggle-visible-mark-backward) - (define-key map (kbd "M-[") nil) - (define-key map (kbd "M-(") #'helm-prev-visible-mark) - (define-key map (kbd "M-)") #'helm-next-visible-mark) - (define-key map (kbd "C-k") #'helm-delete-minibuffer-contents) - (define-key map (kbd "DEL") #'helm-delete-char-backward) - (define-key map (kbd "C-x C-f") #'helm-quit-and-find-file) - (define-key map (kbd "M-m") #'helm-toggle-all-marks) - (define-key map (kbd "M-a") #'helm-mark-all) - (define-key map (kbd "M-U") #'helm-unmark-all) - (define-key map (kbd "C-M-a") #'helm-show-all-candidates-in-source) - (define-key map (kbd "C-M-f") #'helm-limit-to-sources) - (define-key map (kbd "C-M-e") #'helm-display-all-sources) - (define-key map (kbd "C-s") #'undefined) - (define-key map (kbd "M-s") #'undefined) - (define-key map (kbd "C-r") #'undefined) - (define-key map (kbd "C-M-r") #'undefined) - (define-key map (kbd "C-M-s") #'undefined) - (define-key map (kbd "C-M-i") #'undefined) - (define-key map (kbd "C-;") #'undefined) - (define-key map (kbd "C-}") #'helm-narrow-window) - (define-key map (kbd "C-{") #'helm-enlarge-window) - (define-key map (kbd "C-c -") #'helm-swap-windows) - (define-key map (kbd "C-c _") #'helm-toggle-full-frame) - (define-key map (kbd "C-z") #'helm-toggle-full-frame) - (define-key map (kbd "C-c %") #'helm-exchange-minibuffer-and-header-line) - (define-key map (kbd "C-c C-y") #'helm-yank-selection) - (define-key map (kbd "C-c C-k") #'helm-kill-selection-and-quit) - (define-key map (kbd "C-c C-i") #'helm-insert-or-copy) - (define-key map (kbd "C-c C-f") #'helm-follow-mode) - (define-key map (kbd "C-c C-u") #'helm-refresh) - (define-key map (kbd "C-c >") #'helm-toggle-truncate-line) - (define-key map (kbd "C-c l") #'helm-display-line-numbers-mode) - (define-key map (kbd "M-p") #'previous-history-element) - (define-key map (kbd "M-n") #'next-history-element) - ;; Unbind `previous-matching-history-element' which is non sense for helm. - (define-key map (kbd "M-r") #'undefined) - (define-key map (kbd "C-!") #'helm-toggle-suspend-update) - (define-key map (kbd "C-x b") #'helm-resume-previous-session-after-quit) - (define-key map (kbd "C-x C-b") #'helm-resume-list-buffers-after-quit) - (helm-define-key-with-subkeys map (kbd "C-c n") ?n #'helm-run-cycle-resume) - ;; Disable `file-cache-minibuffer-complete'. - (define-key map (kbd "") #'undefined) - (define-key map (kbd "C-t") #'helm-resplit-window-clockwise) - (define-key map (kbd "C-r") #'helm-resplit-window-counterclockwise) - ;; Debugging command - (define-key map (kbd "C-h C-d") #'helm-enable-or-switch-to-debug) - (define-key map (kbd "C-h c") #'helm-customize-group) - (define-key map (kbd "C-h d") #'helm-debug-output) - ;; Allow to eval keymap without errors. - (define-key map [f1] nil) - (define-key map (kbd "C-h C-h") #'undefined) - (define-key map (kbd "C-h h") #'undefined) - (helm-define-key-with-subkeys map - (kbd "C-w") ?\C-w #'helm-yank-text-at-point - '((?\C-_ . helm-undo-yank-text-at-point))) - ;; Use `describe-mode' key in `global-map'. - (dolist (k (where-is-internal #'describe-mode global-map)) - (define-key map k #'helm-help)) - ;; Bind all actions from f1 to f12, `helm-select-nth-action' - ;; counts from 0, i.e. (helm-select-nth-action 0) = action 1. - (dotimes (n 12) - (define-key map (kbd (format "" (1+ n))) - (lambda () - (interactive) - (helm-select-nth-action n)))) - map) - "Keymap for helm.") - -(defun helm-customize-group-1 (group) - (require 'cus-edit) - (let ((name (format "*Customize Group: %s*" - (custom-unlispify-tag-name group)))) - (if (buffer-live-p (get-buffer name)) - (switch-to-buffer name) - (custom-buffer-create - (list (list group 'custom-group)) - name - (concat " for group " - (custom-unlispify-tag-name group)))))) - -(defun helm-customize-group () - "Jump to customization group of current source. - -Default to Helm group when group is not defined in source." - (interactive) - (let ((source (or (helm-get-current-source) - (and (fboundp 'helm-comp-read) - (helm-comp-read - "Customize variables for: " - (cl-loop for src in (with-helm-buffer helm-sources) - collect `(,(assoc-default 'name src) . - ,src)) - :allow-nest t - :exec-when-only-one t)) - ;; No completion on sources when only helm-core package is - ;; used. - (car helm-sources)))) - (helm-run-after-exit 'helm-customize-group-1 (helm-get-attr 'group source)))) -(put 'helm-customize-group 'helm-only t) - -(defun helm--action-at-nth-set-fn-1 (value &optional negative unset) - "Bind VALUE to (+-)nth candidate depending of NEGATIVE arg value. -If UNSET is specified unbind VALUE instead." - (dotimes (n 9) - (let ((key (format value (1+ n))) - (fn (lambda () - (interactive) - (helm-execute-selection-action-at-nth - (if negative (- (1+ n)) (1+ n)))))) - (define-key helm-map (kbd key) nil) - (unless unset - (define-key helm-map (kbd key) fn))))) - -(defun helm--action-at-nth-set-fn- (val &optional unset) - ;; Bind `helm-action-at-nth-negative-prefix-key' to `helm-map'. - (helm--action-at-nth-set-fn-1 val 'negative unset)) - -(defun helm--action-at-nth-set-fn+ (val &optional unset) - ;; Bind `helm-action-at-nth-positive-prefix-key' to `helm-map'. - (helm--action-at-nth-set-fn-1 val nil unset)) - -(defcustom helm-action-at-nth-negative-prefix-key "M-%d" - "The prefix key to execute default action on nth <-n> candidate. - -This is a format spec where %d will be replaced by the candidate -number. - -This is activated only when `helm-display-line-numbers-mode' is turned on. -Note that default value `M-' defeat the usage of `M-' as prefix argument -in `helm-M-x'." - :group 'helm - :type 'string) - -(defcustom helm-action-at-nth-positive-prefix-key "C-%d" - "The prefix key to execute default action on nth <+n> candidate. - -This is a format spec where %d will be replaced by the candidate -number. - -This is activated only when `helm-display-line-numbers-mode' is turned on. -Note that default value `C-' defeat the usage of `C-' as prefix argument -in `helm-M-x'." - :group 'helm - :type 'string) - - -;;; User variables -(defgroup helm nil - "Open Helm." - :prefix "helm-" :group 'convenience) - -;; Easy access to customize -;;;###autoload -(defun helm-configuration () - "Customize Helm." - (interactive) - (customize-group "helm")) - -(defcustom helm-completion-window-scroll-margin 5 - "`scroll-margin' to use for Helm completion window. -Set to 0 to disable. -NOTE: This has no effect when `helm-display-source-at-screen-top' -id is non-nil." - :group 'helm - :type 'integer) - -(defcustom helm-left-margin-width 0 - "`left-margin-width' value for the `helm-buffer'." - :group 'helm - :type 'integer) - -(defcustom helm-display-source-at-screen-top t - "Display candidates at the top of screen. -This happens with `helm-next-source' and `helm-previous-source'. -NOTE: When non-nil (default), disable -`helm-completion-window-scroll-margin'." - :group 'helm - :type 'boolean) - -(defcustom helm-candidate-number-limit 500 - "Global limit for number of candidates displayed. -When the pattern is empty, the number of candidates shown will be -as set here instead of the entire list, which may be hundreds or -thousands. Since narrowing and filtering rapidly reduces -available candidates, having a small list will keep the interface -responsive. - -Set this value to nil for no limit." - :group 'helm - :type '(choice (const :tag "Disabled" nil) integer)) - -(defcustom helm-input-idle-delay (if (display-graphic-p) 0.01 0.05) ; Issue #2730. - "Idle time before updating, specified in seconds." - :group 'helm - :type 'float) - -(defcustom helm-exit-idle-delay 0 - "Idle time before exiting minibuffer while Helm is updating. -Has no affect when helm-buffer is up to date (i.e. exit without -delay in this condition)." - :group 'helm - :type 'float) - -(defvaralias 'helm-samewindow 'helm-full-frame) -(make-obsolete-variable 'helm-samewindow 'helm-full-frame "1.4.8.1") -(defcustom helm-full-frame nil - "Use current window for showing candidates. -If t, then Helm does not pop-up a new window." - :group 'helm - :type 'boolean) - -(defcustom helm-candidate-separator - (if (fontp (char-displayable-p (read "#x2015"))) - "――――――――――――――――――――――――――――――――――――――" - "--------------------------------------") - "Candidates separator of `multiline' source." - :group 'helm - :type 'string) - -(defcustom helm-save-configuration-functions - '(set-window-configuration . helm-current-window-configuration) - "Functions used to restore or save configurations for frames and windows. -Specified as a pair of functions, where car is the restore -function and cdr is the save function. - -To save and restore frame configuration, set this variable to -\\='(set-frame-configuration . helm-current-frame-configuration) - -NOTE: This may not work properly with own-frame minibuffer -settings. Older versions saves/restores frame configuration, but -the default has changed now to avoid flickering." - :group 'helm - :type 'sexp) - -(defcustom helm-display-function 'helm-default-display-buffer - "Function used to display `helm-buffer'. - -Local value in `helm-buffer' will take precedence on this default -value. Commands that are in `helm-commands-using-frame' will have -`helm-buffer' displayed in frame, `helm-display-function' being -ignored. -If no local value is found and current command is not one of -`helm-commands-using-frame' use this default value. -The function in charge of deciding which value use is -`helm-resolve-display-function'. - -To set it locally to `helm-buffer' in Helm sources use -`helm-set-local-variable' in init function or use -:display-function slot in `helm' call." - :group 'helm - :type 'symbol) - -(defcustom helm-case-fold-search 'smart - "Adds \\='smart' option to `case-fold-search'. -Smart option ignores case for searches as long as there are no -upper case characters in the pattern. - -Use nil or t to turn off smart behavior and use -`case-fold-search' behavior. - -Default is smart. - -NOTE: Case fold search has no effect when searching asynchronous -sources, which relies on customized features implemented directly -into their execution process. See helm-grep.el for an example." - :group 'helm - :type '(choice (const :tag "Ignore case" t) - (const :tag "Respect case" nil) - (other :tag "Smart" smart))) - -(defcustom helm-file-name-case-fold-search - (if (memq system-type - '(cygwin windows-nt ms-dos darwin)) - t - helm-case-fold-search) - "Local setting of `helm-case-fold-search' for reading filenames. - -See `helm-case-fold-search' for more info." - :group 'helm - :type 'symbol) - -(defcustom helm-reuse-last-window-split-state nil - "Use the same state of window split, vertical or horizontal. -For the next helm session `helm-resplit-window-clockwise' will use -the same window scheme as the previous session unless -`helm-split-window-default-side' is \\='same or \\='other." - :group 'helm - :type 'boolean) - -(defcustom helm-split-width-threshold nil - "The value of `split-width-threshold' for helm windows. -This affect the behavior of `helm-split-window-default-fn'. -When the value is an integer, `split-window-sensibly' is used inconditionally -and all the helm variables that affect window splitting are ignored." - :group 'helm - :type '(choice - (const :tag "Maybe use `split-window-sensibly'" nil) - (integer :tag "Inconditionally use `split-window-sensibly'"))) - -(defcustom helm-split-window-preferred-function 'helm-split-window-default-fn - "Default function used for splitting window." - :group 'helm - :type 'function) - -(defcustom helm-split-window-default-side 'below - "The default side to display `helm-buffer'. -Must be one acceptable arg for `split-window' SIDE, -that is `below', `above', `left' or `right'. - -Other acceptable values are `same' which always displays -`helm-buffer' in current window and `other' that displays -`helm-buffer' below if only one window or in -`other-window-for-scrolling' when available. - -A nil value has same effect as `below'. If `helm-full-frame' is -non-nil, it take precedence over this setting. - -See also `helm-split-window-inside-p' and -`helm-always-two-windows' that take precedence over this. - -NOTE: this has no effect if -`helm-split-window-preferred-function' is not -`helm-split-window-default-fn' unless this new function can -handle this." - :group 'helm - :type 'symbol) - -(defcustom helm-split-window-other-side-when-one-window 'below - "Place for `helm-window' when `helm-split-window-default-side' is \\='other. - -The default side to display `helm-buffer' when (1) -`helm-split-window-default-side' is \\='other and (2) -the current frame only has one window. Possible values -are acceptable args for `split-window' SIDE, that is `below', -`above', `left' or `right'. - -If `helm-full-frame' is non-nil, it takes precedence over this -setting. - -See also `helm-split-window-inside-p' and `helm-always-two-windows' that -takes precedence over this. - -NOTE: this has no effect if -`helm-split-window-preferred-function' is not -`helm-split-window-default-fn' unless this new function can -handle this." - :group 'helm - :type 'symbol) - -(defcustom helm-display-buffer-default-height nil - "Initial height of `helm-buffer', specified as an integer or a function. - -The function should take one arg and be responsible for re-sizing -the window; function's return value is ignored. Note that this -has no effect when the split is vertical. See `display-buffer' -for more info." - :group 'helm - :type '(choice integer function)) - -(defcustom helm-display-buffer-default-width nil - "Initial width of `helm-buffer', specified as an integer or a function. - -The function should take one arg and be responsible for re-sizing -the window; function's return value is ignored. Note that this -have no effect when the split is horizontal. See `display-buffer' -for more info." - :group 'helm - :type '(choice integer function)) - -(defvaralias 'helm-split-window-in-side-p 'helm-split-window-inside-p) -(make-obsolete-variable 'helm-split-window-in-side-p 'helm-split-window-inside-p "2.8.6") -(defcustom helm-split-window-inside-p nil - "Force split inside selected window when non-nil. -See also `helm-split-window-default-side'. - -NOTE: this has no effect if -`helm-split-window-preferred-function' is not -`helm-split-window-default-fn' unless this new function can -handle this." - :group 'helm - :type 'boolean) - -(defcustom helm-always-two-windows t - "When non-nil Helm uses two windows in this frame. - -I.e. `helm-buffer' in one window and `helm-current-buffer' -in the other. - -Note: this has no effect when `helm-split-window-inside-p' is -non-nil, or when `helm-split-window-default-side' is set to -\\='same. - -When `helm-autoresize-mode' is enabled, setting this to nil -will have no effect. - -Also when non-nil it overrides the effect of -`helm-split-window-default-side' set to `other'." - :group 'helm - :type 'boolean) - -(defcustom helm-display-buffer-width 72 - "Frame width when displaying helm-buffer in own frame." - :group 'helm - :type 'integer) - -(defcustom helm-display-buffer-height 20 - "Frame height when displaying helm-buffer in own frame." - :group 'helm - :type 'integer) - -(defcustom helm-default-display-buffer-functions nil - "Action functions to pass to `display-buffer'. -See (info \"(elisp) Buffer Display Action Functions\"). - -It may override others helm window related variables settings like -`helm-always-two-windows', `helm-split-window-inside-p' etc..." - :group 'helm - :type '(repeat symbol)) - -(defcustom helm-default-display-buffer-alist nil - "Additional alist to pass to `display-buffer' action. -See (info \"(elisp) Action Alists for Buffer Display\"). - -It may override others helm window related variables settings like -`helm-always-two-windows', `helm-split-window-inside-p' etc... - -Note that window-height and window-width have to be configured in -`helm-display-buffer-height' and `helm-display-buffer-width'." - :group 'helm - :type '(alist :key-type symbol :value-type sexp)) - -(defcustom helm-sources-using-default-as-input '(helm-source-imenu - helm-source-imenu-all - helm-source-info-elisp - helm-source-etags-select - helm-source-man-pages - helm-source-occur - helm-source-moccur - helm-source-grep-ag - helm-source-grep-git - helm-source-grep) - "List of Helm sources that need to use `helm-maybe-use-default-as-input'. -When a source is a member of this list, default `thing-at-point' -will be used as input." - :group 'helm - :type '(repeat (choice symbol))) - -(defcustom helm-delete-minibuffer-contents-from-point t - "When non-nil, `helm-delete-minibuffer-contents' deletes region from `point'. -Otherwise it deletes `minibuffer-contents'. -See documentation for `helm-delete-minibuffer-contents'." - :group 'helm - :type 'boolean) - -(defcustom helm-follow-mode-persistent nil - "When non-nil, save last state of `helm-follow-mode' for the next Emacs sessions. - -Each time you turn on or off `helm-follow-mode', the current -source name will be stored or removed from -`helm-source-names-using-follow'. - -Note that this may be disabled in some places where it is unsafe -to use because persistent action is changing according to -context." - :group 'helm - :type 'boolean) - -(defcustom helm-source-names-using-follow nil - "A list of source names to have follow enabled. -This list of source names will be used only -when `helm-follow-mode-persistent' is non-nil. - -You don't have to customize this yourself unless you really want -and know what you are doing, instead just set -`helm-follow-mode-persistent' to non-nil and as soon as you turn -on or off `helm-follow-mode' (C-c C-f) in a source, Helm will -save or remove source name in this variable." - :group 'helm - :type '(repeat (choice string))) - -(defcustom helm-prevent-escaping-from-minibuffer t - "Prevent escaping from minibuffer with `other-window' during the Helm session." - :group 'helm - :type 'boolean) - -(defcustom helm-allow-mouse t - "Allow mouse usage during the Helm session when non-nil. - -Note that this also allows moving out of minibuffer when clicking -outside of `helm-buffer', so it is up to you to get back to Helm -by clicking back in `helm-buffer' or minibuffer." - :group 'helm - :type 'boolean) - -(defcustom helm-move-to-line-cycle-in-source t - "Cycle to the beginning or end of the list after reaching the bottom or top. -This applies when using `helm-next/previous-line'." - :group 'helm - :type 'boolean) - -(defcustom helm-fuzzy-match-fn 'helm-fuzzy-match - "The function for fuzzy matching in `helm-source-sync' based sources." - :group 'helm - :type 'function) - -(defcustom helm-fuzzy-search-fn 'helm-fuzzy-search - "The function for fuzzy matching in `helm-source-in-buffer' based sources." - :group 'helm - :type 'function) - -(defcustom helm-fuzzy-sort-fn 'helm-fuzzy-matching-default-sort-fn - "The sort transformer function used in fuzzy matching." - :group 'helm - :type 'function) - -(defcustom helm-fuzzy-matching-highlight-fn #'helm-fuzzy-default-highlight-match - "The function to highlight fuzzy matches. -The function must have the same signature as -`helm-fuzzy-default-highlight-match' which is the default." - :group 'helm - :type 'function) - -(defcustom helm-autoresize-max-height 40 - "Specify maximum height and defaults to percent of Helm window's frame height. - -See `fit-window-to-buffer' for more infos." - :group 'helm - :type 'integer) - -(defcustom helm-autoresize-min-height 10 - "Specify minimum height and defaults to percent of Helm window's frame height. - -If nil, `window-min-height' is used. -See `fit-window-to-buffer' for details." - :group 'helm - :type 'integer) - -(defcustom helm-input-method-verbose-flag nil - "The default value for `input-method-verbose-flag' used in Helm minibuffer. -It is nil by default, which does not turn off input method. Helm -updates and exits without interruption -- necessary for complex -methods. - -If set to any other value as per `input-method-verbose-flag', -then use `C-\\' to disable the `current-input-method' to exit or -update Helm." - :group 'helm - :type '(radio :tag "A flag to control extra guidance for input methods in helm." - (const :tag "Never provide guidance" nil) - (const :tag "Always provide guidance" t) - (const :tag "Provide guidance only for complex methods" complex-only))) - -(defcustom helm-display-header-line t - "Display header-line when non nil. -It has to be non nil when you want to display minibuffer contents in there with -`helm-echo-input-in-header-line'." - :group 'helm - :type 'boolean) - -(defcustom helm-inherit-input-method t - "Inherit `current-input-method' from `current-buffer' when non-nil. -The default is to enable this by default and then toggle -`toggle-input-method'." - :group 'helm - :type 'boolean) - -(defcustom helm-echo-input-in-header-line nil - "Send current input to header-line when non-nil. -Note that `helm-display-header-line' has to be non nil as well for this to take -effect." - :group 'helm - :type 'boolean) - -(defcustom helm-header-line-space-before-prompt 'left-fringe - "Specify the space before prompt in header-line. - -This will be used when `helm-echo-input-in-header-line' is -non-nil. - -Value can be one of the symbols \\='left-fringe or \\='left-margin or -an integer specifying the number of spaces before prompt. Note -that on input longer that `window-width' the continuation string -will be shown on left side of window without taking care of -this." - :group 'helm - :type '(choice - (symbol - (const :tag "Fringe" left-fringe) - (const :tag "Margin" left-margin)) - integer)) - -(defcustom helm-tramp-connection-min-time-diff 5 - "Value of `tramp-connection-min-time-diff' for Helm remote processes. -If set to zero Helm remote processes are not delayed. - -Setting this to a value less than 5 or disabling it with a zero -value is risky, however on Emacs versions starting at 24.5 it -seems it is now possible to disable it. - -Anyway at any time in Helm you can suspend your processes while -typing by hitting \\ `\\[helm-toggle-suspend-update]'. - -Only async sources than use a sentinel calling -`helm-process-deferred-sentinel-hook' are affected by this." - :type 'integer - :group 'helm) - -(defcustom helm-show-action-window-other-window 'left - "Show action buffer beside `helm-buffer' when non-nil. - -If nil don't split and replace helm-buffer by the action buffer -in same window. -Possible value are left, right, below and above." - :group 'helm - :type '(choice - (const :tag "Split at left" left) - (const :tag "Split at right" right) - (const :tag "Split below" below) - (const :tag "Split above" above) - (const :tag "Don't split" nil))) - -(defcustom helm-cycle-resume-delay 1.0 - "Delay used before resuming in `helm-run-cycle-resume'." - :type 'float - :group 'helm) - -(defcustom helm-display-buffer-reuse-frame nil - "When non nil Helm frame is not deleted and reused in next sessions. - -This was used to workaround a bug in Emacs where frames where -popping up slowly, now that the bug have been fixed upstream -\(emacs-27) probably you don't want to use this any more. On -emacs-26 set `x-wait-for-event-timeout' to nil to have your -frames popping up fast." - :group 'helm - :type 'boolean) - -(defcustom helm-commands-using-frame nil - "A list of commands where `helm-buffer' is displayed in a frame." - :group 'helm - :type '(repeat symbol)) - -(defcustom helm-actions-inherit-frame-settings t - "Actions inherit Helm frame settings of initial command when non nil." - :group 'helm - :type 'boolean) - -(defcustom helm-use-undecorated-frame-option t - "Display Helm frame undecorated when non nil. - -This option has no effect with Emacs versions lower than 26." - :group 'helm - :type 'boolean) - -(defcustom helm-frame-background-color nil - "Background color for Helm frames, a string. -Fallback to default face background when nil." - :group 'helm - :type 'string) - -(defcustom helm-frame-foreground-color nil - "Foreground color for Helm frames, a string. -Fallback to default face foreground when nil" - :group 'helm - :type 'string) - -(defcustom helm-frame-alpha 100 - "Alpha parameter for Helm frames, an integer. -Fallback to 100 when nil." - :group 'helm - :type 'integer) - -(defcustom helm-use-frame-when-more-than-two-windows nil - "Display Helm buffer in frame when more than two windows." - :group 'helm - :type 'boolean) - -(defvaralias 'helm-use-frame-when-dedicated-window - 'helm-use-frame-when-no-suitable-window) - -(defcustom helm-use-frame-when-no-suitable-window nil - "Display Helm buffer in frame when Helm is started from a dedicated window." - :group 'helm - :type 'boolean) -(make-obsolete-variable 'helm-use-frame-when-dedicated-window - 'helm-use-frame-when-no-suitable-window - "3.8.1") - -(defcustom helm-default-prompt-display-function - #'helm-set-default-prompt-display - "The function to use to set face of fake cursor in header-line." - :group 'helm - :type 'function) - -(defcustom helm-truncate-lines nil - "The value of `truncate-lines' when Helm starts. -You can toggle later `truncate-lines' with -\\\\[helm-toggle-truncate-line]." - :group 'helm - :type 'boolean) - -(defcustom helm-visible-mark-prefix "*" - "Prefix used in margin for marked candidates. -Set this to an empty string if you don't want prefix in margin when marking." - :group 'helm - :type 'string) - -(defcustom helm-kill-real-or-display-selection 'display - "What to kill with `\\\\[helm-kill-selection-and-quit]'. -A prefix arg reverse the behavior of this variable." - :group 'helm - :type '(choice - (const :tag "Kill display" display) - (const :tag "Kill real" real))) - -(defcustom helm-follow-input-idle-delay 0.5 - "`helm-follow-mode' will execute action after this delay once idle. -Note that if the `follow-delay' attr is present in source, it -will take precedence over this." - :group 'helm - :type 'float) - -(defvar helm-update-edebug nil - "Development feature, make easier Edebug usage while in Helm. -If set to true then all functions invoked after `helm-update' can be -instrumented by `edebug' for stepping. `helm--maybe-use-while-no-input' -then doesn't use `while-no-input', because `while-no-input' throws on -`edebug' command key input. NOTE: This may hang helm a few seconds -while you are typing so use it only for debugging purpose, not -permanently.") - -(defvar helm-default-output-filter #'helm-output-filter - "The `process-filter' function for Helm async sources.") - -;;; Faces -;; -;; -(defgroup helm-faces nil - "Customize the appearance of Helm." - :prefix "helm-" - :group 'faces - :group 'helm) - -(defface helm-source-header - `((((type tty pc)) - ,@(and (>= emacs-major-version 27) '(:extend t)) - :background "blue" - :foreground "white") - (((background dark)) - ,@(and (>= emacs-major-version 27) '(:extend t)) - :background "#22083397778B" - :foreground "white" - :weight bold :height 1.3 :family "Sans Serif") - (((background light)) - ,@(and (>= emacs-major-version 27) '(:extend t)) - :background "#abd7f0" - :foreground "black" - :weight bold :height 1.3 :family "Sans Serif")) - "Face for source header in the Helm buffer." - :group 'helm-faces) - -(defface helm-visible-mark - `((((min-colors 88) (background dark)) - ,@(and (>= emacs-major-version 27) '(:extend t)) - :background "green1" - :foreground "black") - (((background dark)) - ,@(and (>= emacs-major-version 27) '(:extend t)) - :background "green" - :foreground "black") - (((background light)) - ,@(and (>= emacs-major-version 27) '(:extend t)) - :background "#d1f5ea") - (((min-colors 88)) - ,@(and (>= emacs-major-version 27) '(:extend t)) - :background "green1") - (t ,@(and (>= emacs-major-version 27) '(:extend t)) - :background "green")) - "Face for visible mark." - :group 'helm-faces) - -(defface helm-header - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :inherit header-line)) - "Face for header lines in the Helm buffer." - :group 'helm-faces) - -(defface helm-candidate-number - `((((background dark)) - ,@(and (>= emacs-major-version 27) '(:extend t)) - :background "yellow" :foreground "black") - (((background light)) - ,@(and (>= emacs-major-version 27) '(:extend t)) - :background "#faffb5" :foreground "black")) - "Face for candidate number in mode-line." - :group 'helm-faces) - -(defface helm-candidate-number-suspended - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :inherit helm-candidate-number :inverse-video t)) - "Face for candidate number in mode-line when Helm is suspended." - :group 'helm-faces) - -(defface helm-selection - `((((type tty pc)) - ,@(and (>= emacs-major-version 27) '(:extend t)) - :inherit isearch) - (((background dark)) - ,@(and (>= emacs-major-version 27) '(:extend t)) - :background "ForestGreen" - :distant-foreground "black") - (((background light)) - ,@(and (>= emacs-major-version 27) '(:extend t)) - :background "#b5ffd1" - :distant-foreground "black")) - "Face for currently selected item in the Helm buffer." - :group 'helm-faces) - -(defface helm-separator - `((((background dark)) - ,@(and (>= emacs-major-version 27) '(:extend t)) - :foreground "red") - (((background light)) - ,@(and (>= emacs-major-version 27) '(:extend t)) - :foreground "#ffbfb5")) - "Face for multiline source separator." - :group 'helm-faces) - -(defface helm-action - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :underline t)) - "Face for action lines in the Helm action buffer." - :group 'helm-faces) - -(defface helm-prefarg - `((((background dark)) - ,@(and (>= emacs-major-version 27) '(:extend t)) - :foreground "green") - (((background light)) - ,@(and (>= emacs-major-version 27) '(:extend t)) - :foreground "red")) - "Face for showing prefix arg in mode-line." - :group 'helm-faces) - -(defface helm-match - `((((background light)) - ,@(and (>= emacs-major-version 27) '(:extend t)) - :foreground "#b00000") - (((background dark)) - ,@(and (>= emacs-major-version 27) '(:extend t)) - :foreground "gold1")) - "Face used to highlight matches." - :group 'helm-faces) - -(defface helm-header-line-left-margin - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :foreground "black" :background "yellow")) - "Face used to highlight helm-header sign in left-margin. -This face is used only when using `helm-echo-input-in-header-line' and pattern -is wider then screen." - :group 'helm-faces) - -(defface helm-minibuffer-prompt - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :inherit minibuffer-prompt)) - "Face used for the minibuffer/headline prompt (such as Pattern:) in Helm." - :group 'helm-faces) - -(defface helm-eob-line - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :inherit default)) - "Face for empty line at end of sources in the Helm buffer. -Allow specifying the height of this line." - :group 'helm-faces) - -(defface helm-mark-prefix - `((t :inherit default)) - "Face for string `helm-visible-mark-prefix'." - :group 'helm-faces) - -(defface helm-dim-prompt - `((((class color) (min-colors 88) (background dark)) - :foreground "DimGray") - (t :inherit shadow)) - "Face used for shadowing prompt while updating." - :group 'helm-faces) - -;;; Variables. -;; -;; -(defvar helm-selection-overlay nil - "Overlay used to highlight the currently selected item.") - -(defvar helm-async-processes nil - "List of information about asynchronous processes managed by Helm.") - -(defvar helm-before-initialize-hook nil - "Runs before Helm initialization. -This hook runs before init functions in `helm-sources', which is -before creation of `helm-buffer'. Set local variables for -`helm-buffer' that need a value from `current-buffer' with -`helm-set-local-variable'.") - -(defvar helm-after-initialize-hook nil - "Runs after Helm initialization. -This hook runs after `helm-buffer' is created but not from -`helm-buffer'. The hook needs to specify in which buffer to -run.") - -(defvaralias 'helm-update-hook 'helm-after-update-hook) -(make-obsolete-variable 'helm-update-hook 'helm-after-update-hook "1.9.9") - -(defvar helm-after-update-hook nil - "Runs after updating the Helm buffer with the new input pattern.") - -(defvar helm-before-update-hook nil - "Runs before updating the Helm buffer with the new input pattern.") - -(defvar helm-cleanup-hook nil - "Runs after exiting the minibuffer and before performing an -action. - -This hook runs even if Helm exits the minibuffer abnormally (e.g. -via `helm-keyboard-quit').") - -(defvar helm-select-action-hook nil - "Runs when opening the action buffer.") - -(defvar helm-before-action-hook nil - "Runs before executing action. -Unlike `helm-cleanup-hook', this hook runs before Helm closes the -minibuffer and also before performing an action.") - -(defvar helm-after-action-hook nil - "Runs after executing action.") - -(defvar helm-exit-minibuffer-hook nil - "Runs just before exiting the minibuffer. - -This hook runs when Helm exits the minibuffer normally (e.g., via -candidate selection), but does NOT run if Helm exits the -minibuffer abnormally (e.g. via `helm-keyboard-quit').") - -(defvar helm-after-persistent-action-hook nil - "Runs after executing persistent action.") - -(defvar helm-move-selection-before-hook nil - "Runs before moving selection in `helm-buffer'.") - -(defvar helm-move-selection-after-hook nil - "Runs after moving selection in `helm-buffer'.") - -(defvar helm-after-preselection-hook nil - "Runs after pre-selection in `helm-buffer'.") - -(defvar helm-window-configuration-hook nil - "Runs when switching to and from the action buffer. -Should run also at end of `helm-display-function'.") - -(defvar helm-execute-action-at-once-if-one nil - "When non-nil execute the default action and then exit if only one candidate. -If symbol \\='current-source is given as value exit if only one -candidate in current source. This variable accepts a function -with no args that should returns a boolean value or \\='current-source.") - -(defvar helm-quit-if-no-candidate nil - "When non-nil, quit if there are no candidates. -This variable accepts a function.") - -(defvar helm-debug-function #'helm-default-debug-function - "A Function that returns a list of values to print in `helm-debug-output' buffer.") - -(defvar helm-debug-output-buffer "*Helm Debug*") - -(defvar helm-debug-buffer "*Debug Helm Log*") - -(defvar helm-debug nil - "If non-nil, write log message to `helm-debug-buffer'. -Default is nil, which disables writing log messages because the -size of `helm-debug-buffer' grows quickly.") - -(defvar helm-mode-line-string "\ -\\\ -\\[helm-help]:Help \ -\\[helm-select-action]:Act \ -\\[helm-maybe-exit-minibuffer]/\ -f1..f12:NthAct \ -\\[helm-toggle-suspend-update]:Tog.suspend \ -\\[helm-customize-group]:Conf" - "Help string displayed by Helm in the mode-line. -It is either a string or a list of two string arguments where the -first string is the name and the second string is displayed in -the mode-line. When nil, it defaults to `mode-line-format'.") - -(defvar helm-minibuffer-set-up-hook '(helm-hide-minibuffer-maybe) - "Hook that runs at minibuffer initialization. -A hook useful for modifying minibuffer settings in Helm. - -Uses `helm-hide-minibuffer-maybe' by default which hide minibuffer contents with -header-line contents when `helm-echo-input-in-header-line' is non nil.") - -(defvar helm-help-message - "* Helm Generic Help -** Basics - -To navigate in this Help buffer see [[Helm help][here]]. - -Helm narrows down the list of candidates as you type a filter -pattern. See [[Matching in Helm][Matching in Helm]]. - -Helm accepts multiple space-separated patterns, each pattern can -be negated with \"!\". - -Helm also supports fuzzy matching in some places when specified, -you will find several variables to enable fuzzy matching in -diverse [[Helm sources][sources]], see [[https://github.com/emacs-helm/helm/wiki/Fuzzy-matching][fuzzy-matching]] in helm-wiki for more infos. - -Helm generally uses familiar Emacs keys to navigate the list. -Here follow some of the less obvious bindings: - -- `\\\\[helm-maybe-exit-minibuffer]' selects the -candidate from the list, executes the default action upon exiting -the Helm session. - -- `\\\\[helm-execute-persistent-action]' executes the -default action but without exiting the Helm session. Not all -sources support this. - -- `\\\\[helm-select-action]' displays a list of actions -available on current candidate or all marked candidates. The -default binding is ordinarily used for completion, but that -would be redundant since Helm completes upon every character -entered in the prompt. See [[https://github.com/emacs-helm/helm/wiki#helm-completion-vs-emacs-completion][Helm wiki]]. - -Note: In addition to the default actions list, additional actions -appear depending on the type of the selected candidate(s). They -are called filtered actions. - -** Helm sources - -Helm uses what's called sources to provide different kinds of -completions. Each Helm session can handle one or more source. A -source is an alist object which is build from various classes, -see [[Writing your own Helm sources][here]] and [[https://github.com/emacs-helm/helm/wiki/Developing#creating-a-source][Helm wiki]] for more infos. - -*** Configure sources - -You will find in Helm sources already built and bound to a -variable called generally `helm-source-'. In this case -it is an alist and you can change the attributes (keys) values -using `helm-set-attr' function in your configuration. Of course -you have to ensure before calling `helm-set-attr' that the file -containing source is loaded, e.g. with `with-eval-after-load'. Of -course you can also completely redefine the source but this is -generally not elegant as it duplicate for its most part code -already defined in Helm. - -You will find also sources that are not built and even not bound -to any variables because they are rebuilded at each start of a -Helm session. In this case you can add a defmethod called -`helm-setup-user-source' to your config: - -#+begin_src elisp - - (cl-defmethod helm-setup-user-source ((source helm-moccur-class)) - (setf (slot-value source 'follow) -1)) - -#+end_src - -See -[[https://github.com/emacs-helm/helm/wiki/FAQ#why-is-a-customizable-helm-source-nil][here]] -for more infos, and for more complex examples of configuration -[[https://github.com/thierryvolpiatto/emacs-tv-config/blob/master/init-helm.el#L340][here]]. - -** Modify keybindings in Helm - -Helm main keymap is `helm-map', all keys bound in this map apply -to all Helm sources. However, most sources have their own keymap, -with each binding overriding its counterpart in `helm-map', you -can see all bindings in effect in the [[Commands][Commands]] -section (available only if the source has its own keymap and -documentation of course). - -** Matching in Helm - -All that you write in minibuffer is interpreted as a regexp or -multiple regexps if separated by a space. This is true for most -sources unless the developer of the source has disabled it or -have choosen to use fuzzy matching. Even if a source has fuzzy -matching enabled, Helm will switch to multi match as soon as it -detects a space in the pattern. It may also switch to multi match -as well if pattern starts with a \"^\" beginning of line sign. In -those cases each pattern separated with space should be a regexp -and not a fuzzy pattern. When using multi match patterns, each -pattern starting with \"!\" is interpreted as a negation i.e. -match everything but this. - -** Moving selection to a specific candidate - -Once you found the candidate you were searching by narrowing candidates, -you may want to keep the selection on this candidate after deleting -minibuffer contents and showing the whole list of candidates, this is -useful for example when examining and searching git log or similar. To -achieve this, ensure all candidates are shown at startup or at least -enough candidates to be sure your candidate is not beyond candidate-number-limit, -you can use \\\\[helm-show-all-candidates-in-source] for this with a prefix arg or a numeric prefix arg. -Once this is done narrow down your list by typing in minibuffer, once the -selection is on the candidate you want to keep, hit C-u \\\\[helm-delete-minibuffer-contents]. -Another way to achieve this is to mark the candidate, then delete minibuffer -contents with \\\\[helm-delete-minibuffer-contents] and reach back the mark with \\\\[helm-next-visible-mark]. - -*** Completion-styles - -UPDATE: At version 3.8.0 Helm default is now to NOT use -`completion-styles' i.e. now `helm-completion-style' default to -'helm and no more to 'emacs. - -If you want to use `completion-styles' in Helm customize -`helm-completion-style' to 'emacs. - -Helm generally fetches its candidates with the :candidates -function up to `helm-candidate-number-limit' and then applies -match functions to these candidates according to `helm-pattern'. -But Helm allows matching candidates directly from the :candidates -function using its own `completion-styles'. -Helm provides 'helm completion style but also 'helm-flex -completion style for Emacs<27 that don't have 'flex completion -style, otherwise (emacs-27) 'flex completion style is used to -provide fuzzy aka flex completion. - -When using helm-fuzzy as `helm-completion-style' helm use its own -fuzzy implementation which have nothing to do with emacs `flex' -style. - -Any Helm sources can use `completion-styles' -by using :match-dynamic slot and building their :candidates -function with `helm-dynamic-completion'. - -Example: - -#+begin_src elisp - - (helm :sources (helm-build-sync-source \"test\" - :candidates (helm-dynamic-completion - '(foo bar baz foab) - 'symbolp) - :match-dynamic t) - :buffer \"*helm test*\") - -#+end_src - -By default Helm sets up `completion-styles' and always adds 'helm -to it. However the flex completion styles are not added. This is -up to the user if she wants to have such completion to enable -this. -As specified above use 'flex for emacs-27 and 'helm-flex for -emacs-26. Anyway, 'helm-flex is not provided in -`completion-styles-alist' if 'flex is present. - -Finally Helm provides two user variables to control -`completion-styles' usage: `helm-completion-style' and -`helm-completion-styles-alist'. Both variables are customizable. -The former allows retrieving previous Helm behavior if needed, by -setting it to `helm' or `helm-fuzzy', default being `emacs' which -allows dynamic completion and usage of `completion-styles'. The -second allows setting `helm-completion-style' per mode and also -specifying `completion-styles' per mode (see its docstring). Note -that these two variables take effect only in helm-mode i.e. in -all that uses `completion-read' or `completion-in-region', IOW all -helmized commands. File completion in `read-file-name' family -doesn't obey completion-styles and has its own file completion -implementation. Native Helm commands using `completion-styles' -doesn't obey `helm-completion-style' and -`helm-completion-styles-alist' (e.g., helm-M-x). - -Also for a better control of styles in native Helm sources (not -helmized by helm-mode) using :match-dynamic, -`helm-dynamic-completion' provides a STYLES argument that allows -specifying explicitely styles for this source. - -NOTE: Some old completion styles are not working fine with Helm -and are disabled by default in -`helm-blacklist-completion-styles'. They are anyway not useful in -Helm because 'helm style supersedes these styles. - -** Helm mode - -`helm-mode' toggles Helm completion in native Emacs functions, so -when you turn `helm-mode' on, commands like `switch-to-buffer' -will use Helm completion instead of the usual Emacs completion -buffer. - -*** What gets or does not get \"helmized\" when `helm-mode' is enabled? - -Helm provides generic completion on all Emacs functions using -`completing-read', `completion-in-region' and their derivatives, -e.g. `read-file-name'. Helm exposes a user variable to control -which function to use for a specific Emacs command: -`helm-completing-read-handlers-alist'. If the function for a -specific command is nil, it turns off Helm completion. See the -variable documentation for more infos. - -*** Helm functions vs helmized Emacs functions - -While there are Helm functions that perform the same completion -as other helmized Emacs functions, e.g. `switch-to-buffer' and -`helm-buffers-list', the native Helm functions like -`helm-buffers-list' can receive new features that allow marking -candidates, have several actions, etc. Whereas the helmized Emacs -functions only have Helm completion, Emacs can provide no more -than one action for this function. This is the intended behavior. - -Generally you are better off using the native Helm command than -the helmized Emacs equivalent. - -*** Completion behavior with Helm and completion-at-point - -Helm is NOT completing dynamically. That means that when you are -completing some text at point, completion is done against this -text and subsequent characters you add AFTER this text. This -allows you to use matching methods provided by Helm, that is multi -matching or fuzzy matching (see [[Matching in Helm][Matching in -Helm]]). - -Completion is not done dynamically (against `helm-pattern') -because backend functions (i.e. `completion-at-point-functions') -are not aware of Helm matching methods. - -By behaving like this, the benefit is that you can fully use Helm -matching methods but you can't start a full completion against a -prefix different than the initial text you have at point. Helm -warns you against this by colorizing the initial input and sends -a user-error message when trying to delete backward text beyond -this limit at first hit on DEL. A second hit on DEL within a -short delay (1s) quits Helm and delete-backward char in -current-buffer. - -** Helm help - -\\[helm-documentation]: Show all Helm documentations concatenated -in one org file. - -From a Helm session, just hit \\\\[helm-help] to have -the documentation for the current source followed by the global -Helm documentation. - -While in the help buffer, most of the Emacs regular key bindings -are available; the most important ones are shown in minibuffer. -However, due to implementation restrictions, no regular Emacs -keymap is used (it runs in a loop when reading the help buffer). -Only simple bindings are available and they are defined in -`helm-help-hkmap', which is a simple alist of (key . function). -You can define or redefine bindings in help with -`helm-help-define-key' or by adding/removing entries directly in -`helm-help-hkmap'. For example if you want to replace isearch by [[https://github.com/thierryvolpiatto/isearch-light][isl-search]] -to have multi match like helm use: - - (helm-help-define-key \"C-s\" nil) - (helm-help-define-key \"C-r\" nil) - (helm-help-define-key \"C-s\" 'isl-search)) - -See `helm-help-hkmap' for restrictions on bindings and functions. - -The documentation of default bindings are: - -| Key | Alternative keys | Command | -|-----------+------------------+---------------------| -| C-v | Space next | Scroll up | -| M-v | b prior | Scroll down | -| C-s | | Isearch forward | -| C-r | | Isearch backward | -| C-a | | Beginning of line | -| C-e | | End of line | -| C-f | right | Forward char | -| C-b | left | Backward char | -| C-n | down | Next line | -| C-p | up | Previous line | -| M-a | | Backward sentence | -| M-e | | Forward sentence | -| M-f | | Forward word | -| M-b | | Backward word | -| M-> | | End of buffer | -| M-< | | Beginning of buffer | -| C- | | Toggle mark | -| C-M-SPACE | | Mark sexp | -| RET | | Follow org link | -| C-% | | Push org mark | -| C-& | | Goto org mark-ring | -| TAB | | Org cycle | -| M- | | Toggle visibility | -| M-w | | Copy region | -| q | | Quit | - -** Customize Helm - -Helm provides a lot of user variables for extensive customization. -From any Helm session, type \\\\[helm-customize-group] -to jump to the current source `custom' group. Helm also has a -special group for faces you can access via `M-x customize-group -RET helm-faces'. - -Note: Some sources may not have their group set and default to -the `helm' group. - -** Display Helm in windows and frames - -You can display the Helm completion buffer in many different -window configurations, see the custom interface to discover the -different windows configurations available (See [[Customize Helm][Customize Helm]] to jump to custom interface). -When using Emacs in a graphic display (i.e. not in a terminal) you can as -well display your Helm buffers in separated frames globally for -all Helm commands or separately for specific Helm commands. -See `helm-display-function' and `helm-commands-using-frame'. -See also [[https://github.com/emacs-helm/helm/wiki/frame][helm wiki]] for more infos. - -There is a variable to allow reusing frame instead of deleting -and creating a new one at each session, see `helm-display-buffer-reuse-frame'. -Normally you don't have to use this, it have been made to workaround -slow frame popup in Emacs-26, to workaround this slowness in Emacs-26 use instead - -#+begin_src elisp - (when (= emacs-major-version 26) - (setq x-wait-for-event-timeout nil)) -#+end_src - -WARNING: -There is a package called Posframe and also one called Helm-posframe, -you DO NOT need these packages to display helm buffers in frames. -Thus Posframe package use child frames which have no minibuffers -and are by the way not compatible with Helm. - -** Helm's basic operations and default key bindings - -| Key| Command| -|----+--------| -| | -| \\[helm-previous-line]| Previous line | -| \\[helm-next-line]| Next line | -| \\[helm-scroll-up]| Scroll up | -| \\[helm-scroll-down]| Scroll down | -| \\[helm-scroll-other-window]| Scroll up other-window | -| \\[helm-scroll-other-window-down]| Scroll down other-window | -| \\[helm-maybe-exit-minibuffer]| Execute first (default) action / Select [1] | -| \\[helm-beginning-of-buffer]| Goto beginning of buffer | -| \\[helm-end-of-buffer]| Goto end of buffer | -| \\[helm-select-action]| Show actions menu | -| \\[helm-previous-source]| Previous source | -| \\[helm-next-source]| Next source | -| \\[helm-delete-minibuffer-contents]| Delete pattern (with prefix arg delete from point to end or all [2]) | -| \\[helm-execute-persistent-action]| Persistent action (Execute and keep Helm session) | -|\\[helm-resplit-window-clockwise]|Resplit helm window clockwise. | -|\\[helm-resplit-window-counterclockwise]||Resplit helm window counterclockwise. | -|\\[helm-exchange-minibuffer-and-header-line]|Exchange minibuffer and header-line. | -|\\[helm-quit-and-find-file]|Drop into `helm-find-files'. | -|\\[helm-kill-selection-and-quit]|Kill display value of candidate and quit (with prefix arg, kill the real value). | -|\\[helm-yank-selection]|Yank current selection into pattern. | -|\\[helm-insert-or-copy]|Insert or copy marked candidates (C-u) . | -|\\[helm-follow-mode]|Toggle automatic execution of persistent action. | -|\\[helm-follow-action-forward]|Run persistent action then select next line. | -|\\[helm-follow-action-backward]|Run persistent action then select previous line. | -|\\[helm-refresh]|Recalculate and redisplay candidates. | -|\\[helm-toggle-suspend-update]|Toggle candidate updates. | - -\[1] Behavior may change depending context in some source e.g. `helm-find-files'. - -\[2] Delete from point to end or all depending on the value of -`helm-delete-minibuffer-contents-from-point'. When the cursor is at end -of minibuffer and a prefix arg is given, delete the whole contents of -minibuffer and keep selection as well when possible (depends of -candidate-number-limit) when helm update to the whole list of -candidates. This depends also of requires-pattern i.e. you may have a -source that display nothing when there is an input < to requires-pattern. - -NOTE: Any of these bindings are from `helm-map' and may be -overriten by the map specific to the current source in use (each -source can have its own keymap). - -** The actions menu - -You can display the action menu in the same window -as helm candidates (default) or in a side window according to -`helm-show-action-window-other-window' value. - -When the action menu popup, the helm prompt is used to narrow -down this menu, no more candidates. - -When `helm-allow-mouse' is non nil, you can use as well -mouse-3 (right click) in the candidate zone to select actions -with the mouse once your candidate is selected. - -** Action transformers - -You may be surprized to see your actions list changing depending -on the context. This happen when a source has an action -transformer function which checks the current selected candidate -and adds specific actions for this candidate. - -** Shortcuts for n-th first actions - -f1-f12: Execute n-th action where n is 1 to 12. - -** Shortcuts for executing the default action on the n-th candidate - -Helm does not display line numbers by default, with Emacs-26+ you -can enable it permanently in all helm buffers with: - - (add-hook 'helm-after-initialize-hook 'helm-init-relative-display-line-numbers) - -You can also toggle line numbers with -\\\\[helm-display-line-numbers-mode] in current Helm -buffer. - -Of course when enabling `global-display-line-numbers-mode' Helm -buffers will have line numbers as well. (Don't forget to -customize `display-line-numbers-type' to relative). - -In Emacs versions < to 26 you will have to use -[[https://github.com/coldnew/linum-relative][linum-relative]] -package and `helm-linum-relative-mode'. - -Then when line numbers are enabled with one of the methods above -the following keys are available: - - : Execute default action on the n-th candidate before -currently selected candidate. - - : Execute default action on the n-th candidate after -currently selected candidate. - -Where and are respectively the value of -the customizable variables `helm-action-at-nth-negative-prefix-key' and -`helm-action-at-nth-positive-prefix-key'. - - is limited to 1-9. - -** Mouse control in Helm - -A basic support for the mouse is provided when the user sets -`helm-allow-mouse' to non-nil. - -- mouse-1 selects the candidate. -- mouse-2 executes the default action on selected candidate. -- mouse-3 pops up the action menu. - -Note: When mouse control is enabled in Helm, it also lets you -click around and lose the minibuffer focus: you'll have to click -on the Helm buffer or the minibuffer to retrieve control of your -Helm session. - -** Marked candidates - -You can mark candidates to execute an action on all of them -instead of the current selected candidate only. (See bindings -below.) Most Helm actions operate on marked candidates unless -candidate-marking is explicitely forbidden for a specific source. - -- To mark/unmark a candidate, use -\\[helm-toggle-visible-mark]. (See bindings below.) With a -numeric prefix arg mark ARG candidates forward, if ARG is -negative mark ARG candidates backward. - -- To mark all visible unmarked candidates at once in current -source use \\[helm-mark-all]. With a prefix argument, mark all -candidates in all sources. - -- To unmark all visible marked candidates at once use - \\[helm-unmark-all]. - -- To mark/unmark all candidates at once use -\\[helm-toggle-all-marks]. With a prefix argument, mark/unmark -all candidates in all sources. - -Note: When multiple candidates are selected across different -sources, only the candidates of the current source will be used -when executing most actions (as different sources can have -different actions). Some actions support multi-source marking -however. - -** Follow candidates - -When `helm-follow-mode' is on (\\\\[helm-follow-mode] -to toggle it), moving up and down Helm session or updating the -list of candidates will automatically execute the -persistent-action as specified for the current source. - -If `helm-follow-mode-persistent' is non-nil, the state of the -mode will be restored for the following Helm sessions. - -If you just want to follow candidates occasionally without -enabling `helm-follow-mode', you can use -\\\\[helm-follow-action-forward] or -\\[helm-follow-action-backward] instead. Conversely, when -`helm-follow-mode' is enabled, those commands go to previous/next -line without executing the persistent action. - -** Special yes, no or yes for all answers - -You may be prompted in the minibuffer to answer by [y,n,!,q] in -some places for confirmation. - -- y mean yes -- no mean no -- ! mean yes for all -- q mean quit or abort current operation. - -When using ! you will not be prompted for the same thing in -current operation any more, e.g. file deletion, file copy etc... - -** Moving in `helm-buffer' - -You can move in `helm-buffer' with the usual commands used in -Emacs: \(\\\\[helm-next-line], -\\\\[helm-previous-line], etc. See above basic -commands. When `helm-buffer' contains more than one source, -change source with \\\\[helm-next-source] and -\\[helm-previous-source]. - -Note: When reaching the end of a source, -\\\\[helm-next-line] will *not* go to the next source -when variable `helm-move-to-line-cycle-in-source' is non-nil, so -you will have to use \\\\[helm-next-source] and -\\[helm-previous-source]. - -** Resume previous session from current Helm session - -You can use `C-c n' (`helm-run-cycle-resume') to cycle in -resumables sources. `C-c n' is a special key set with -`helm-define-key-with-subkeys' which, after pressing it, allows -you to keep cycling with further `n'. - -Tip: You can bound the same key in `global-map' to - `helm-cycle-resume' with `helm-define-key-with-subkeys' to - let you transparently cycle sessions, Helm fired up or not. - You can also bind the cycling commands to single key - presses (e.g., `S-') this time with a simple - `define-key'. (Note that `S-' is not available in - terminals.) - -Note: `helm-define-key-with-subkeys' is available only once Helm -is loaded. - -You can also use -\\\\[helm-resume-previous-session-after-quit] to resume -the previous session, or -\\\\[helm-resume-list-buffers-after-quit] to have -completion on all resumable buffers. - -** Global commands - -*** Resume Helm session from outside Helm - -\\\\[helm-resume] revives the last Helm session. -Binding a key to this command will greatly improve Helm -interactivity, e.g. when quitting Helm accidentally. - -You can call \\\\[helm-resume] with a prefix argument -to choose \(with completion!) which session you'd like to resume. -You can also cycle in these sources with `helm-cycle-resume' (see -above). - -** Debugging Helm - -Helm exposes the special variable `helm-debug': setting it to -non-nil will enable Helm logging in a special outline-mode -buffer. Helm resets the variable to nil at the end of each -session. - -For convenience, \\\\[helm-enable-or-switch-to-debug] -allows you to turn on debugging for this session only. To avoid -accumulating log entries while you are typing patterns, you can -use \\\\[helm-toggle-suspend-update] to turn off -updating. When you are ready turn it on again to resume logging. - -Once you exit your Helm session you can access the debug buffer -with `helm-debug-open-last-log'. - -Note: Be aware that Helm log buffers grow really fast, so use -`helm-debug' only when needed. - -** Writing your own Helm sources - -Writing simple sources for your own usage is easy. When calling -the `helm' function, the sources are added the :sources slot -which can be a symbol or a list of sources. Sources can be built -with different EIEIO classes depending on what you want to do. To -simplify this, several `helm-build-*' macros are provided. Below -there are simple examples to start with. - -We will not go further here, see -[[https://github.com/emacs-helm/helm/wiki/Developing][Helm wiki]] -and the source code for more information and more complex -examples. - -#+begin_src elisp - - ;; Candidates are stored in a list. - (helm :sources (helm-build-sync-source \"test\" - ;; A function can be used as well - ;; to provide candidates. - :candidates '(\"foo\" \"bar\" \"baz\")) - :buffer \"*helm test*\") - - ;; Candidates are stored in a buffer. - ;; Generally faster but doesn't allow a dynamic updating - ;; of the candidates list i.e the list is fixed on start. - (helm :sources (helm-build-in-buffer-source \"test\" - :data '(\"foo\" \"bar\" \"baz\")) - :buffer \"*helm test*\") - -#+end_src - -** Helm Map -\\{helm-map}" - "Message string containing detailed help for `helm'. -It also accepts function or variable symbol.") - -(defvar helm-autoresize-mode) ;; Undefined in `helm-default-display-buffer'. - -(defvar helm-async-outer-limit-hook nil - "Run in async sources when process output is out of `candidate-number-limit'. -Should be set locally to `helm-buffer' with `helm-set-local-variable'.") - -(defvar helm-quit-hook nil - "A hook that runs when quitting Helm.") - -(defvar helm-resume-after-hook nil - "A hook that runs after resuming a Helm session. -The hook should takes one arg SOURCES.") - -(defvar helm-help-buffer-name "*Helm Help*" - "The name of helm help buffer.") - -;; See bug#2503. -(defvar helm-process-output-split-string-separator "\n" - "Separator to use when splitting helm async output.") - -(defvar helm-last-query "" - "The value of `helm-pattern' is stored here exit or quit.") - -(defvar helm-dim-prompt-on-update nil - "Dim prompt when updating. -Do not set this globally. Do not use this in async sources or in -commands using an async source in their sources. -Use this either let-bounded or helm buffer local.") - -;; logging -(defun helm-log (from format-string &rest args) - "Log message if `helm-debug' is non-nil. -Messages are written to the `helm-debug-buffer' buffer. - -FROM is the place from where it is called. -Argument FORMAT-STRING is a string to use with `format'. -Use optional arguments ARGS like in `format'." - (when helm-debug - (with-current-buffer (get-buffer-create helm-debug-buffer) - (outline-mode) - (buffer-disable-undo) - (let ((inhibit-read-only t)) - (goto-char (point-max)) - (insert (let ((tm (current-time))) - (format (concat (if (string-match "Start session" format-string) - "* " "** ") - "%s.%06d (%s)\n %s\n") - (format-time-string "%H:%M:%S" tm) - (nth 2 tm) - from - (apply #'format (cons format-string args))))))))) - -(defun helm-log-run-hook (from hook) - "Run HOOK like `run-hooks' and log these actions to Helm log buffer. -FROM is the place from where it is called." - (helm-log from "Executing %s with value = %S" hook (symbol-value hook)) - (helm-log from "Executing %s with global value = %S" hook (default-value hook)) - (run-hooks hook) - (helm-log from "executed %s" hook)) - -(defun helm-log-error (from &rest args) - "Accumulate error messages into `helm-issued-errors'. -FROM is the place from where it is called. -ARGS are args given to `format'. -E.g. (helm-log-error \"Error %s: %s\" (car err) (cdr err))." - (apply 'helm-log from (concat "ERROR: " (car args)) (cdr args)) - (let ((msg (apply 'format args))) - (unless (member msg helm-issued-errors) - (cl-pushnew msg helm-issued-errors :test 'equal)))) - -;;;###autoload -(defun helm-debug-open-last-log () - "Open Helm log file or buffer of last Helm session." - (interactive) - (if helm--last-log-file - (progn - (find-file helm--last-log-file) - (outline-mode) (view-mode 1) (visual-line-mode 1)) - (switch-to-buffer helm-debug-buffer) - (view-mode 1) (visual-line-mode 1))) - -(defun helm-print-error-messages () - "Print error messages in `helm-issued-errors'." - (and helm-issued-errors - (message "Helm issued errors: %s" - (mapconcat 'identity (reverse helm-issued-errors) "\n")))) - - -;; Test tools -(defmacro with-helm-time-after-update (&rest body) - (helm-with-gensyms (start-time time-elapsed) - `(let ((,start-time (float-time)) ,time-elapsed) - (add-hook 'helm-after-update-hook - (lambda () - (setq ,time-elapsed (- (float-time) ,start-time)) - (keyboard-quit))) - (unwind-protect ,@body - (remove-hook 'helm-after-update-hook - (lambda () - (setq ,time-elapsed (- (float-time) ,start-time)) - (keyboard-quit)))) - ,time-elapsed))) - - -;; Helm API -(defmacro with-helm-default-directory (directory &rest body) - (declare (indent 1) (debug t)) - `(let ((default-directory (or (and ,directory - (file-name-as-directory ,directory)) - default-directory))) - ,@body)) - -(defun helm-default-directory () - "Return the local value of `default-directory' in `helm-buffer'." - (buffer-local-value 'default-directory (get-buffer helm-buffer))) - -(defmacro with-helm-temp-hook (hook &rest body) - "Execute temporarily BODY as a function for HOOK." - (declare (indent 1) (debug t)) - `(letrec ((helm--hook (lambda () - (unwind-protect - (progn ,@body) - (remove-hook ,hook helm--hook))))) - (push (cons helm--hook ,hook) helm--temp-hooks) - (add-hook ,hook helm--hook))) - -(defmacro with-helm-after-update-hook (&rest body) - "Execute BODY at end of `helm-update'." - (declare (indent 0) (debug t)) - `(with-helm-temp-hook 'helm-after-update-hook ,@body)) - -(defmacro with-helm-alive-p (&rest body) - "Return error when BODY run outside Helm context." - (declare (indent 0) (debug t)) - `(progn - (if helm-alive-p - (progn ,@body) - (error "Running helm command outside of context")))) - -(defmacro with-helm-in-frame (&rest body) - "Execute Helm function in BODY displaying `helm-buffer' in separate frame." - (declare (debug t) (indent 0)) - `(progn - (helm-set-local-variable - 'helm-display-function 'helm-display-buffer-in-own-frame) - ,@body)) - -(defmacro helm-make-command-from-action (symbol doc action &rest body) - "Make a command SYMBOL from ACTION with docstring DOC. -The command SYMBOL will quit helm before execute. -Argument ACTION should be an existing helm action. -BODY form will run before calling action. - -Example: - - (helm-make-command-from-action foo-command - \"Docstring\" - \\='foo-action - (run body)) - -will produce a command like this: - - (defun foo-command () - \"docstring\" - (interactive) - (with-helm-alive-p - (run body) - (helm-exit-and-execute-action \\='foo-action))) - -And automatically put the symbol \\='helm-only on SYMBOL." - (declare (indent defun) (debug t)) - `(progn - (defun ,symbol () - ,doc - (interactive) - (with-helm-alive-p - (progn ,@body) - (helm-exit-and-execute-action ,action))) - (put ',symbol 'helm-only t))) - -(defmacro helm-make-persistent-command-from-action (symbol doc psymbol action) - "Make a persistent command SYMBOL bound to PSYMBOL from ACTION." - (declare (indent defun) (debug t)) - `(progn - (defun ,symbol () - ,doc - (interactive) - (with-helm-alive-p - (helm-set-attr ,psymbol (cons ,action 'never-split)) - (helm-execute-persistent-action ,psymbol))) - (put ',symbol 'helm-only t))) - - -;;; helm-attributes -;; -(defun helm-get-attr (attribute-name &optional source compute) - "Get the value of ATTRIBUTE-NAME of SRC. - -If SRC is omitted, use current source. - -If COMPUTE is non-`nil' compute value of ATTRIBUTE-NAME with -`helm-interpret-value'. COMPUTE can have also \\='ignorefn as value, -in this case `helm-interpret-value' will return a function as -value unchanged, but will eval a symbol which is bound. - -You can use `setf' to modify value of ATTRIBUTE-NAME unless -COMPUTE is specified, if attribute ATTRIBUTE-NAME is not found in -SOURCE `setf' will create new attribute ATTRIBUTE-NAME with -specified value. You can also use `helm-set-attr' to modify -ATTRIBUTE-NAME." - (declare (gv-setter - (lambda (val) - `(let* ((src (or ,source (helm-get-current-source))) - (attr (assq ,attribute-name src))) - (cl-assert (null ,compute) nil - "`setf' can't set the computed value of attribute `%s'" - ,attribute-name) - (if attr - (setcdr attr ,val) - (and (setcdr src (cons (cons ,attribute-name ,val) - (cdr src))) - ,val)))))) - (let ((src (or source (helm-get-current-source)))) - (helm-aif (assq attribute-name src) - (if compute - (helm-interpret-value (cdr it) src compute) - (cdr it))))) - -(defalias 'helm-attr 'helm-get-attr) -(make-obsolete 'helm-attr 'helm-get-attr "3.7.0") - -(defun helm-set-attr (attribute-name value &optional src) - "Set the value of ATTRIBUTE-NAME of source SRC to VALUE. - -If ATTRIBUTE-NAME doesn't exists in source it is created with -value VALUE. If SRC is omitted, use current source. If operation -succeed, return value, otherwise nil. - -Using this function is same as using `setf' on `helm-get-attr'." - (unless src (setq src (helm-get-current-source))) - (setf (helm-get-attr attribute-name src) value)) - -(defalias 'helm-attrset 'helm-set-attr) -(make-obsolete 'helm-attrset 'helm-set-attr "3.7.0") - -(defun helm-add-action-to-source (name fn source &optional index) - "Add new action NAME linked to function FN to SOURCE. -Function FN should be a valid function that takes one arg i.e. -candidate, argument NAME is a string that will appear in action -menu and SOURCE should be an existing helm source already loaded. -If INDEX is specified, action is added to the action list at INDEX, -otherwise added at end. -This allows users to add specific actions to an existing source -without modifying source code." - (let ((actions (helm-get-attr 'action source 'ignorefn)) - (new-action (list (cons name fn)))) - (when (functionp actions) - (setq actions (list (cons "Default action" actions)))) - (helm-set-attr 'action - (if index - (helm-append-at-nth actions new-action index) - (append actions new-action)) - source))) - -(defun helm-delete-action-from-source (action-or-name source) - "Delete ACTION-OR-NAME from SOURCE. -ACTION-OR-NAME can either be the name of action or the symbol -function associated to name." - (let* ((actions (helm-get-attr 'action source 'ignorefn)) - (del-action (if (symbolp action-or-name) - (rassoc action-or-name actions) - (assoc action-or-name actions)))) - (helm-set-attr 'action (delete del-action actions) source))) - -(defun helm-add-action-to-source-if (name fn source predicate &optional index test-only) - "Add new action NAME linked to function FN to SOURCE. -Action NAME will be available when the current candidate matches -PREDICATE. -This function adds an entry in the `action-transformer' attribute -of SOURCE (or creates one if not found). -Function PREDICATE must take one candidate as arg. -Function FN should be a valid function that takes one arg i.e. -candidate, argument NAME is a string that will appear in action -menu and SOURCE should be an existing Helm source already loaded. -If INDEX is specified, action is added in action list at INDEX. -Value of INDEX should be always >=1, default to 4. This allows -user to add a specific `action-transformer' to an existing source -without modifying source code. - -E.g. - -Add the action \"Byte compile file async\" linked to function -`async-byte-compile-file' to source `helm-source-find-files' only -when predicate helm-ff-candidates-lisp-p returns non-nil: - -\(helm-add-action-to-source-if \"Byte compile file async\" - \\='async-byte-compile-file - helm-source-find-files - \\='helm-ff-candidates-lisp-p)." - (unless index (setq index 4)) - (let* ((actions (helm-get-attr 'action source 'ignorefn)) - (action-transformers (helm-get-attr 'action-transformer source)) - (new-action (list (cons name fn))) - (transformer (lambda (actions _candidate) - (let ((candidate (car (helm-marked-candidates)))) - (cond ((funcall predicate candidate) - (helm-append-at-nth - actions new-action index)) - (t actions)))))) - (when (functionp actions) - (helm-set-attr 'action (list (cons "Default action" actions)) source)) - (when (or (symbolp action-transformers) (functionp action-transformers)) - (setq action-transformers (list action-transformers))) - (if test-only ; debug - (delq nil (append (list transformer) action-transformers)) - (helm-set-attr 'action-transformer - (helm-fast-remove-dups - (delq nil (append (list transformer) action-transformers)) - :test 'equal) - source)))) - - -;;; Source filter -;; -(defun helm-set-source-filter (sources) - "Set the value of `helm-source-filter' to SOURCES and update. - -This function sets a filter for Helm sources and it may be called -while Helm is running. It can be used to toggle displaying of -sources dynamically. For example, additional keys can be bound -into `helm-map' to display only the file-related results if there -are too many matches from other sources and you're after files -only: - -Shift+F shows only file results from some sources: - -\(define-key helm-map \"F\" \\='helm-my-show-files-only) - -\(defun helm-my-show-files-only () - (interactive) - (helm-set-source-filter \\='(\"File Name History\" - \"Files from Current Directory\"))) - -Shift+A shows all results: - -\(define-key helm-map \"A\" \\='helm-my-show-all) - -\(defun helm-my-show-all () - (interactive) - (helm-set-source-filter nil)) - -The -my- part is added to avoid collisions with -existing Helm function names." - (with-helm-buffer - (let ((cur-disp-sel (helm-get-selection nil t))) - (set (make-local-variable 'helm-source-filter) - (helm--normalize-filter-sources sources)) - (helm-log "helm-set-source-filter" "helm-source-filter = %S" helm-source-filter) - ;; Use force-update to run init/update functions. - (helm-update (and (stringp cur-disp-sel) - (regexp-quote cur-disp-sel)))))) - -(defun helm--normalize-filter-sources (sources) - (cl-loop for s in sources collect - (cl-typecase s - (symbol (assoc-default 'name (symbol-value s))) - (list (assoc-default 'name s)) - (string s)))) - -(defun helm-set-sources (sources &optional no-init no-update) - "Set SOURCES during `helm' invocation. -If NO-INIT is non-nil, skip executing init functions of SOURCES. -If NO-UPDATE is non-nil, skip executing `helm-update'." - (with-current-buffer helm-buffer - (setq helm-sources (helm-get-sources sources)) - (helm-log "helm-set-sources" "helm-sources = %S" helm-sources)) - (unless no-init (helm-compute-attr-in-sources 'init)) - (unless no-update (helm-update))) - -(defun helm--get-candidate-number-limit-value (arg) - "Return a suitable value for candidate-number-limit according to pref ARG." - (helm-acase arg - ;; Using a large number instead of nil allows always having a value with - ;; helm-get-attr. - ((guard* (consp arg)) 9999999) - ((guard* (numberp arg)) it) - (t (default-value 'helm-candidate-number-limit)))) - -(defun helm-show-all-candidates-in-source (arg) - "Toggle all sources or only current source visibility. -With a prefix arg show all candidates in current source -disregarding candidate-number-limit and with a numeric prefix arg -show ARG number of candidates. With no prefix arg candidate-number-limit is -reset to default value." - (interactive "P") - (with-helm-alive-p - (with-helm-buffer - (if helm-source-filter - (progn - (if (helm-get-attr 'candidate-number-limit) - (helm-set-attr 'candidate-number-limit - (helm--get-candidate-number-limit-value arg)) - (setq-local helm-candidate-number-limit - (default-value 'helm-candidate-number-limit))) - (helm-set-source-filter nil)) - ;; FIXME: What default-directory has to do with this? - (with-helm-default-directory (helm-default-directory) - (if (helm-get-attr 'candidate-number-limit) - (helm-set-attr 'candidate-number-limit - (helm--get-candidate-number-limit-value arg)) - (setq-local helm-candidate-number-limit - (helm--get-candidate-number-limit-value arg))) - (helm-set-source-filter - (list (helm-get-current-source)))))))) -(put 'helm-show-all-candidates-in-source 'helm-only t) - -(defun helm-display-all-sources () - "Display all sources previously hidden by `helm-set-source-filter'." - (interactive) - (with-helm-alive-p - (helm-set-source-filter nil))) -(put 'helm-display-all-sources 'helm-only t) - -(defun helm-limit-to-sources () - "Limit sources to display from current session. -This is a toggle command, when hit a second time reset to all sources." - (interactive) - (with-helm-alive-p - (with-helm-buffer - (if (null helm-source-filter) - (when (cdr helm-sources) - (let ((headers (if (fboundp 'helm-comp-read) - (helm-comp-read - "Limit to source(s): " - (mapcar - (lambda (s) - (let* ((name (assoc-default 'name s)) - (disp (helm-aif (assoc-default 'header-name s) - (funcall it name) name))) - (cons disp name))) - helm-sources) - :marked-candidates t - :allow-nest t - :buffer "*helm sources*") - ;; No completion on sources when only helm-core package is - ;; used. - (list (assoc-default 'name (helm-get-current-source)))))) - (helm-set-source-filter headers))) - (helm-set-source-filter nil))))) -(put 'helm-limit-to-sources 'helm-only t) - -;;; Source infos fns. -;; -(defun helm-get-selection (&optional buffer force-display-part source) - "Return the currently selected candidate from BUFFER. - -If BUFFER is nil or unspecified, use `helm-buffer' as default value. - -If FORCE-DISPLAY-PART is non-nil, return the display part of candidate. - -If FORCE-DISPLAY-PART value is `withprop' the display part of -candidate is returned with its properties. - -If FORCE-DISPLAY-PART value is `noicon' return the display part with its -properties but without its leading icon if some. - -When FORCE-DISPLAY-PART is nil the real part of candidate is returned. - -SOURCE default to current-source when unspecified but it is better to -specify SOURCE when it is already available to avoid to call -`helm-get-current-source' uselessly. - -Note that FORCE-DISPLAY-PART when specified takes precedence over -`display-to-real' attribute, that's mean don't use FORCE-DISPLAY-PART -when you want the `display-to-real' function(s) to be applied." - (with-current-buffer (or buffer helm-buffer) - (unless (or (helm-empty-buffer-p (current-buffer)) - (helm-pos-header-line-p)) - (let* ((beg (overlay-start helm-selection-overlay)) - (end (overlay-end helm-selection-overlay)) - (disp-fn (if (memq force-display-part '(withprop noicon)) - 'buffer-substring - 'buffer-substring-no-properties)) - ;; If there is no selection at point, the - ;; overlay is at its initial pos, (point-min) - ;; (point-min), that's mean the helm-buffer - ;; is not empty but have no selection yet, - ;; this happen with grep sentinel sending an - ;; error message in helm-buffer when no matches. - (disp (unless (= beg end) - (helm-acase (funcall disp-fn beg (1- end)) - ((guard* (and (eq force-display-part 'noicon) - (get-text-property 0 'icon it))) - ;; Remove icon if some from display see issue#2743. - (substring it (1+ guard))) ; icon length + one space. - (t it)))) - (src (or source (helm-get-current-source))) - (selection (helm-acond (force-display-part disp) - ;; helm-realvalue always takes precedence - ;; over display-to-real. - ((get-text-property beg 'helm-realvalue) it) - ((assoc-default 'display-to-real src) - (helm-apply-functions-from-source source it disp)) - (t disp)))) - (unless (equal selection "") - (helm-log "helm-get-selection" "selection = %S" selection) - selection))))) - -(defun helm-get-actions-from-current-source (&optional source) - "Return the associated action for the selected candidate. -It is a function symbol (sole action) or list -of (action-display . function)." - (unless (helm-empty-buffer-p (helm-buffer-get)) - (let* ((src (or source (helm-get-current-source))) - (marked (helm-marked-candidates)) - (action-transformer (helm-get-attr 'action-transformer src)) - (actions (helm-get-attr 'action src 'ignorefn))) - (if action-transformer - (helm-apply-functions-from-source - src action-transformer actions - ;; When there is marked candidates assume the set of - ;; candidates user selected contains candidates of the same - ;; type so that the actions added by transformer fit with - ;; all marked (previously we were looping on each marked - ;; but it is too costly for the benefit it brings). - (car marked)) - actions)))) - -(defun helm-get-current-source () - "Return the source for the current selection. -Return nil when `helm-buffer' is empty." - (or helm-current-source - (with-helm-buffer - (or (get-text-property (point) 'helm-cur-source) - (progn - ;; This is needed to not loose selection. - (goto-char (overlay-start helm-selection-overlay)) - (let ((header-pos (or (helm-get-previous-header-pos) - (helm-get-next-header-pos)))) - ;; Return nil when no--candidates. - (when header-pos - (cl-loop with source-name = (save-excursion - (goto-char header-pos) - (helm-current-line-contents)) - for source in helm-sources thereis - (and (equal (assoc-default 'name source) source-name) - source))))))))) - -(defun helm-run-after-exit (function &rest args) - "Execute FUNCTION with ARGS after exiting Helm. -The action is to call FUNCTION with arguments ARGS. -Unlike `helm-exit-and-execute-action', this can be used -to call non-actions functions with any ARGS or no ARGS at all. - -Use this on commands invoked from key bindings, but not on action -functions invoked as action from the action menu, i.e. functions -called with RET." - (helm-kill-async-processes) - (helm-log "helm-run-after-exit" "function = %S" function) - (helm-log "helm-run-after-exit" "args = %S" args) - (helm-exit-and-execute-action - (lambda (_candidate) - (apply function args)))) - -(defun helm-exit-and-execute-action (action) - "Exit current Helm session and execute ACTION. -Argument ACTION is a function called with one arg (candidate) and -part of the actions of current source. - -Use this on commands invoked from key bindings, but not -on action functions invoked as action from the action menu, -i.e. functions called with RET." - ;; If ACTION is not an action available in source 'action attribute, - ;; return an error. This allow to remove unneeded actions from - ;; source that inherit actions from type, note that ACTION have to - ;; be bound to a symbol and not to be an anonymous action - ;; i.e. lambda or byte-code. - (helm-log "helm-exit-and-execute-action" "Start executing action") - (let ((actions (helm-get-actions-from-current-source))) - (when actions - (cl-assert (or - ;; Single actions defined as symbol. - (eq action actions) - ;; Compiled lambdas - (byte-code-function-p action) - ;; Natively compiled (libgccjit) - (helm-subr-native-elisp-p action) - ;; Lambdas (lambdas are no more represented as list in - ;; Emacs-29+) Bug#2666. - (and (not (symbolp action)) (functionp action)) - ;; One of current actions. - (rassq action actions)) - nil "No such action `%s' for this source" action))) - (setq helm-saved-action action) - (setq helm-saved-selection (or (helm-get-selection) "")) - (setq helm--executing-helm-action t) - ;; When toggling minibuffer and header-line, we want next action - ;; inherit this setting. - (helm-set-local-variable 'helm-echo-input-in-header-line - (with-helm-buffer helm-echo-input-in-header-line)) - ;; Ensure next action use same display function as initial helm-buffer when - ;; helm-actions-inherit-frame-settings is non nil. - (when (and helm-actions-inherit-frame-settings - helm--buffer-in-new-frame-p) - (helm-set-local-variable 'helm-display-function - (with-helm-buffer helm-display-function) - 'helm--last-frame-parameters - (with-helm-buffer - (helm--get-frame-parameters))) - ;; The helm-buffer keeps `helm-display-function' and - ;; `helm--get-frame-parameters' values during 0.5 seconds, just - ;; the time to execute the possible helm action with those values. - ;; If no helm based action run within 0.5 seconds, the next helm - ;; session will have to resolve again those variable values. - (run-with-idle-timer 0.5 nil - (lambda () - (helm-set-local-variable - 'helm-display-function nil - 'helm--last-frame-parameters nil)))) - (helm-exit-minibuffer)) - -(defun helm-quit-and-find-file () - (interactive) - (if (fboundp 'helm-quit-and-find-file-1) - (helm-quit-and-find-file-1) - (error "No rules to find file, please install helm package for this"))) -(put 'helm-quit-and-find-file 'helm-only t) - -(defun helm--get-frame-parameters (&optional frame) - (cl-loop with params = (frame-parameters frame) - for p in helm--frame-default-attributes - when (assq p params) collect it)) - -(defalias 'helm-run-after-quit 'helm-run-after-exit) -(make-obsolete 'helm-run-after-quit 'helm-run-after-exit "1.7.7") -(defalias 'helm-quit-and-execute-action 'helm-exit-and-execute-action) -(make-obsolete 'helm-quit-and-execute-action 'helm-exit-and-execute-action "1.7.7") - -(defun helm-interpret-value (value &optional source compute) - "Interpret VALUE as variable, function or literal and return it. -If VALUE is a function, call it with no arguments and return the value -unless COMPUTE value is \\='ignorefn. -If SOURCE compute VALUE for this source. -If VALUE is a variable, return the value. -If VALUE is a symbol, but it is not a function or a variable, cause an error. -Otherwise, return VALUE itself." - (cond ((and source (functionp value) (not (eq compute 'ignorefn))) - (helm-apply-functions-from-source source value)) - ((and (functionp value) (not (eq compute 'ignorefn))) - (funcall value)) - ((and (symbolp value) (boundp value)) - (symbol-value value)) - ((and (symbolp value) (not (functionp value))) - (error - "helm-interpret-value: Symbol must be a function or a variable")) - (t - value))) - -(defun helm-set-local-variable (&rest args) - "Bind each pair in ARGS locally to `helm-buffer'. - -Use this to set local vars before calling helm. - -When used from an init or update function -\(i.e. when `helm-force-update' is running) the variables are set -using `make-local-variable' within the `helm-buffer'. - -Usage: helm-set-local-variable ([VAR VALUE]...) -Just like `setq' except that the vars are not set sequentially. -IOW Don't use VALUE of previous VAR to set the VALUE of next VAR. - -\(fn VAR VALUE ...)" - (if helm--force-updating-p - (with-helm-buffer - (cl-loop for i on args by #'cddr - do (set (make-local-variable (car i)) (cadr i)))) - (setq helm--local-variables - (append (cl-loop for i on args by #'cddr - collect (cons (car i) (cadr i))) - helm--local-variables)))) - -(defun helm--set-local-variables-internal () - (cl-loop for (var . val) in helm--local-variables - ;; If `helm-set-local-variable' is called twice or more - ;; on same variable use the last value entered which is - ;; the first on stack e.g. - ;; (helm-set-local-variable 'helm-foo 1) - ;; (helm-set-local-variable 'helm-foo 2) - ;; helm--local-variables => - ;; '((helm-foo . 2) (helm-foo. 1)) - ;; (helm-foo . 2) is retained and (helm-foo . 1) - ;; ignored. - unless (memq var computed) - do (set (make-local-variable var) val) - collect var into computed - finally (setq helm--local-variables nil))) - - -;; API helper -(defun helm-empty-buffer-p (&optional buffer) - "Check if BUFFER have candidates. -Default value for BUFFER is `helm-buffer'." - (unless buffer (setq buffer helm-buffer)) - (zerop (buffer-size (and buffer (get-buffer buffer))))) - -(defun helm-empty-source-p () - "Check if current source contains candidates. -This could happen when for example the last element of a source -was deleted and the candidates list not updated." - (when (helm-window) - (with-helm-window - (or (helm-empty-buffer-p) - (and (helm-end-of-source-p) - (eq (pos-bol) (pos-eol)) - (or - (save-excursion - (forward-line -1) - (helm-pos-header-line-p)) - (bobp))))))) - - -;; Tools -;; -(defun helm-apply-functions-from-source (source functions &rest args) - "From SOURCE apply FUNCTIONS on ARGS. - -This function is used to process filter functions. When filter is -a `filtered-candidate-transformer', we pass to ARGS -candidates+source whereas when the filter is -`candidate-transformer' we pass to ARGS candidates only. -This function is also used to process functions called with no -args, e.g. init functions. In this case it is called without -ARGS. -See `helm-process-filtered-candidate-transformer' - `helm-compute-attr-in-sources' - `helm-process-candidate-transformer'. - -Arg FUNCTIONS is either a symbol or a list of functions, each -function being applied on ARGS and called on the result of the -precedent function. Return the result of last function call." - (let ((helm--source-name (assoc-default 'name source)) - (helm-current-source source) - (funs (if (functionp functions) (list functions) functions))) - (cl-loop with result - for fn in funs - ;; In filter functions, ARGS is a list of one or two elements where - ;; the first element is the list of candidates and the second - ;; a list containing the source. - do (setq result (apply fn args)) - when (and args (cdr funs)) - ;; When more than one fn, set the candidates list to what returns - ;; this fn to compute the modified candidates with the next fn - ;; and so on. - do (setcar args result) - finally return result))) - -(defalias 'helm-funcall-with-source 'helm-apply-functions-from-source) -(make-obsolete 'helm-funcall-with-source 'helm-apply-functions-from-source "2.9.7") - -(defun helm-compute-attr-in-sources (attr &optional sources) - "Call the associated function(s) to ATTR for each source if any." - (let ((sources (or (helm-get-sources sources) - ;; Fix error no buffer named *helm... by checking - ;; if helm-buffer exists. - (and (buffer-live-p (get-buffer (helm-buffer-get))) - ;; `helm-sources' are local to helm-buffer. - (with-helm-buffer helm-sources))))) - (when sources - (dolist (source sources) - (helm-aif (assoc-default attr source) - (helm-apply-functions-from-source source it)))))) - -(defalias 'helm-funcall-foreach 'helm-compute-attr-in-sources) -(make-obsolete 'helm-funcall-foreach 'helm-compute-attr-in-sources "2.9.7") - -(defun helm-normalize-sources (sources) - "If SOURCES is only one source, make a list of one element." - (if (or (and sources (symbolp sources)) - (and (listp sources) (assq 'name sources))) - (list sources) - sources)) - -(defun helm-get-candidate-number (&optional in-current-source) - "Return candidates number in `helm-buffer'. -If IN-CURRENT-SOURCE is provided return the number of candidates -of current source only." - (with-helm-buffer - (if (or (helm-empty-buffer-p) - (helm-empty-source-p)) - 0 - (save-excursion - (helm-aif (and in-current-source (helm-get-previous-header-pos)) - (goto-char it) - (goto-char (point-min))) - (forward-line 1) - (if (helm-pos-multiline-p) - (cl-loop with count-multi = 1 - while (and (not (if in-current-source - (save-excursion - (forward-line 2) - (or (helm-pos-header-line-p) (eobp))) - (eobp))) - (search-forward helm-candidate-separator nil t)) - do (cl-incf count-multi) - finally return count-multi) - (cl-loop with ln = 0 - while (not (if in-current-source - (or (helm-pos-header-line-p) (eobp)) - (eobp))) - ;; Don't count empty lines maybe added by popup (bug#1370). - unless (or (eq (pos-bol) (pos-eol)) - (helm-pos-header-line-p)) - do (cl-incf ln) - do (forward-line 1) finally return ln)))))) - -;;; Main functions -;; -(defconst helm-argument-keys - ;; `:allow-nest' is not in this list because it is treated before. - '(:sources :input :prompt :resume - :preselect :buffer :keymap :default :history)) - -;;;###autoload -(defun helm (&rest plist) - "Main function to execute helm sources. - -PLIST is a list like - -\(:key1 val1 :key2 val2 ...) - - or - -\(&optional sources input prompt resume preselect - buffer keymap default history allow-nest). - -** Keywords - -Keywords supported: - -- :sources -- :input -- :prompt -- :resume -- :preselect -- :buffer -- :keymap -- :default -- :history -- :allow-nest - -Extra LOCAL-VARS keywords are supported, see the \"** Other -keywords\" section below. - -Basic keywords are the following: - -*** :sources - -One of the following: - -- List of sources -- Symbol whose value is a list of sources -- Alist representing a Helm source. - - In this case the source has no name and is referenced in - `helm-sources' as a whole alist. - -*** :input - -Initial input of minibuffer (temporary value of `helm-pattern') - -*** :prompt - -Minibuffer prompt. Default value is `helm--prompt'. - -*** :resume - -If t, allow resumption of the previous session of this Helm -command, skipping initialization. - -If \\='noresume, this instance of `helm' cannot be resumed. - -*** :preselect - -Initially selected candidate (string or regexp). - -*** :buffer - -Buffer name for this Helm session. `helm-buffer' will take this value. - -*** :keymap - -\[Obsolete] - -Keymap used at the start of this Helm session. - -It is overridden by keymaps specified in sources, and is kept -only for backward compatibility. - -Keymaps should be specified in sources using the :keymap slot -instead. See `helm-source'. - -This keymap is not restored by `helm-resume'. - -*** :default - -Default value inserted into the minibuffer \ with -\\\\[next-history-element]. - -It can be a string or a list of strings, in this case -\\\\[next-history-element] cycles through -the list items, starting with the first. - -If nil, `thing-at-point' is used. - -If `helm-maybe-use-default-as-input' is non-nil, display is -updated using this value if this value matches, otherwise it is -ignored. If :input is specified, it takes precedence on :default. - -*** :history - -Minibuffer input, by default, is pushed to `minibuffer-history'. - -When an argument HISTORY is provided, input is pushed to -HISTORY. HISTORY should be a valid symbol. - -*** :allow-nest - -Allow running this Helm command in a running Helm session. - -** Other keywords - -Other keywords are interpreted as local variables of this Helm -session. The `helm-' prefix can be omitted. For example, - -\(helm :sources \\='helm-source-buffers-list - :buffer \"*helm buffers*\" - :candidate-number-limit 10) - -Starts a Helm session with the variable -`helm-candidate-number-limit' set to 10. - -** Backward compatibility - -For backward compatibility, positional parameters are -supported: - -\(helm sources input prompt resume preselect - buffer keymap default history allow-nest) - -However, the use of non-keyword args is deprecated. - -\(fn &key SOURCES INPUT PROMPT RESUME PRESELECT BUFFER KEYMAP DEFAULT HISTORY ALLOW-NEST OTHER-LOCAL-VARS)" - (let ((fn (cond ((or (and helm-alive-p (plist-get plist :allow-nest)) - (and helm-alive-p (memq 'allow-nest plist))) - #'helm--nest) - ((keywordp (car plist)) - #'helm) - (t #'helm-internal)))) - (if (and helm-alive-p (eq fn #'helm)) - (if (helm--alive-p) - ;; A helm session is normally running. - (error "Error: Trying to run helm within a running helm session") - ;; A helm session is already running and user jump somewhere else - ;; without deactivating it. - (with-helm-buffer - (prog1 - (message "Aborting an helm session running in background") - ;; `helm-alive-p' will be reset in unwind-protect forms. - (helm-keyboard-quit)))) - (if (keywordp (car plist)) - ;; Parse `plist' and move not regular `helm-argument-keys' - ;; to `helm--local-variables', then calling helm on itself - ;; with normal arguments (the non--arguments-keys removed) - ;; will end up in [1]. - (progn - (setq helm--local-variables - (append helm--local-variables - ;; Vars passed by keyword on helm call - ;; take precedence on same vars - ;; that may have been passed before helm call. - (helm-parse-keys plist))) - (apply fn (mapcar (lambda (key) (plist-get plist key)) - helm-argument-keys))) - (apply fn plist))))) ; [1] fn == helm-internal. - -(defun helm--alive-p () - "[INTERNAL] Check if `helm' is alive. -An Helm session is considered alive if `helm-alive-p' value is -non-nil, the `helm-buffer' is visible, and cursor is in the -minibuffer." - (and helm-alive-p - (get-buffer-window (helm-buffer-get) 'visible) - (minibuffer-window-active-p (minibuffer-window)) - (minibufferp (current-buffer)))) - -(defun helm-parse-keys (keys) - "Parse the KEYS arguments of `helm'. -Return only those keys not in `helm-argument-keys', prefix them -with \"helm\", and then convert them to an alist. This allows -adding arguments that are not part of `helm-argument-keys', but -are valid helm variables nevertheless. For example, -:candidate-number-limit is bound to `helm-candidate-number-limit' -in the source. - - (helm-parse-keys \\='(:sources ((name . \"test\") - (candidates . (a b c))) - :buffer \"toto\" - :candidate-number-limit 4)) - ==> ((helm-candidate-number-limit . 4))." - - (cl-loop for (key value) on keys by #'cddr - for symname = (substring (symbol-name key) 1) - for sym = (intern (if (string-match "^helm-" symname) - symname - (concat "helm-" symname))) - unless (memq key helm-argument-keys) - collect (cons sym value))) - -(defun helm-internal (&optional - sources input - prompt resume - preselect buffer - keymap default history) - "The internal Helm function called by `helm'. -For SOURCES INPUT PROMPT RESUME PRESELECT BUFFER KEYMAP DEFAULT and -HISTORY args see `helm'." - (cl-assert (or (stringp input) - (null input)) - nil "Error in %S buffer: Initial input should be a string or nil" - buffer) - ;; Set all windows NON dedicated to avoid headaches with PA and - ;; helm-window (bug#2443) - (cl-loop for win in (window-list nil 1) - for state = (window-dedicated-p win) - when state - do (progn (set-window-dedicated-p win nil) - (push `(,win . ,state) helm--original-dedicated-windows-alist))) - (unless helm--nested (setq helm-initial-frame (selected-frame))) - ;; Launch tramp-archive with dbus-event in `while-no-input-ignore-events'. - (helm--maybe-load-tramp-archive) - ;; Activate the advices. - ;; Advices will be available only in >=emacs-24.4, but - ;; allow compiling without errors on lower emacs. - (when (fboundp 'advice-add) - (advice-add 'tramp-read-passwd :around #'helm--suspend-read-passwd) - (advice-add 'ange-ftp-get-passwd :around #'helm--suspend-read-passwd) - (advice-add 'epa-passphrase-callback-function - :around #'helm--suspend-read-passwd) - ;; Ensure linum-mode is disabled in Helm buffers to preserve - ;; performances (Bug#1894). - (advice-add 'linum-on :override #'helm--advice-linum-on '((depth . 100)))) - (helm-log "helm-internal" (concat "[Start session] " (make-string 41 ?+))) - (helm-log "helm-internal" "prompt = %S" prompt) - (helm-log "helm-internal" "preselect = %S" preselect) - (helm-log "helm-internal" "buffer = %S" buffer) - (helm-log "helm-internal" "default = %S" default) - (helm-log "helm-internal" "history = %S" history) - (setq helm--prompt (or prompt "pattern: ")) - (let ((non-essential t) - ;; Prevent mouse jumping to the upper-right - ;; hand corner of the frame (bug#1538). - mouse-autoselect-window - focus-follows-mouse - mode-line-in-non-selected-windows - minibuffer-completion-confirm - (ori--minibuffer-follows-selected-frame - (and (boundp 'minibuffer-follows-selected-frame) - (default-toplevel-value 'minibuffer-follows-selected-frame))) - (input-method-verbose-flag helm-input-method-verbose-flag) - (helm-maybe-use-default-as-input - (and (null input) - (or helm-maybe-use-default-as-input ; it is let-bounded so use it. - (cl-loop for s in (helm-normalize-sources sources) - thereis (memq s helm-sources-using-default-as-input)))))) - (unwind-protect - (condition-case-unless-debug _v - (let ( ;; `helm--source-name' is non-`nil' - ;; when `helm' is invoked by action, reset it. - helm--source-name - helm-current-source - helm-in-persistent-action - helm--quit - (helm-buffer (or buffer helm-buffer))) - (helm-initialize - resume input default sources) - ;; This allows giving the focus to a nested helm session which use - ;; a frame, like completion in - ;; `helm-eval-expression'. Unfortunately - ;; `minibuffer-follows-selected-frame' is available only in - ;; emacs-28+ (bug#2536). - ;; When non-nil (the default) the current active - ;; minibuffer is used in new frame, which is not what we - ;; want in helm when starting from an active minibuffer, - ;; either a helm minibuffer or something line M-:. - (and ori--minibuffer-follows-selected-frame - (setq minibuffer-follows-selected-frame - (unless (or helm--nested - ;; Allow keeping initial minibuffer visible - ;; e.g. completion-at-point from M-:. - (minibufferp helm-current-buffer)) - t))) - ;; We don't display helm-buffer here to avoid popping - ;; up a window or a frame when exiting immediately when - ;; only one candidate (this avoid having the helm frame - ;; flashing), lets first compute candidates and if more - ;; than one display helm-buffer (this is done later in - ;; helm-read-from-minibuffer). - (unless helm-execute-action-at-once-if-one - (helm-display-buffer helm-buffer resume) - (select-window (helm-window)) - (when (and resume helm-visible-mark-overlays) - (set-window-margins (selected-window) - (+ (string-width helm-visible-mark-prefix) - helm-left-margin-width)))) - ;; We are now in helm-buffer. - (unless helm-allow-mouse - (helm--remap-mouse-mode 1)) ; Disable mouse bindings. - (add-hook 'post-command-hook 'helm--maybe-update-keymap) - ;; Add also to update hook otherwise keymap is not updated - ;; until a key is hit (Bug#1670). - (add-hook 'helm-after-update-hook 'helm--maybe-update-keymap) - (add-hook 'post-command-hook 'helm--update-header-line) - (helm-log "helm-internal" "show prompt") - (unwind-protect - (helm-read-from-minibuffer - prompt input preselect - resume keymap default history) - (helm-cleanup)) - (prog1 - (unless helm--quit (helm-execute-selection-action)) - (helm-log "helm-internal" (concat "[End session] " (make-string 41 ?-))))) - (quit - (helm-restore-position-on-quit) - (helm-log-run-hook "helm-internal" 'helm-quit-hook) - (helm-log "helm-internal" (concat "[End session (quit)] " (make-string 34 ?-))) - nil)) - (when (fboundp 'advice-remove) - (advice-remove 'tramp-read-passwd #'helm--suspend-read-passwd) - (advice-remove 'ange-ftp-get-passwd #'helm--suspend-read-passwd) - (advice-remove 'epa-passphrase-callback-function #'helm--suspend-read-passwd) - (advice-remove 'linum-on #'helm--advice-linum-on)) - (helm-log "helm-internal" "helm-alive-p = %S" (setq helm-alive-p nil)) - (helm--remap-mouse-mode -1) ; Reenable mouse bindings. - (setq helm-alive-p nil) - (and ori--minibuffer-follows-selected-frame - (set-default-toplevel-value 'minibuffer-follows-selected-frame - ori--minibuffer-follows-selected-frame)) - ;; Prevent error "No buffer named *helm*" triggered by - ;; `helm-set-local-variable'. - (setq helm--force-updating-p nil) - (setq helm--buffer-in-new-frame-p nil) - ;; Reset helm-pattern so that lambda's using it - ;; before running helm will not start with its old value. - (setq helm-pattern "") - (setq helm--ignore-errors nil - helm-debug nil)))) - -(defun helm--maybe-load-tramp-archive () - ;; Should fix bug#2393 and bug#2394. `while-no-input-ignore-events' - ;; is also let-bounded in `helm--maybe-use-while-no-input'. - (let ((while-no-input-ignore-events - (and (boundp 'while-no-input-ignore-events) - (cons 'dbus-event while-no-input-ignore-events)))) - (unless helm--tramp-archive-maybe-loaded - ;; This for Emacs-27 not requiring tramp-archive. - (and (boundp 'tramp-archive-enabled) - (require 'tramp-archive nil t)) - (setq helm--tramp-archive-maybe-loaded t)))) - -(defun helm--advice-linum-on () - (unless (or (minibufferp) - (string-match "\\`\\*helm" (buffer-name)) - (and (daemonp) (null (frame-parameter nil 'client)))) - (linum-mode 1))) - -;;; Helm resume -;; -;; -(defun helm-resume (arg) - "Resume a previous Helm session. -Call with a prefix arg to choose among existing Helm -buffers (sessions). When calling from Lisp, specify a -`buffer-name' as a string with ARG." - (interactive "P") - (let (buffer - cur-dir - narrow-pos - (helm-full-frame (default-value 'helm-full-frame)) - sources) - (if arg - (if (and (stringp arg) (bufferp (get-buffer arg))) - (setq buffer arg) - (setq buffer (helm-resume-select-buffer))) - (setq buffer helm-last-buffer)) - (cl-assert buffer nil - "helm-resume: No helm buffers found to resume") - (setq sources (buffer-local-value - 'helm-sources (get-buffer buffer))) - ;; Reset `cursor-type' to nil as it have been set to t - ;; when quitting previous session. - (with-current-buffer buffer (setq cursor-type nil)) - (setq helm-full-frame (buffer-local-value - 'helm-full-frame (get-buffer buffer))) - (setq cur-dir (buffer-local-value - 'default-directory (get-buffer buffer))) - (setq helm-saved-selection nil - helm-saved-action nil) - ;; Always resume from current-buffer, if a source needs to resume from a - ;; specific buffer it should be specified from this source, not here. - (setq helm-current-buffer (current-buffer)) - (helm-aif (with-current-buffer buffer - helm--current-buffer-narrowed) - (progn - (set-buffer (car it)) - (setq narrow-pos (cdr it)))) - ;; This happen when calling C-x b within helm. - (helm-aif (get-buffer-window helm-marked-buffer-name 'visible) - (progn (delete-window it) (kill-buffer helm-marked-buffer-name))) - (save-restriction - (when narrow-pos (apply #'narrow-to-region narrow-pos)) - ;; Restart with same `default-directory' value this session - ;; was initially started with. - (with-helm-default-directory cur-dir - (unwind-protect - (helm - :sources sources - :input (buffer-local-value 'helm-input-local (get-buffer buffer)) - :prompt (buffer-local-value 'helm--prompt (get-buffer buffer)) - :resume t - :buffer buffer) - (run-hook-with-args 'helm-resume-after-hook sources)))))) - -(defun helm-resume-previous-session-after-quit () - "Resume previous Helm session within a running Helm." - (interactive) - (with-helm-alive-p - (let ((arg (if (null (member helm-buffer helm-buffers)) 0 1))) - (cond ((> (minibuffer-depth) 1) - (message "Can't resume from recursive minibuffers")) - ((> (length helm-buffers) arg) - (helm-run-after-exit (lambda () (helm-resume (nth arg helm-buffers))))) - (t (message "No previous helm sessions available for resuming")))))) -(put 'helm-resume-previous-session-after-quit 'helm-only t) - -(defun helm-resume-list-buffers-after-quit () - "List Helm buffers that can be resumed within a running Helm." - (interactive) - (with-helm-alive-p - (cond ((> (minibuffer-depth) 1) - (message "Can't resume from recursive minibuffers")) - ((> (length helm-buffers) 0) - (helm-run-after-exit (lambda () (helm-resume t)))) - (t (message "No previous helm sessions available for resuming"))))) -(put 'helm-resume-list-buffers-after-quit 'helm-only t) - -(defun helm-resume-p (resume) - "Whether current Helm session is resumed or not." - (eq resume t)) - -(defun helm-resume-select-buffer () - "Select an `helm-buffer' in `helm-buffers' list to resume a helm session. -Return nil if no `helm-buffer' found." - (when helm-buffers - (or (helm :sources (helm-build-sync-source "Resume helm buffer" - :candidates helm-buffers) - :resume 'noresume - :buffer "*helm resume*") - (keyboard-quit)))) - -;;;###autoload -(defun helm-cycle-resume () - "Cycle in `helm-buffers' list and resume when waiting more than 1.2s." - (interactive) - (cl-assert (and helm-buffers helm-last-buffer) - nil "No helm buffers to resume") - ;; Setup a new iterator only on first hit on - ;; `helm-run-cycle-resume', subsequents hits should reuse same - ;; iterator. - (unless (and (eq last-command 'helm-cycle-resume) - helm--cycle-resume-iterator) - (setq helm--cycle-resume-iterator - (helm-iter-sub-next-circular - helm-buffers helm-last-buffer :test 'equal))) - (helm--resume-or-iter)) - -(defun helm--resume-or-iter (&optional from-helm) - (message "Resuming helm buffer `%s'" helm-last-buffer) - (if (sit-for helm-cycle-resume-delay) - ;; Delay expire, run helm-resume. - (if from-helm - (helm-run-after-exit (lambda () (helm-resume helm-last-buffer))) - (helm-resume helm-last-buffer)) - ;; key pressed before delay, cycle. - (unless from-helm ; cycling to next item already done. - (message "Resuming helm buffer `%s'" - (setq helm-last-buffer - (helm-iter-next helm--cycle-resume-iterator)))))) - -(defun helm-run-cycle-resume () - "Same as `helm-cycle-resume' but intended to be called only from Helm." - (interactive) - (when (cdr helm-buffers) ; only one session registered. - ;; Setup a new iterator only on first hit on - ;; `helm-run-cycle-resume', subsequents hits should reuse same - ;; iterator. - (unless (and (eq last-command 'helm-run-cycle-resume) - helm--cycle-resume-iterator) - (setq helm--cycle-resume-iterator - (helm-iter-sub-next-circular - helm-buffers helm-last-buffer :test 'equal))) - ;; start at next buffer as we already are at `helm-last-buffer'. - (setq helm-last-buffer - (helm-iter-next helm--cycle-resume-iterator)) - (helm--resume-or-iter 'from-helm))) -(put 'helm-run-cycle-resume 'helm-only t) - - -;;; Nested sessions -;; -;; -(defun helm--nest (&rest same-as-helm) - "[INTERNAL] Allow calling `helm' within a running Helm session. - -Arguments SAME-AS-HELM are the same as `helm'. - -Don't use this directly, use instead `helm' with the keyword -:allow-nest. - -\(fn &key SOURCES INPUT PROMPT RESUME PRESELECT BUFFER KEYMAP DEFAULT HISTORY OTHER-LOCAL-VARS)" - (with-helm-window - (let ((orig-helm-current-buffer helm-current-buffer) - (orig-helm-buffer helm-buffer) - (orig-helm--prompt helm--prompt) - (orig-helm-sources helm-sources) - (orig-helm--in-fuzzy helm--in-fuzzy) - (orig-helm--display-frame helm--buffer-in-new-frame-p) - (orig-helm-last-frame-or-window-configuration - helm-last-frame-or-window-configuration) - (orig-one-window-p helm-onewindow-p) - (helm--nested (if helm--buffer-in-new-frame-p 'share t)) - ;; Prevent reusing the underlying value of - ;; `helm-execute-action-at-once-if-one' particularly if it is a function. - helm-execute-action-at-once-if-one) - ;; Using helm-full-frame here allow showing the new - ;; helm-buffer in the same window as old helm-buffer by forcing the usage - ;; of switch-to-buffer in `helm-default-display-buffer', using the flag - ;; `helm--nested' would have the same effect and be more explicit. - (helm-set-local-variable 'helm-full-frame t) - (unwind-protect - (let (helm-current-position - helm-current-buffer - helm-pattern - (helm-buffer (or (cl-getf same-as-helm :buffer) - (nth 5 same-as-helm) - "*Helm*")) - (enable-recursive-minibuffers t)) - (setq helm-sources nil) - (apply #'helm same-as-helm)) - (with-current-buffer orig-helm-buffer - (setq helm-sources orig-helm-sources) - (setq helm--nested nil) - (setq helm--buffer-in-new-frame-p orig-helm--display-frame) - (setq helm-alive-p t) ; Nested session set this to nil on exit. - (setq helm-buffer orig-helm-buffer) - (setq helm-full-frame nil) - (setq helm--prompt orig-helm--prompt) - (setq helm--in-fuzzy orig-helm--in-fuzzy) - (helm-initialize-overlays helm-buffer) - (unless (helm-empty-buffer-p) (helm-mark-current-line t)) - (setq helm-last-frame-or-window-configuration - orig-helm-last-frame-or-window-configuration) - (setq cursor-type nil) - (setq helm-current-buffer orig-helm-current-buffer) - (setq helm-onewindow-p orig-one-window-p) - ;; Be sure advices, hooks, and local modes keep running. - (advice-add 'tramp-read-passwd - :around #'helm--suspend-read-passwd) - (advice-add 'ange-ftp-get-passwd - :around #'helm--suspend-read-passwd) - (advice-add 'epa-passphrase-callback-function - :around #'helm--suspend-read-passwd) - (unless helm-allow-mouse - (helm--remap-mouse-mode 1)) - (unless (cl-loop for h in post-command-hook - thereis (memq h '(helm--maybe-update-keymap - helm--update-header-line))) - (add-hook 'post-command-hook 'helm--maybe-update-keymap) - (add-hook 'post-command-hook 'helm--update-header-line)) - (helm-display-mode-line (helm-get-current-source))))))) - - -;;; Windows and frames -;; -;; - -(defun helm-frame-or-window-configuration (save-or-restore) - "Save or restore last frame or window configuration. -Argument SAVE-OR-RESTORE is either save or restore of window or -frame configuration as per `helm-save-configuration-functions'." - (helm-log "helm-frame-or-window-configuration" "helm-save-configuration-functions = %S" - helm-save-configuration-functions) - (let ((window-persistent-parameters (append '((no-other-window . t)) - window-persistent-parameters))) - (cl-case save-or-restore - (save (setq helm-last-frame-or-window-configuration - (funcall (cdr helm-save-configuration-functions)))) - (restore (funcall (car helm-save-configuration-functions) - helm-last-frame-or-window-configuration) - ;; Restore dedicated windows (bug#2443). - (when helm--original-dedicated-windows-alist - (cl-loop for (win . state) in helm--original-dedicated-windows-alist - when (window-live-p win) - do (set-window-dedicated-p win state)) - (setq helm--original-dedicated-windows-alist nil)) - ;; Restore frame focus. - ;; This is needed for minibuffer own-frame config - ;; when recursive minibuffers are in use. - ;; e.g M-: + helm-minibuffer-history. - (cl-letf ((frame (if (minibufferp helm-current-buffer) - (selected-frame) - (last-nonminibuffer-frame))) - ;; This is a workaround, because the i3 window - ;; manager developers are refusing to fix their - ;; broken timestamp and event handling. - ;; - ;; We basically just disable the part of - ;; select-frame-set-input-focus that would call - ;; XSetInputFocus in Xlib (x-focus-frame), that - ;; resets a timestamp in the xserver which the i3 - ;; developers fail to notice. - ;; - ;; Since they don't know about the new timestamp, - ;; their keyboard handling can break after a helm - ;; user quits emacs, as reported in bug#1641. - ;; - ;; Fortunately for us, we really don't need this - ;; XSetInputFocus call, since we already have focus - ;; for Emacs, the user is just using helm! We call - ;; select-frame-set-input-focus for the other - ;; side-effects, not for x-focus-frame. - ((symbol-function 'x-focus-frame) #'ignore)) - (select-frame-set-input-focus frame)))))) - -(defun helm-current-window-configuration () - "Like `current-window-configuration' but deal with Transient incompatibility. -See https://github.com/magit/transient/discussions/361 for details." - (when (and (window-live-p (bound-and-true-p transient--window)) - (not (transient--preserve-window-p))) - (transient--delete-window)) - (current-window-configuration)) - -(defun helm-split-window-default-fn (window) - "Default function to split windows before displaying `helm-buffer'. - -It is used as default value for -`helm-split-window-preferred-function' which is then the -let-bounded value of `split-window-preferred-function' in -`helm-display-buffer'. When `helm-display-function' which default -to `helm-default-display-buffer' is called from -`helm-display-buffer' the value of -`split-window-preferred-function' will be used by -`display-buffer'." - (let* ((split-width-threshold (and (integerp helm-split-width-threshold) - helm-split-width-threshold)) - (win (if (and (fboundp 'window-in-direction) - ;; Don't try to split when starting in a minibuffer - ;; e.g M-: and try to use helm-show-kill-ring. - (not (minibufferp helm-current-buffer)) - (null helm-split-width-threshold)) - (if (or (one-window-p t) - helm-split-window-inside-p) - (split-window - (selected-window) nil - (if (eq helm-split-window-default-side 'other) - helm-split-window-other-side-when-one-window - helm-split-window-default-side)) - ;; If more than one window reuse one of them. - (cl-case helm-split-window-default-side - (left (or (helm-window-in-direction 'left) - (helm-window-in-direction 'above) - (selected-window))) - (above (or (helm-window-in-direction 'above) - (helm-window-in-direction 'left) - (selected-window))) - (right (or (helm-window-in-direction 'right) - (helm-window-in-direction 'below) - (selected-window))) - (below (or (helm-window-in-direction 'below) - (helm-window-in-direction 'right) - (selected-window))) - (same (selected-window)) - (other (or (helm-other-window-for-scrolling) - (selected-window))) - (t (or (window-next-sibling) (selected-window))))) - (split-window-sensibly window)))) - (setq helm-persistent-action-window-buffer (window-buffer win)) - win)) - -(defun helm-window-in-direction (direction) - "Same as `window-in-direction' but check if window is dedicated. -Return nil when window is dedicated." - (helm-aif (window-in-direction direction) - (and (not (window-dedicated-p it)) it))) - -(defun helm-other-window-for-scrolling () - "Same as `other-window-for-scrolling' but check if window is dedicated. -Returns nil when window is dedicated." - (helm-aif (other-window-for-scrolling) - (and (not (window-dedicated-p it)) it))) - -(defun helm-resolve-display-function (com) - "Decide which display function to use according to `helm-commands-using-frame'. - -The `helm-display-function' buffer local value takes precedence -on `helm-commands-using-frame'. -If `helm-initial-frame' has no minibuffer, use -`helm-display-buffer-in-own-frame' function. -Fallback to global value of `helm-display-function' when no local -value found and current command is not in -`helm-commands-using-frame'." - (let ((win (get-buffer-window helm-current-buffer))) - (or (with-helm-buffer helm-display-function) - (and (or (memq com helm-commands-using-frame) - (and helm-use-frame-when-no-suitable-window - (or (window-dedicated-p win) - (window-parameter win 'window-side))) - (and helm-use-frame-when-more-than-two-windows - (null helm--nested) - (> (length (window-list)) 2)) - ;; Frame parameter is unreliable for minibuffer on emacs-26. - (null (member helm-initial-frame (minibuffer-frame-list)))) - #'helm-display-buffer-in-own-frame) - (default-value 'helm-display-function)))) - -(defun helm-display-buffer (buffer &optional resume) - "Display BUFFER. - -The function used to display `helm-buffer' by calling -`helm-display-function' which splits window with -`helm-split-window-preferred-function'." - (let ((split-window-preferred-function - helm-split-window-preferred-function) - (helm-split-window-default-side - (if (and (not helm-full-frame) - helm-reuse-last-window-split-state) - (helm-acase helm-split-window-default-side - ((same other) it) ; take precedence on *-window-side-state. - ((guard* (progn helm--window-side-state)) guard) - (t it)) - helm-split-window-default-side)) - (disp-fn (with-current-buffer buffer - (helm-resolve-display-function - (if helm-actions-inherit-frame-settings - (helm-this-command) this-command))))) - (prog1 - (funcall disp-fn buffer (or (helm-resume-p resume) - (and helm-actions-inherit-frame-settings - helm--executing-helm-action))) - (with-helm-buffer (setq-local helm-display-function disp-fn)) - (setq helm-onewindow-p (one-window-p t)) - ;; Don't allow other-window and friends switching out of minibuffer. - (when helm-prevent-escaping-from-minibuffer - (helm-prevent-switching-other-window))))) - -(cl-defun helm-prevent-switching-other-window (&key (enabled t)) - "Allow setting `no-other-window' parameter for all windows. -Arg ENABLE is the value of `no-other-window' window property." - (walk-windows - (lambda (w) - (unless (window-dedicated-p w) - (set-window-parameter w 'no-other-window enabled))) - 0)) - -(defun helm-default-display-buffer (buffer &optional _resume) - "Default function to display `helm-buffer' BUFFER. - -It is the default value of `helm-display-function'. -It uses `switch-to-buffer' or `display-buffer' depending on the -value of `helm-full-frame' or `helm-split-window-default-side'." - (let (pop-up-frames - (curwin (get-buffer-window helm-current-buffer))) - (if (or (buffer-local-value 'helm-full-frame (get-buffer buffer)) - (and (eq helm-split-window-default-side 'same) - (one-window-p t))) - (progn (and (not (minibufferp helm-current-buffer)) - ;; side-windows can't be the only window in frame, - ;; emacs refuse to delete other windows when - ;; current is a side-window [1]. - (not (window-parameter curwin 'window-side)) - (delete-other-windows)) - (switch-to-buffer buffer)) - (when (and (or helm-always-two-windows helm-autoresize-mode) - (not (eq helm-split-window-default-side 'same)) - (not (minibufferp helm-current-buffer)) - (not helm-split-window-inside-p) - ;; Same comment as in [1]. - (not (window-parameter curwin 'window-side))) - (delete-other-windows)) - (display-buffer - buffer `(,helm-default-display-buffer-functions - . ,(append helm-default-display-buffer-alist - `((window-height . ,helm-display-buffer-default-height) - (window-width . ,helm-display-buffer-default-width))))) - (helm-log-run-hook "helm-default-display-buffer" 'helm-window-configuration-hook)))) - -;; Shut up byte-compiler in emacs-26 -(defvar tab-bar-mode) -;; No warnings in Emacs built --without-x -(defvar x-display-name) - -(defun helm-display-buffer-in-own-frame (buffer &optional resume) - "Display Helm buffer BUFFER in a separate frame. - -Function suitable for `helm-display-function', -`helm-completion-in-region-display-function' and/or -`helm-show-completion-default-display-function'. - -See `helm-display-buffer-height' and `helm-display-buffer-width' -to configure frame size. - -Note that this feature is available only with emacs-25+. -Note also it is not working properly in helm nested session with emacs -version < emacs-28." - (cl-assert (and (fboundp 'window-absolute-pixel-edges) - (fboundp 'frame-geometry)) - nil "Helm buffer in own frame is only available starting at emacs-25+") - (if (not (display-graphic-p)) - ;; Fallback to default when frames are not usable. - (helm-default-display-buffer buffer) - (setq helm--buffer-in-new-frame-p t) - (let* ((pos (window-absolute-pixel-position)) - (px (car pos)) - (py (cdr pos)) - (half-screen-size (/ (display-pixel-height x-display-name) 2)) - (frame-info (frame-geometry)) - (screen-width (display-pixel-width x-display-name)) - (helm-frame-width (* (frame-char-width) (+ 2 helm-display-buffer-width))) - (prmt-size (length helm--prompt)) - (prmt-width (* prmt-size (frame-char-width))) - (line-height (frame-char-height)) - tab-bar-mode - (new-frame-alist - (if resume - (buffer-local-value 'helm--last-frame-parameters - (get-buffer buffer)) - `((width . ,helm-display-buffer-width) - (height . ,helm-display-buffer-height) - (tool-bar-lines . 0) - ;; lateral constraint to keep the frame inside of the screen - (left . ,(cond ((> (+ px helm-frame-width) screen-width) - (- screen-width helm-frame-width)) - (t (max (- px prmt-width) 0)))) - ;; Try to put frame at the best possible place. - ;; Frame should be below point if enough - ;; place, otherwise above point and - ;; current line should not be hidden - ;; by helm frame. - (top . ,(if (> py half-screen-size) - ;; Above point - (- py - ;; add 2 lines to make sure there is always a gap - (* (+ helm-display-buffer-height 2) line-height) - ;; account for title bar height too - (cddr (assq 'title-bar-size frame-info))) - ;; Below point - (+ py line-height))) - (title . "Helm") - (undecorated . ,helm-use-undecorated-frame-option) - (background-color . ,(or helm-frame-background-color - (face-attribute 'default :background))) - (foreground-color . ,(or helm-frame-foreground-color - (face-attribute 'default :foreground))) - (alpha . ,(or helm-frame-alpha 100)) - (font . ,(assoc-default 'font (frame-parameters))) - (vertical-scroll-bars . nil) - (menu-bar-lines . 0) - (fullscreen . nil) - (visibility . ,(null helm-display-buffer-reuse-frame)) - (minibuffer . t)))) - display-buffer-alist) - ;; Display minibuffer above or below only in initial session, - ;; not on a session triggered by action, this way if user have - ;; toggled minibuffer and header-line manually she keeps this - ;; setting in next action. - (unless (or helm--executing-helm-action resume) - ;; Add the hook inconditionally, if - ;; helm-echo-input-in-header-line is nil helm-hide-minibuffer-maybe - ;; will have anyway no effect so no need to remove the hook. - (add-hook 'helm-minibuffer-set-up-hook 'helm-hide-minibuffer-maybe) - (with-helm-buffer - (setq-local helm-echo-input-in-header-line - (not (> py half-screen-size))))) - (helm-display-buffer-popup-frame buffer new-frame-alist) - ;; When frame size have been modified manually by user restore - ;; it to default value unless resuming or not using - ;; `helm-display-buffer-reuse-frame'. - ;; This have to be done AFTER raising the frame otherwise - ;; minibuffer visibility is lost until next session. - (unless (or resume (not helm-display-buffer-reuse-frame)) - (set-frame-size helm-popup-frame - helm-display-buffer-width - helm-display-buffer-height))) - (helm-log-run-hook "helm-display-buffer-in-own-frame" 'helm-window-configuration-hook))) - -(defun helm-display-buffer-popup-frame (buffer frame-alist) - (if helm-display-buffer-reuse-frame - (let* ((x (cdr (assoc 'left frame-alist))) - (y (cdr (assoc 'top frame-alist))) - (width (cdr (assoc 'width frame-alist))) - (height (cdr (assoc 'height frame-alist)))) - (unless (and helm-popup-frame - (frame-live-p helm-popup-frame)) - (setq helm-popup-frame (make-frame frame-alist))) - (select-frame helm-popup-frame) - (set-frame-position helm-popup-frame x y) - (set-frame-width helm-popup-frame width) - (set-frame-height helm-popup-frame height) - (switch-to-buffer buffer) - (select-frame-set-input-focus helm-popup-frame t)) - ;; If user have changed `helm-display-buffer-reuse-frame' to nil - ;; maybe kill the frame. - (when (and helm-popup-frame - (frame-live-p helm-popup-frame)) - (delete-frame helm-popup-frame)) - (display-buffer - buffer `(display-buffer-pop-up-frame - . ((pop-up-frame-parameters . ,frame-alist)))))) - -(defun helm--frame () - (cl-loop for f in (frame-list) - when (equal (frame-parameter f 'title) "Helm") - return f)) - -;; Ensure to quit helm when user delete helm frame manually. -;; If user deletes another frame keep session running. -(defun helm--delete-frame-function (frame) - (when (and helm-alive-p - ;; FRAME is handling helm-buffer - (get-buffer-window helm-buffer frame)) - (helm-keyboard-quit))) -(add-hook 'delete-frame-functions 'helm--delete-frame-function) - -;;; Initialize -;; -(defun helm-get-sources (sources) - "Transform each element of SOURCES in alist. -Return the resulting list." - (when sources - (mapcar (lambda (source) - (if (listp source) - source (symbol-value source))) - (helm-normalize-sources sources)))) - -(defun helm-initialize (resume input default sources) - "Start initialization of Helm session. -For RESUME INPUT DEFAULT and SOURCES see `helm'." - (helm-log "helm-initialize" "start initialization: resume=%S input=%S" - resume input) - (helm-frame-or-window-configuration 'save) - (let ((sources-list (helm-get-sources sources))) - (setq helm--in-fuzzy - (cl-loop for s in sources-list - for matchfns = (helm-match-functions s) - for searchfns = (helm-search-functions s) - when (or (memq 'helm-fuzzy-match matchfns) - (memq 'helm-fuzzy-search searchfns)) - return t)) - (helm-log "helm-initialize" "sources-list = %S" sources-list) - (helm-set-local-variable 'helm-sources sources-list) - ;; Once `helm-buffer' is created `helm-sources' will be a local - ;; variable which value is a list of alists. - (helm-current-position 'save) - (if (helm-resume-p resume) - (helm-initialize-overlays (helm-buffer-get)) - (helm-initial-setup input default sources-list)) - (setq helm-alive-p t) - (unless (eq resume 'noresume) - (helm--push-and-remove-dups helm-buffer 'helm-buffers) - (setq helm-last-buffer helm-buffer)) - ;; If a `resume' attribute is present `helm-compute-attr-in-sources' - ;; will run its function. - (when (helm-resume-p resume) - (helm-compute-attr-in-sources 'resume)) - (helm-log "helm-initialize" "end initialization"))) - -(defun helm-current-position (save-or-restore) - "Save or restore current position in `helm-current-buffer'. -Argument SAVE-OR-RESTORE is either save or restore." - (cl-case save-or-restore - (save - (helm-log "helm-current-position" "Save position at %S" (cons (point) (window-start))) - (setq helm-current-position (cons (point) (window-start)))) - (restore - ;; Maybe `helm-current-buffer' have been deleted - ;; during helm session so check if it is here - ;; otherwise position in underlying buffer will be lost. - (when (get-buffer-window helm-current-buffer 'visible) - (helm-log "helm-current-position" "Restore position at %S in buffer %s" - helm-current-position - (buffer-name (current-buffer))) - (goto-char (car helm-current-position)) - ;; Fix this position with the NOFORCE arg of `set-window-start' - ;; otherwise, if there is some other buffer than `helm-current-buffer' - ;; one, position will be lost. - (set-window-start (selected-window) (cdr helm-current-position) t))))) - -(defun helm-initialize-overlays (buffer) - "Initialize Helm overlays in BUFFER." - (helm-log "helm-initialize-overlays" "overlay setup") - (if helm-selection-overlay - ;; make sure the overlay belongs to the helm buffer if - ;; it's newly created - (move-overlay helm-selection-overlay (point-min) (point-min) - (get-buffer buffer)) - - (setq helm-selection-overlay - (make-overlay (point-min) (point-min) (get-buffer buffer))) - (overlay-put helm-selection-overlay 'face 'helm-selection) - (overlay-put helm-selection-overlay 'priority 1))) - -(defun helm-initial-setup (input default sources) - "Initialize Helm settings and set up the Helm buffer." - ;; Run global hook. - (helm-log-run-hook "helm-initial-setup" 'helm-before-initialize-hook) - ;; Run local source hook. - (helm--run-init-hooks 'before-init-hook sources) - ;; For initialization of helm locals vars that need - ;; a value from current buffer, it is here. - (helm-set-local-variable 'current-input-method current-input-method) - (setq helm-current-prefix-arg nil - helm-saved-action nil - helm-saved-selection nil - helm-suspend-update-flag nil - ;; Ensure this is called BEFORE selecting helm-window. - helm-current-buffer (helm--current-buffer) - helm-buffer-file-name buffer-file-name - helm-issued-errors nil - helm-saved-current-source nil - helm--suspend-update-interactive-flag nil) - (when (and (with-helm-current-buffer - (and (buffer-narrowed-p) - (use-region-p))) - (not helm--nested)) - (helm-set-local-variable 'helm--current-buffer-narrowed - (list (current-buffer) - (region-beginning) (region-end)))) - (unless (and (or helm-split-window-state - helm--window-side-state) - helm-reuse-last-window-split-state) - ;; `helm-split-window-state' should be the contrary of what we currently - ;; have to allow toggling windows with C-t. This was influencing the - ;; behavior of `helm-show-action-window-other-window' but we have now - ;; removed this limitation, the action buffer beeing displayed 'below' when - ;; helm-window is too narrow (vertical split). See bug#2635. - (setq helm-split-window-state - (if (or (null helm-split-window-default-side) ; same as below. - (memq helm-split-window-default-side '(below above)) - (null helm-split-width-threshold) - (and (integerp helm-split-width-threshold) - (>= helm-split-width-threshold (+ (frame-width) 4)))) - 'vertical 'horizontal)) - (setq helm--window-side-state - (or helm-split-window-default-side 'below))) - ;; Some sources like helm-mu are using input to init their - ;; candidates in init function, so setup initial helm-pattern here. - ;; See bug#2530 and https://github.com/emacs-helm/helm-mu/issues/54. - ;; Input should have precedence on default. - (cond (input - (setq helm-input input - helm-pattern input)) - ((and default helm-maybe-use-default-as-input) - (setq helm-pattern (if (listp default) - (car default) - default) - ;; Even if helm-pattern is set we want the - ;; prompt to be empty when using default as input, why - ;; helm-input is initialized to "". - helm-input "")) - (helm-maybe-use-default-as-input - (setq helm-pattern (or (with-helm-current-buffer - (thing-at-point 'symbol)) - "") - helm-input "")) - (t - (setq helm-pattern "" - helm-input ""))) - (helm--fuzzy-match-maybe-set-pattern) - ;; Call the init function for sources where appropriate - (helm-compute-attr-in-sources 'init sources) - (clrhash helm-candidate-cache) - (helm-create-helm-buffer) - (helm-clear-visible-mark) - ;; Run global hook. - (helm-log-run-hook "helm-initial-setup" 'helm-after-initialize-hook) - ;; Run local source hook. - (helm--run-init-hooks 'after-init-hook sources)) - -(defun helm--run-init-hooks (hook sources) - "Run after and before init hooks local to source. -See :after-init-hook and :before-init-hook in `helm-source'." - ;; We handle here incorrect values of hooks to not break packages using such - ;; values i.e. lambda's or lists not bound to a symbol. In the future we may - ;; use `helm-log-run-hook' directly which allow using add-hook, remove-hook - ;; etc... - (dolist (s sources) - (helm-acase (assoc-default hook s) - ((guard* (and (functionp it) (not (symbolp it)))) - (funcall it)) - ((guard* (listp it)) - (dolist (h it) (funcall h))) - (t (helm-log-run-hook "helm--run-init-hooks" it))))) - -(defun helm-restore-position-on-quit () - "Restore position in `helm-current-buffer' when quitting." - (helm-current-position 'restore)) - -(defun helm--push-and-remove-dups (elm sym) - "Move ELM of SYM value on top and set SYM to this new value." - (set sym (cons elm (delete elm (symbol-value sym))))) - -(defun helm--current-buffer () - "[INTERNAL] Return `current-buffer' BEFORE `helm-buffer' is initialized. -Note that it returns the minibuffer in use after Helm has started -and is intended for `helm-initial-setup'. To get the buffer where -Helm was started, use `helm-current-buffer' instead." - (if (minibuffer-window-active-p (minibuffer-window)) - ;; If minibuffer is active be sure to use it's buffer - ;; as `helm-current-buffer', this allow to use helm - ;; from an already active minibuffer (M-: etc...) - (window-buffer (active-minibuffer-window)) - ;; Fix Bug#456 - ;; Use this instead of `current-buffer' to ensure - ;; helm session started in helm-mode from a completing-read - ;; Use really the buffer where we started and not the one - ;; where the completing-read is wrapped. i.e - ;; (with-current-buffer SOME-OTHER-BUFFER (completing-read [...]) - (window-buffer (with-selected-window (minibuffer-window) - (minibuffer-selected-window))))) - -(define-derived-mode helm-major-mode - fundamental-mode "Hmm" - "[INTERNAL] Provide major-mode name in Helm buffers. -Unuseful when used outside Helm, don't use it.") -(put 'helm-major-mode 'mode-class 'special) -(put 'helm-major-mode 'helm-only t) - -(defun helm-create-helm-buffer () - "Create and setup `helm-buffer'." - (let ((root-dir default-directory) - (inhibit-read-only t)) - (with-current-buffer (get-buffer-create helm-buffer) - (helm-log "helm-create-helm-buffer" "Enabling major-mode %S" major-mode) - (helm-log "helm-create-helm-buffer" "kill local variables: %S" (buffer-local-variables)) - (kill-all-local-variables) - (helm-major-mode) - (set (make-local-variable 'buffer-read-only) nil) - (buffer-disable-undo) - (erase-buffer) - ;; Use this instead of setting helm-map local ensure we have all - ;; our keys when helm loose minibuffer focus. And the map is - ;; made local as well AFAIU. - (use-local-map helm-map) - (set (make-local-variable 'helm-source-filter) nil) - (make-local-variable 'helm-sources) - (set (make-local-variable 'helm-display-function) nil) - (set (make-local-variable 'helm-selection-point) nil) - (set (make-local-variable 'scroll-margin) - (if helm-display-source-at-screen-top - 0 helm-completion-window-scroll-margin)) - (set (make-local-variable 'default-directory) root-dir) - (set (make-local-variable 'helm-marked-candidates) nil) - (set (make-local-variable 'helm--prompt) helm--prompt) - (helm-initialize-persistent-action) - (helm-log "helm-create-helm-buffer" "helm-display-function = %S" helm-display-function) - (helm-log "helm-create-helm-buffer" "helm--local-variables = %S" helm--local-variables) - (helm--set-local-variables-internal) - (setq truncate-lines helm-truncate-lines) ; already local. - (setq left-margin-width helm-left-margin-width) - (setq cursor-type nil)) - (helm-initialize-overlays helm-buffer) - (get-buffer helm-buffer))) - -(define-minor-mode helm--minor-mode - "[INTERNAL] Enable keymap in Helm minibuffer. -Since this mode has no effect when run outside of Helm context, -please don't use it outside of Helm. - -\\{helm-map}" - :group 'helm - :keymap (and helm-alive-p helm-map) - (unless helm-alive-p (setq helm--minor-mode nil))) -(put 'helm--minor-mode 'helm-only t) - -(defun helm--reset-default-pattern () - (setq helm-pattern "") - (setq helm-maybe-use-default-as-input nil)) - -(defun helm-read-from-minibuffer (prompt - input preselect resume - keymap default history) - "Read pattern with prompt PROMPT and initial input INPUT. -For PRESELECT RESUME KEYMAP DEFAULT HISTORY, see `helm'." - (with-helm-buffer - (if (and (helm-resume-p resume) - ;; When no source, helm-buffer is empty - ;; or contain non--candidate lines (e.g grep exit status) - (helm-get-current-source)) - (helm-mark-current-line t) - (helm-update preselect)) - (let* ((src (helm-get-current-source)) - (src-keymap (assoc-default 'keymap src)) - (hist (or (and history (symbolp history) history) - ;; Needed for resuming. - (assoc-default 'history src))) - (timer nil) - blink-matching-paren - (first-src (car helm-sources)) - (source-process-p (or (assq 'candidates-process src) - (assq 'candidates-process first-src))) - ;; As we are using `helm-keyboard-quit' for `C-g' we have - ;; to prevent emacs command loop redefining `C-g' during - ;; helm-session. This happen only on async source with - ;; large output after a certain delay. The effect is that - ;; the minibuffer is exited but the helm async process - ;; continue running, and because minibuffer is lost `C-g' - ;; have no more effect. By binding `inhibit-quit' here we - ;; prevent this and allow `C-g' (the helm one aka - ;; `helm-keyboard-quit') to quit immediately. - (inhibit-quit source-process-p)) - (helm-log "helm-read-from-minibuffer" "helm-get-candidate-number => %S" - (helm-get-candidate-number)) - (helm-log "helm-read-from-minibuffer" "helm-execute-action-at-once-if-one = %S" - helm-execute-action-at-once-if-one) - (helm-log "helm-read-from-minibuffer" - "helm-quit-if-no-candidate = %S" helm-quit-if-no-candidate) - (when (and src (helm-resume-p resume)) - (helm-display-mode-line src) - (setq helm-pattern input)) - ;; Reset `helm-pattern' and update - ;; display if no result found with precedent value of `helm-pattern' - ;; unless `helm-quit-if-no-candidate' is non-`nil', in this case - ;; Don't force update with an empty pattern. - ;; Reset also `helm-maybe-use-default-as-input' as this checking - ;; happen only on startup. - (when helm-maybe-use-default-as-input - ;; Store value of `default' temporarily here waiting next update - ;; to allow actions like helm-moccur-action matching pattern - ;; at the place it jump to. - (setq helm-input helm-pattern) - (if source-process-p - ;; Reset pattern to next update. - (with-helm-after-update-hook - (helm--reset-default-pattern)) - ;; Reset pattern right now. - (helm--reset-default-pattern)) - ;; Ensure force-update when no candidates - ;; when we start with an empty pattern. - (and (helm-empty-buffer-p) - (null helm-quit-if-no-candidate) - (helm-force-update preselect))) - ;; Handle `helm-execute-action-at-once-if-one' and - ;; `helm-quit-if-no-candidate' now. - (cond ((and (if (functionp helm-execute-action-at-once-if-one) - (funcall helm-execute-action-at-once-if-one) - helm-execute-action-at-once-if-one) - (= (helm-get-candidate-number - (eq helm-execute-action-at-once-if-one 'current-source)) - 1)) - (ignore)) ; Don't enter the minibuffer loop. - ((and helm-quit-if-no-candidate - (= (helm-get-candidate-number) 0)) - (setq helm--quit t) - (and (functionp helm-quit-if-no-candidate) - (funcall helm-quit-if-no-candidate))) - (t ; Enter now minibuffer and wait for input. - (let ((tap (or default - (with-helm-current-buffer - (thing-at-point 'symbol))))) - (when helm-execute-action-at-once-if-one - (helm-display-buffer helm-buffer resume) - (select-window (helm-window))) - (unwind-protect - (minibuffer-with-setup-hook - (lambda () - ;; Start minor-mode with global value of helm-map. - (helm--minor-mode 1) - ;; Now override the global value of `helm-map' with - ;; the local one which is in this order: - ;; - The keymap of current source. - ;; - The value passed in KEYMAP - ;; - Or fallback to the global value of helm-map. - (helm--maybe-update-keymap - (or src-keymap keymap helm-map)) - (helm-log-run-hook "helm-read-from-minibuffer" - 'helm-minibuffer-set-up-hook) - (setq timer - (run-with-idle-timer - (max (with-helm-buffer helm-input-idle-delay) - 0.001) - 'repeat - (lambda () - ;; Stop updating in persistent action - ;; or when `helm-suspend-update-flag' - ;; is non-`nil'. - (unless (or helm-in-persistent-action - helm-suspend-update-flag) - (save-selected-window - (helm-check-minibuffer-input) - (helm-print-error-messages)))))) - ;; minibuffer has already been filled here. - (helm--update-header-line)) - (read-from-minibuffer (propertize (or prompt "pattern: ") - 'face 'helm-minibuffer-prompt) - input helm-map - nil hist tap - helm-inherit-input-method)) - (when timer (cancel-timer timer) (setq timer nil))))))))) - -(defun helm-toggle-suspend-update () - "Enable or disable display update in helm. -This can be useful for example for quietly writing a complex -regexp without Helm constantly updating." - (interactive) - (helm-suspend-update (not helm-suspend-update-flag) t) - (setq helm--suspend-update-interactive-flag - (not helm--suspend-update-interactive-flag))) -(put 'helm-toggle-suspend-update 'helm-only t) - -(defun helm-suspend-update (arg &optional verbose) - "Enable or disable display update in helm. -If ARG is 1 or non nil suspend update, if it is -1 or nil reenable -updating. When VERBOSE is specified display a message." - (with-helm-buffer - (when (setq helm-suspend-update-flag - (helm-acase arg - (1 t) - (-1 nil) - (t it))) - (helm-kill-async-processes) - (setq helm-pattern "")) - (when verbose - (message (if helm-suspend-update-flag - "Helm update suspended!" - "Helm update re-enabled!"))) - (helm-aif (helm-get-current-source) - (helm-display-mode-line it t)))) - -(defun helm-delete-backward-no-update (arg) - "Disable update and delete ARG chars backward. -Update is reenabled when idle 1s." - (interactive "p") - (with-helm-alive-p - (unless helm--suspend-update-interactive-flag - (helm-suspend-update 1)) - (delete-char (- arg)) - (run-with-idle-timer - 1 nil - (lambda () - (unless helm--suspend-update-interactive-flag - (helm-suspend-update -1) - (helm-check-minibuffer-input) - (helm-force-update)))))) -(put 'helm-delete-backward-no-update 'helm-only t) - -(defun helm-delete-char-backward (arg) - "Delete char backward and update when reaching prompt." - (interactive "p") - (condition-case _err - (cond ((and (use-region-p) - delete-active-region - (= arg 1)) - ;; If a region is active, kill or delete it. - (if (eq delete-active-region 'kill) - (kill-region (region-beginning) (region-end) 'region) - (delete-region (region-beginning) (region-end)))) - (t (delete-char (- arg)))) - (buffer-read-only - (progn - (helm-update) - (helm-reset-yank-point))))) -(put 'helm-delete-char-backward 'helm-only t) - -(defun helm--suspend-read-passwd (old--fn &rest args) - "Suspend Helm while reading password. -This is used to advice `tramp-read-passwd', `ange-ftp-get-passwd' -and `epa-passphrase-callback-function'." - ;; Suspend update when prompting for a tramp password. - (setq helm-suspend-update-flag t) - (setq overriding-terminal-local-map nil) - (setq helm--reading-passwd-or-string t) - (unwind-protect - ;; No need to suspend timer in emacs-24.4 - ;; it is fixed upstream. - (apply old--fn args) - (setq helm--reading-passwd-or-string nil) - (setq helm-suspend-update-flag nil))) - -(defun helm--maybe-update-keymap (&optional map) - "Handle different keymaps in multiples sources. - -Overrides `helm-map' with the local map of current source. If no -map is found in current source, does nothing (keeps previous -map)." - (with-helm-buffer - (helm-aif (or map (assoc-default 'keymap (helm-get-current-source))) - ;; We used a timer in the past to leave - ;; enough time to helm to setup its keymap - ;; when changing source from a recursive minibuffer. - ;; e.g C-x C-f M-y C-g - ;; => *find-files have now the bindings of *kill-ring. - ;; It is no more true now we are using `minor-mode-overriding-map-alist' - ;; and `helm--minor-mode' thus it fix Bug#1076 for emacs-24.3 - ;; where concurrent timers are not supported. - ;; i.e update keymap+check input. - (with-current-buffer (window-buffer (minibuffer-window)) - (setq minor-mode-overriding-map-alist `((helm--minor-mode . ,it))))))) - -;;; Prevent loosing focus when using mouse. -;; -(defvar helm--remap-mouse-mode-map - (let ((map (make-sparse-keymap))) - (cl-loop for k in '([mouse-1] [mouse-2] [mouse-3] - [down-mouse-1] [down-mouse-2] [down-mouse-3] - [drag-mouse-1] [drag-mouse-2] [drag-mouse-3] - [double-mouse-1] [double-mouse-2] [double-mouse-3] - [triple-mouse-1] [triple-mouse-2] [triple-mouse-3]) - do (define-key map k 'ignore)) - map)) - -(define-minor-mode helm--remap-mouse-mode - "[INTERNAL] Prevent escaping helm minibuffer with mouse clicks. -Do nothing when used outside of helm context. - -WARNING: Do not use this mode yourself, it is internal to Helm." - :group 'helm - :global t - :keymap helm--remap-mouse-mode-map - (unless helm-alive-p - (setq helm--remap-mouse-mode-map nil))) -(put 'helm--remap-mouse-mode 'helm-only t) - -;; Clean up - -(defun helm-cleanup () - "Clean up the mess when Helm exit or quit." - (helm-log "helm-cleanup" "start cleanup") - (with-selected-window - ;; When exiting with `helm-execute-action-at-once-if-one', - ;; `helm-window' may not be created and we endup with an error - ;; e.g. in eshell completion when only one candidate to complete - ;; so fallback to selected-window in such cases. - (or (get-buffer-window helm-buffer) - (selected-window)) - (let ((frame (helm--frame))) - (setq cursor-type (default-value 'cursor-type)) - ;; Ensure restoring default-value of mode-line to allow user - ;; using the mouse when helm is inactive (Bug#1517,Bug#2377). - (setq mode-line-format (default-value 'mode-line-format)) - (remove-hook 'post-command-hook 'helm--maybe-update-keymap) - (remove-hook 'post-command-hook 'helm--update-header-line) - (helm-display-line-numbers-mode -1) - ;; Be sure we call cleanup functions from helm-buffer. - (helm-compute-attr-in-sources 'cleanup) - ;; Delete or make invisible helm frame. - (if (and helm--buffer-in-new-frame-p - ;; a helm session running in a frame that runs a nested - ;; session share the same frame for both sessions so - ;; don't delete the common frame. - ;; i.e. helm--nested == t => delete - ;; helm--nested == nil => delete - ;; helm--nested == share => don't delete - (not (eq helm--nested 'share)) - ;; Do not delete inadvertently the main frame, this may happen - ;; when hitting quickly twice the same command - ;; e.g. completion-at-point. Should not happen now we use - ;; `helm--frame'. - (not (eql frame helm-initial-frame))) - (progn - (setq-local helm--last-frame-parameters - (helm--get-frame-parameters)) - (bury-buffer) - (if helm-display-buffer-reuse-frame - (make-frame-invisible frame) (delete-frame frame))) - ;; bury-buffer from this window [1]. - ;; Do it at end to make sure buffer is still current. - (bury-buffer)))) - (helm-kill-async-processes) - ;; Remove the temporary hooks added - ;; by `with-helm-temp-hook' that - ;; may not have been consumed. - (when helm--temp-hooks - (cl-loop for (fn . hook) in helm--temp-hooks - do (remove-hook hook fn)) - (setq helm--temp-hooks nil)) - ;; When running helm from a dedicated frame - ;; with no minibuffer, helm will run in the main frame - ;; which have a minibuffer, so be sure to disable - ;; the `no-other-window' prop there. - (helm-prevent-switching-other-window :enabled nil) - (helm-log-run-hook "helm-cleanup" 'helm-cleanup-hook) - (helm-frame-or-window-configuration 'restore) - ;; [1] now bury-buffer from underlying windows otherwise, - ;; if this window is killed the underlying buffer will - ;; be a helm buffer. - (replace-buffer-in-windows helm-buffer) - (setq helm-alive-p nil) - ;; Prevent error "No buffer named *helm*" triggered by - ;; `helm-set-local-variable'. - (setq helm--force-updating-p nil) - (setq helm--buffer-in-new-frame-p nil) - ;; No need to reinitialize helm-pattern here now it is done only - ;; once in init function bug#2530. - (setq helm-last-query helm-pattern) - ;; This is needed in some cases where last input - ;; is yielded infinitely in minibuffer after helm session. - (helm-clean-up-minibuffer)) - -(defun helm-clean-up-minibuffer () - "Remove contents of minibuffer." - (let ((miniwin (minibuffer-window))) - ;; Clean only current minibuffer used by helm. - ;; i.e The precedent one is active. - (unless (minibuffer-window-active-p miniwin) - (with-current-buffer (window-buffer miniwin) - (delete-minibuffer-contents))))) - - -;;; Input handling -;; -;; -(defun helm-check-minibuffer-input () - "Check minibuffer content." - (with-selected-window (or (active-minibuffer-window) - (minibuffer-window)) - (helm-check-new-input (minibuffer-contents)))) - -(defun helm-check-new-input (input) - "Check INPUT string and update the helm buffer if necessary." - (unless (equal input helm-pattern) - (setq helm-pattern input) - (unless (helm-action-window) - (setq helm-input helm-pattern)) - (helm-log "helm-check-new-input" "helm-pattern = %S" helm-pattern) - (helm-log "helm-check-new-input" "helm-input = %S" helm-input) - (helm-log-run-hook "helm-check-new-input" 'helm-before-update-hook) - (setq helm--in-update t) - (helm-update))) - -(defun helm--reset-update-flag () - (run-with-idle-timer - helm-exit-idle-delay nil - (lambda () (setq helm--in-update nil)))) - -;; (add-hook 'helm-after-update-hook #'helm--reset-update-flag) - - -;; All candidates - -(defun helm-get-candidates (source) - "Retrieve and return the list of candidates from SOURCE." - (let* ((candidate-fn (assoc-default 'candidates source)) - (candidate-proc (assoc-default 'candidates-process source)) - ;; See comment in helm-get-cached-candidates (Bug#2113). - (inhibit-quit candidate-proc) - cfn-error - (notify-error - (lambda (&optional e) - (error - "In `%s' source: `%s' %s %s" - (assoc-default 'name source) - (or candidate-fn candidate-proc) - (if e "\n" "must be a list, a symbol bound to a list, or a function returning a list") - (if e (prin1-to-string e) "")))) - (candidates (condition-case-unless-debug err - ;; Process candidates-(process) function - ;; It may return a process or a list of candidates. - (if candidate-proc - ;; Calling `helm-interpret-value' with no - ;; SOURCE arg force the use of `funcall' - ;; and not `helm-apply-functions-from-source'. - (helm-interpret-value candidate-proc) - (helm-interpret-value candidate-fn source)) - (error (helm-log "helm-get-candidates" - "Error: %S" (setq cfn-error err)) - nil)))) - (cond ((and (processp candidates) (not candidate-proc)) - (warn "Candidates function `%s' should be called in a `candidates-process' attribute" - candidate-fn)) - ((and candidate-proc (not (processp candidates))) - (error "Candidates function `%s' should run a process" candidate-proc))) - (cond ((processp candidates) - ;; Candidates will be filtered later in process filter. - candidates) - ;; An error occured in candidates function. - (cfn-error (unless helm--ignore-errors - (funcall notify-error cfn-error))) - ;; Candidates function returns no candidates. - ((or (null candidates) - ;; Can happen when the output of a process - ;; is empty, and the candidates function call - ;; something like (split-string (buffer-string) "\n") - ;; which result in a list of one empty string (Bug#938). - ;; e.g (completing-read "test: " '("")) - (equal candidates '(""))) - nil) - ((listp candidates) - ;; Transform candidates with `candidate-transformer' functions or - ;; `real-to-display' functions if those are found, - ;; otherwise return candidates unmodified. - ;; `filtered-candidate-transformer' is NOT called here. - (helm-transform-candidates candidates source)) - (t (funcall notify-error))))) - -(defun helm-get-cached-candidates (source) - "Return the cached value of candidates for SOURCE. -Cache the candidates if there is no cached value yet." - (let* ((name (assoc-default 'name source)) - (candidate-cache (gethash name helm-candidate-cache)) - ;; Bind inhibit-quit to ensure function terminate in case of - ;; quit from `helm-while-no-input' and processes are added to - ;; helm-async-processes for further deletion (Bug#2113). - ;; FIXME: Is this still needed now `helm-while-no-input' - ;; handles quit-flag? - (inhibit-quit (assoc-default 'candidates-process source))) - (helm-aif candidate-cache - (prog1 it (helm-log "helm-get-cached-candidates" - "Use cached candidates")) - (helm-log "helm-get-cached-candidates" - "No cached candidates, calculate candidates") - (let ((candidates (helm-get-candidates source))) - (cond ((processp candidates) - (push (cons candidates - (append source - (list (cons 'item-count 0) - (cons 'incomplete-line "")))) - helm-async-processes) - (set-process-filter candidates helm-default-output-filter) - (setq candidates nil)) - ((not (assq 'volatile source)) - (puthash name candidates helm-candidate-cache))) - candidates)))) - - -;;; Candidate transformers - -(defun helm-process-candidate-transformer (candidates source) - "Execute `candidate-transformer' function(s) on CANDIDATES in SOURCE." - (helm-aif (assoc-default 'candidate-transformer source) - (helm-apply-functions-from-source source it candidates) - candidates)) - -(defun helm-process-filtered-candidate-transformer (candidates source) - "Execute `filtered-candidate-transformer' function(s) on CANDIDATES in SOURCE." - (helm-aif (assoc-default 'filtered-candidate-transformer source) - (helm-apply-functions-from-source source it candidates source) - candidates)) - -(defun helm--maybe-process-filter-one-by-one-candidate (candidate source) - "Execute `filter-one-by-one' function(s) on real value of CANDIDATE in SOURCE. -Return CANDIDATE modified by the function(s)." - (helm-aif (assoc-default 'filter-one-by-one source) - (let ((real (if (consp candidate) (cdr candidate) candidate))) - (when real - (if (and (listp it) - (not (functionp it))) ;; Don't treat lambda's as list. - (cl-loop with cand = candidate - for f in it - do (setq cand (funcall f real)) - finally return cand) - (funcall it real)))) - candidate)) - -(defun helm--initialize-one-by-one-candidates (candidates source) - "Process CANDIDATES with the `filter-one-by-one' function in SOURCE. -Return CANDIDATES unchanged when pattern is not empty." - (helm-aif (and (string= helm-pattern "") - (assoc-default 'filter-one-by-one source)) - (cl-loop for cand in candidates collect - (helm--maybe-process-filter-one-by-one-candidate cand source)) - candidates)) - -(defun helm-process-filtered-candidate-transformer-maybe - (candidates source process-p) - "Execute `filtered-candidate-transformer' function(s) on CANDIDATES in SOURCE. -When PROCESS-P is non-nil execute -`filtered-candidate-transformer' functions if some, otherwise -return CANDIDATES." - (if process-p - ;; When no filter return CANDIDATES unmodified. - (helm-process-filtered-candidate-transformer candidates source) - candidates)) - -(defun helm-process-real-to-display (candidates source) - "Execute real-to-display function on all CANDIDATES of SOURCE." - (helm-aif (assoc-default 'real-to-display source) - (setq candidates (helm-apply-functions-from-source - source 'mapcar - (lambda (cand) - (if (consp cand) - ;; override DISPLAY from candidate-transformer - (cons (funcall it (cdr cand)) (cdr cand)) - (cons (funcall it cand) cand))) - candidates)) - candidates)) - -(defun helm-transform-candidates (candidates source &optional process-p) - "Transform CANDIDATES from SOURCE according to candidate transformers. - -When PROCESS-P is non-nil executes the -`filtered-candidate-transformer' functions, otherwise processes -`candidate-transformer' functions only, -`filtered-candidate-transformer' functions being processed later, -after the candidates have been narrowed by -`helm-candidate-number-limit', see `helm-compute-matches'. When -`real-to-display' attribute is present, execute its functions on all -maybe filtered CANDIDATES." - (helm-process-real-to-display - (helm-process-filtered-candidate-transformer-maybe - (helm-process-candidate-transformer - candidates source) - source process-p) - source)) - - -;; Narrowing candidates -(defun helm-candidate-number-limit (source) - "Apply candidate-number-limit attribute value. -This overrides `helm-candidate-number-limit' variable. - -E.g.: -If (candidate-number-limit) is in SOURCE, show all candidates in SOURCE. -If (candidate-number-limit . 123) is in SOURCE limit candidate to 123." - (helm-aif (assq 'candidate-number-limit source) - ;; When assoc value is nil use by default 99999999 otherwise use - ;; the assoc value, when it is a symbol interpret its value (bug#1831). - (or (helm-aand (cdr it) (helm-interpret-value it)) 99999999) - (or helm-candidate-number-limit 99999999))) - -(defun helm-candidate-get-display (candidate) - "Get searched display part from CANDIDATE. -CANDIDATE is either a string, a symbol, or a (DISPLAY . REAL) -cons cell." - (helm-acase candidate - ((dst* (disp . real)) disp) - ((guard* (symbolp candidate)) - (symbol-name candidate)) - ((guard* (numberp candidate)) - (number-to-string candidate)) - (t candidate))) - -(defun helm-process-pattern-transformer (pattern source) - "Execute pattern-transformer attribute function(s) on PATTERN in SOURCE." - (helm-aif (assoc-default 'pattern-transformer source) - (helm-apply-functions-from-source source it pattern) - pattern)) - -(defun helm-default-match-function (candidate) - "Check if `helm-pattern' match CANDIDATE. -Default function to match candidates according to `helm-pattern'." - (string-match helm-pattern candidate)) - - -;;; Fuzzy matching -;; -;; -(defvar helm--fuzzy-regexp-cache (make-hash-table :test 'eq)) -(defun helm--fuzzy-match-maybe-set-pattern () - ;; Computing helm-pattern with helm--mapconcat-pattern - ;; is costly, so cache it once time for all and reuse it - ;; until pattern change. - (when helm--in-fuzzy - (let ((fun (if (string-match "\\`\\^" helm-pattern) - #'identity - #'helm--mapconcat-pattern))) - (clrhash helm--fuzzy-regexp-cache) - ;; 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 "\\`!" helm-pattern) - (puthash 'helm-pattern - (if (> (length helm-pattern) 1) - (list (regexp-quote (substring helm-pattern 1 2)) - (funcall fun (substring helm-pattern 1))) - '("" "")) - helm--fuzzy-regexp-cache) - (puthash 'helm-pattern - (if (> (length helm-pattern) 0) - (list (regexp-quote (substring helm-pattern 0 1)) - (funcall fun helm-pattern)) - '("" "")) - helm--fuzzy-regexp-cache))))) - -(defun helm-fuzzy-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 (cadr (gethash 'helm-pattern helm--fuzzy-regexp-cache)))) - (if (string-match "\\`!" helm-pattern) - (not (string-match regexp candidate)) - (string-match regexp candidate))))) - -(defun helm-fuzzy-search (pattern) - "Same as `helm-fuzzy-match' but for sources built with -`helm-source-in-buffer'." - (unless (string-match " " helm-pattern) - ;; Same as in `helm-fuzzy-match' ref[1]. - (let* ((regexps (gethash 'helm-pattern helm--fuzzy-regexp-cache)) - (partial-regexp (car regexps)) - (regexp (cadr regexps))) - (if (string-match "\\`!" pattern) - ;; Don't try to search here, just return - ;; the position of line and go ahead, - ;; letting `helm-search-match-part' checking if - ;; pattern match against this line. - (prog1 (list (pos-bol) (pos-eol)) - (forward-line 1)) - ;; We could use here directly `re-search-forward' - ;; on the regexp produced by `helm--mapconcat-pattern', - ;; but it is very slow because emacs have to do an incredible - ;; amount of loops to match e.g "[^f]*f[^o]*o..." in the whole buffer, - ;; more the regexp is long more the amount of loops grow. - ;; (Probably leading to a max-lisp-eval-depth error if both - ;; regexp and buffer are too big) - ;; So just search the first bit of pattern e.g "[^f]*f", and - ;; then search the corresponding line with the whole regexp, - ;; which increase dramatically the speed of the search. - (cl-loop while (re-search-forward partial-regexp nil t) - for bol = (pos-bol) - for eol = (pos-eol) - if (progn (goto-char bol) - (re-search-forward regexp eol t)) - do (goto-char eol) and return t - else do (goto-char eol) - finally return nil))))) - -(defvar helm-fuzzy-default-score-fn #'helm-fuzzy-flex-style-score) -(defun helm-score-candidate-for-pattern (candidate pattern) - "Assign score to CANDIDATE according to PATTERN." - ;; Unknown candidates always go on top. - (if (helm-candidate-prefixed-p candidate) - 200.00 - (funcall helm-fuzzy-default-score-fn candidate pattern))) - -;; The flex scoring needs a regexp whereas the fuzzy scoring works -;; directly with helm-pattern, so cache the needed regexp for flex -;; scoring to not (re)compute it at each candidate. We could reuse -;; the regexp cached in `helm--fuzzy-regexp-cache' but it is not -;; exactly the same as the one needed for flex and also it is always -;; computed against the whole helm-pattern which is not usable for -;; e.g. file completion. -(defvar helm--fuzzy-flex-regexp-cache (make-hash-table :test 'equal)) -(defun helm-fuzzy-flex-style-score (candidate pattern) - "Give a score to CANDIDATE according to PATTERN. -A regexp is generated from PATTERN to calculate score. -Score is calculated with the emacs-27 flex algorithm using -`helm-flex--style-score'." - (let ((regexp (helm-aif (gethash pattern helm--fuzzy-flex-regexp-cache) - it - (clrhash helm--fuzzy-flex-regexp-cache) - (puthash pattern (helm--fuzzy-flex-pattern-to-regexp pattern) - helm--fuzzy-flex-regexp-cache)))) - (helm-flex--style-score candidate regexp t))) - -(defun helm--fuzzy-flex-pattern-to-regexp (pattern) - "Return a regexp from PATTERN compatible with emacs-27 flex algorithm." - (completion-pcm--pattern->regex - (helm-completion--flex-transform-pattern (list pattern)) 'group)) - -(defun helm-flex-add-score-as-prop (candidates regexp) - (cl-loop with case-fold-search = (helm-set-case-fold-search) - for cand in candidates - collect (helm-flex--style-score cand regexp))) - -(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))) - -(defun helm-fuzzy-helm-style-score (candidate pattern) - "Give a score to CANDIDATE according to PATTERN. -Score is calculated for contiguous matches found with PATTERN. -Score is 100 (maximum) if PATTERN is fully matched in CANDIDATE. -One point bonus is added to score when PATTERN prefix matches -CANDIDATE. Contiguous matches get a coefficient of 2." - (let* ((cand (if (stringp candidate) - 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))) - 2) - ((and (null pat-lookup) ; length = 1 - (string= pattern (substring cand 0 1))) - 150) - (t 0))) - ;; Exact match e.g. foo -> foo == 200 - (bonus1 (and (string= cand pattern) 200)) - ;; Partial match e.g. foo -> aafooaa == 100 - ;; or foo -> fooaaa - (bonus2 (and (or (string-match - (concat "\\`" (regexp-quote pattern)) - cand) - (string-match - (concat "\\<" (regexp-quote pattern) "\\>") - cand)) - 100))) - (+ bonus - (or bonus1 bonus2 - ;; Give a coefficient of 2 for contiguous matches. - ;; That's mean that "wiaaaki" will not take precedence - ;; on "aaawiki" when matching on "wiki" even if "wiaaaki" - ;; starts by "wi". - (* (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. -It sorts on the display part by default. - -It sorts CANDIDATES by their scores as calculated by -`helm-score-candidate-for-pattern'. Set USE-REAL to non-nil to -sort on the real part. If BASENAME is non-nil assume we are -completing filenames and sort on basename of candidates. If -PRESERVE-TIE-ORDER is nil, ties in scores are sorted by length of -the candidates." - (if (string= helm-pattern "") - candidates - (let ((table-scr (make-hash-table :test 'equal))) - (sort candidates - (lambda (s1 s2) - ;; Score and measure the length on real or display part of candidate - ;; according to `use-real'. - (let* ((real-or-disp-fn (if use-real #'cdr #'car)) - (cand1 (cond ((and basename (consp s1)) - (helm-basename (funcall real-or-disp-fn s1))) - ((consp s1) (funcall real-or-disp-fn s1)) - (basename (helm-basename s1)) - (t s1))) - (cand2 (cond ((and basename (consp s2)) - (helm-basename (funcall real-or-disp-fn s2))) - ((consp s2) (funcall real-or-disp-fn s2)) - (basename (helm-basename s2)) - (t s2))) - (data1 (or (gethash cand1 table-scr) - (puthash cand1 - (list (helm-score-candidate-for-pattern - cand1 helm-pattern) - (length (helm-stringify cand1))) - table-scr))) - (data2 (or (gethash cand2 table-scr) - (puthash cand2 - (list (helm-score-candidate-for-pattern - cand2 helm-pattern) - (length (helm-stringify cand2))) - table-scr))) - (len1 (cadr data1)) - (len2 (cadr data2)) - (scr1 (car data1)) - (scr2 (car data2))) - (cond ((= scr1 scr2) - ;; Comparison by length should not be called here most of - ;; the time because we use now flex scoring which does - ;; such test, however we still use helm fuzzy scoring - ;; with preserve-tie-order, so keep testing length here - ;; for it. - (unless preserve-tie-order - (< len1 len2))) - ((> scr1 scr2))))))))) - -(defun helm-fuzzy-matching-default-sort-fn (candidates _source) - "Default `filtered-candidate-transformer' to sort in fuzzy matching." - (helm-fuzzy-matching-default-sort-fn-1 candidates)) - -(defun helm-fuzzy-matching-sort-fn-preserve-ties-order (candidates _source) - "Same as `helm-fuzzy-matching-default-sort-fn' but preserving order of ties. -The default function, `helm-fuzzy-matching-default-sort-fn', -sorts ties by length, shortest first. This function may be more -useful when the order of the candidates is meaningful, e.g. with -`recentf-list'." - ;; Flex scoring is already taking in account length of strings so this - ;; function have no effect when flex scoring is in use, force the usage of - ;; helm fuzzy scoring to ensure no testing against length is done. - (let ((helm-fuzzy-default-score-fn #'helm-fuzzy-helm-style-score)) - (helm-fuzzy-matching-default-sort-fn-1 candidates nil nil t))) - -(defun helm--maybe-get-migemo-pattern (pattern &optional diacritics) - (or (and helm-migemo-mode - (assoc-default pattern helm-mm--previous-migemo-info)) - (if diacritics - (char-fold-to-regexp pattern) - pattern))) - -(defun helm-fuzzy-default-highlight-match-1 (candidate &optional pattern diacritics file-comp) - (let* ((pair (and (consp candidate) candidate)) - (display (helm-stringify (if pair (car pair) candidate))) - (real (cdr pair)) - (host (and file-comp (get-text-property - (max 0 (1- (length display))) 'host display))) - (regex (helm--maybe-get-migemo-pattern pattern diacritics)) - ;; Match prop at end, because at 0 we might have an icon. - (mpart (get-text-property (1- (length display)) 'match-part display)) - (mp (cond ((and mpart (string= display mpart)) nil) - (mpart) - ;; FIXME: This may be wrong when match-on-real - ;; is nil, so we should flag match-on-real on - ;; top and use it. - (file-comp (file-name-nondirectory - (or host (and (stringp real) real) display))))) - (count 0) - beg-str end-str) - ;; Happens when matching empty lines (^$), in this case there is nothing to - ;; highlight. - (if (string= mpart "") - candidate - (when host (setq pattern (cadr (split-string pattern ":")))) - ;; Extract all parts of display keeping original properties. - (when (and mp (ignore-errors - ;; Avoid error when candidate is a huge line. - (string-match (regexp-quote mp) display))) - (setq beg-str (substring display 0 (match-beginning 0)) - end-str (substring display (match-end 0) (length display)) - mp (substring display (match-beginning 0) (match-end 0)))) - (with-temp-buffer - ;; Insert the whole display part and remove non--match-part - ;; to keep their original face properties. - (insert (propertize (or mp display) 'read-only nil)) ; Fix (bug#1176) - (goto-char (point-min)) - (condition-case nil - (progn - ;; Try first matching against whole pattern. - (unless (string= pattern "") - (while (helm-re-search-forward regex nil t) - (cl-incf count) - (helm-add-face-text-properties - (match-beginning 0) (match-end 0) 'helm-match))) - ;; If no matches start matching against multiples or fuzzy matches. - (when (zerop count) - (cl-loop with multi-match = (string-match-p " " pattern) - with patterns = (if multi-match - (cl-loop for pat in (helm-mm-split-pattern - pattern) - collect - (helm--maybe-get-migemo-pattern - pat diacritics)) - (helm-acase (split-string pattern "" t) - ((guard* (string= "!" (car it))) nil) - (t it))) - for p in patterns - ;; Multi matches (regexps patterns). - if multi-match do - (progn - (while (helm-re-search-forward p nil t) - (helm-add-face-text-properties - (match-beginning 0) (match-end 0) 'helm-match)) - (goto-char (point-min))) - ;; Fuzzy matches (literal patterns). - else do - (when (search-forward p nil t) - (helm-add-face-text-properties - (match-beginning 0) (match-end 0) - 'helm-match))))) - (invalid-regexp nil)) - ;; Now replace the original match-part with the part - ;; with face properties added. - (setq display (if mp (concat beg-str (buffer-string) end-str) (buffer-string)))) - (if real (cons display real) display)))) - -(defun helm-fuzzy-default-highlight-match (candidate &optional pattern diacritics file-comp) - "The default function to highlight matches in fuzzy matching. -Highlight elements in CANDIDATE matching PATTERN according -to the matching method in use. When DIACRITICS is specified, ignore -diacritics, see `char-fold-to-regexp' for more infos." - (unless pattern (setq pattern helm-pattern)) - (if (string= pattern "") - ;; Empty pattern, do nothing. This is needed when this function - ;; is used outside of helm-fuzzy-highlight-matches like in *buffers-list. - candidate - ;; Else start highlighting. - (helm-fuzzy-default-highlight-match-1 candidate pattern diacritics file-comp))) - -(defun helm-fuzzy-highlight-matches (candidates source) - "Highlight matches in CANDIDATES for SOURCE. -The filtered-candidate-transformer function to highlight fuzzy matches. -See `helm-fuzzy-default-highlight-match'." - (cl-assert helm-fuzzy-matching-highlight-fn nil "Wrong type argument functionp: nil") - (cl-loop with diac = (helm-get-attr 'diacritics source) - with file-comp-p = (and (not (helm-action-window)) - (or minibuffer-completing-file-name - helm--minibuffer-completing-file-name - (helm-get-attr 'completing-file-name source))) - ;; helm-pattern may have been modified (fuzzy) so ensure to - ;; use helm-input which is the raw pattern. - with pattern = (if file-comp-p - (file-name-nondirectory helm-input) - helm-pattern) - when (string= pattern "") return candidates - for c in candidates - collect (funcall helm-fuzzy-matching-highlight-fn c pattern diac file-comp-p))) - - -;;; helm-flex style -;; -;; Provide the emacs-27 flex style for emacs<27. -;; Reuse the flex scoring algorithm of flex style in emacs-27. -(defun helm-flex--style-score (str regexp &optional score) - "Score STR candidate according to REGEXP. - -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 may be build with -`helm-completion--flex-transform-pattern' function, and the regexp -with `completion-pcm--pattern->regex'. For commodity, -`helm--fuzzy-flex-pattern-to-regexp' is used to build such regexp. - -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)) - (if (string-match 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))) - result) - (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)) - (setq result (/ score-numerator (* len (1+ score-denominator)) 1.0)) - (put-text-property 0 1 'completion-score result str)) - (if (and score result) result str)) - (put-text-property 0 1 'completion-score 0.0 str) - (if score 0.0 str))) - - -;;; Matching candidates -;; -;; -(defun helm-match-functions (source) - (let ((matchfns (or (assoc-default 'match source) - (assoc-default 'match-strict source) - #'helm-default-match-function))) - (if (and (listp matchfns) (not (functionp matchfns))) - matchfns (list matchfns)))) - -(defun helm-search-functions (source) - (let ((searchfns (assoc-default 'search source))) - (if (and (listp searchfns) (not (functionp searchfns))) - searchfns (list searchfns)))) - -(defun helm-match-from-candidates (cands matchfns match-part-fn limit source) - "Filter CANDS list in SOURCE with functions in MATCHFNS. -If MATCH-PART-FN is a valid function, use it to determine in each -candidate of CANDS the part of candidate we want to match on (see the -:match-part documentation in `helm-source'). When LIMIT in CANDS is -reached, stop and return the filtered list. This function is used only -by sync sources, i.e. sources built with `helm-source-sync', see -`helm-search-from-candidate-buffer' for `helm-source-in-buffer' sources -and `helm-output-filter' for async sources." - (when cands ; nil in async sources. - (condition-case-unless-debug err - (cl-loop with hash = (make-hash-table :test 'equal) - with allow-dups = (assq 'allow-dups source) - with case-fold-search = (helm-set-case-fold-search) - with count = 0 - for iter from 1 - for fn in matchfns - when (< count limit) nconc - (cl-loop for c in cands - for dup = (gethash c hash) - for disp = (helm-candidate-get-display c) - while (< count limit) - for target = (if (helm-get-attr 'match-on-real source) - ;; Let's fails on error in - ;; case next block returns nil. - (or (cdr-safe c) - (get-text-property 0 'helm-realvalue disp)) - disp) - for prop-part = (get-text-property 0 'match-part target) - for part = (and match-part-fn - (or prop-part - (funcall match-part-fn target))) - ;; When allowing dups check if DUP - ;; have been already found in previous loop - ;; by comparing its value with ITER. - when (and (or (and allow-dups dup (= dup iter)) - (null dup)) - (condition-case nil - (funcall fn (or part target)) - (invalid-regexp nil))) - do - (progn - ;; Give as value the iteration number of - ;; inner loop to be able to check if - ;; the duplicate have not been found in previous loop. - (puthash c iter hash) - (setq c (helm--maybe-process-filter-one-by-one-candidate c source)) - (cl-incf count)) - ;; Filter out nil candidates maybe returned by - ;; `helm--maybe-process-filter-one-by-one-candidate'. - and when c collect - (if (and part (not prop-part)) - (if (consp c) - (cons (propertize target 'match-part part) (cdr c)) - (propertize c 'match-part part)) - c))) - (error (unless (eq (car err) 'invalid-regexp) ; Always ignore regexps errors. - (helm-log-error "helm-match-from-candidates" - "helm-match-from-candidates in source `%s': %s %s" - (assoc-default 'name source) (car err) (cdr err))) - nil)))) - -(defun helm-compute-matches (source) - "Start computing candidates in SOURCE." - (save-current-buffer - (let ((matchfns (helm-match-functions source)) - (matchpartfn (assoc-default 'match-part source)) - (helm--source-name (assoc-default 'name source)) - (helm-current-source source) - (limit (helm-candidate-number-limit source)) - (helm-pattern (helm-process-pattern-transformer - helm-pattern source))) - (helm--fuzzy-match-maybe-set-pattern) - ;; If source have a `filtered-candidate-transformer' attr - ;; Filter candidates with this func, otherwise just compute - ;; candidates. - ;; NOTE that this next block of code is returning nil on async sources, - ;; the candidates being processed directly in `helm-output-filter' - ;; process-filter. - (helm-process-filtered-candidate-transformer - ;; When using in-buffer method or helm-pattern is empty or - ;; using dynamic completion always compute all candidates. - (if (or (equal helm-pattern "") - (assq 'match-dynamic source) - (helm--candidates-in-buffer-p source)) - ;; Compute all candidates up to LIMIT. - ;; one-by-one are computed here only for sources that - ;; display a list of candidates even with an empty - ;; pattern. - (helm--initialize-one-by-one-candidates - (helm-take (helm-get-cached-candidates source) limit) - source) - ;; Compute candidates according to pattern with their match - ;; fns. - ;; one-by-one filtered candidates are computed during the - ;; execution of next loop in `helm-match-from-candidates'. - (helm-match-from-candidates - (helm-get-cached-candidates source) matchfns matchpartfn limit source)) - source)))) - -(defun helm--candidates-in-buffer-p (source) - (assq 'search source)) - -(defun helm-render-source (source matches) - "Display MATCHES from SOURCE according to its settings." - (when matches - (helm-insert-header-from-source source) - (let ((start (point)) - (multiline (assq 'multiline source)) - (count 1) - separate) - (dolist (m matches) - (when multiline - (if separate - (helm-insert-candidate-separator) - (setq separate t))) - (helm-insert-match m 'insert count source) - (cl-incf count)) - (when multiline - (put-text-property start (point) 'helm-multiline t))))) - -(defmacro helm-while-no-input (&rest body) - "Same as `while-no-input' but returns either BODY or nil. -Unlike `while-no-input' this macro ensure to not returns `t'." - (declare (debug t) (indent 0)) - (let ((catch-sym (make-symbol "input"))) - `(with-local-quit - (catch ',catch-sym - (let ((throw-on-input ',catch-sym) - val) - (setq val (progn ,@body)) - ;; See comments in `while-no-input' about resetting - ;; quit-flag. - (cond ((eq quit-flag throw-on-input) - (setq quit-flag nil)) - (quit-flag nil) - (t val))))))) - -(defmacro helm--maybe-use-while-no-input (&rest body) - "Wrap BODY in `helm-while-no-input' unless initializing a remote connection." - `(progn - ;; Tramp would ask for passwd, so don't use `helm-while-no-input' until - ;; connected to remote. - (if (or (and (file-remote-p helm-pattern) - (not (file-remote-p helm-pattern nil t))) - helm-update-edebug - ;; Don't use while-no-input on initial helm-update before minibuffer - ;; is not ready (Issue #2729), this happen in - ;; `helm-read-from-minibuffer'. - (not (helm-active-minibuffer-window))) - ,@body - (helm-log "helm--maybe-use-while-no-input" - "Using here `helm-while-no-input'") - ;; Emacs bug , unexpected - ;; dbus-event is triggered on dbus init. - ;; Ignoring the dbus-event work on emacs28+; for emacs27 or older - ;; version, require tramp-archive can workaround the issue. - (let ((while-no-input-ignore-events - (and (boundp 'while-no-input-ignore-events) - (cons 'dbus-event while-no-input-ignore-events)))) - (helm-while-no-input ,@body))))) - -(defun helm-active-minibuffer-window () - "Check if helm-window has an active minibuffer." - (and (helm-window) (minibuffer-window-active-p (minibuffer-window)))) - -(defun helm--collect-matches (src-list) - "Return a list of matches for each source in SRC-LIST. - -The resulting value is a list of lists, e.g. ((a b c) (c d) (e -f)) or (nil nil nil) for three sources when no matches found, -however this function can be interrupted by new input and in this -case returns a plain nil i.e. not (nil), in this case -`helm-update' is not rendering the source, keeping previous -candidates in display." - (let ((matches (helm--maybe-use-while-no-input - (cl-loop for src in src-list - collect (helm-compute-matches src))))) - (unless (eq matches t) matches))) - - -;;; Case fold search -;; -;; -(defun helm-set-case-fold-search (&optional pattern) - "Used to set the value of `case-fold-search' in Helm. -Return t or nil depending on the value of `helm-case-fold-search' -and `helm-pattern'." - (unless pattern (setq pattern helm-pattern)) - (if helm-alive-p - (let ((helm-case-fold-search - (helm-aif (assq 'case-fold-search (helm-get-current-source)) - (cdr it) - helm-case-fold-search)) - ;; Only parse basename for filenames - ;; to avoid setting case sensitivity - ;; when expanded directories contains upcase - ;; characters. - (bn-or-pattern (if (string-match "[~/]*" pattern) - (helm-basename pattern) - pattern))) - (helm-set-case-fold-search-1 bn-or-pattern)) - case-fold-search)) - -(defun helm-set-case-fold-search-1 (pattern) - (cl-case helm-case-fold-search - (smart (let ((case-fold-search nil)) - (if (string-match "[[:upper:]]" pattern) nil t))) - (t helm-case-fold-search))) - - -;;; Helm update -;; -(defun helm-update (&optional preselect source candidates) - "Update candidates list in `helm-buffer' based on `helm-pattern'. -Argument PRESELECT is a string or regexp used to move selection -to a particular place after finishing update. -When SOURCE is provided update mode-line for this source, otherwise -the current source will be used. -Argument CANDIDATES when provided is used to redisplay these candidates -without recomputing them, it should be a list of lists." - (helm-log "helm-update" "Start updating") - (helm-kill-async-processes) - ;; When persistent action have been called - ;; we have two windows even with `helm-full-frame'. - ;; So go back to one window when updating if `helm-full-frame' - ;; is non-`nil'. - (when (with-helm-buffer - (and helm-onewindow-p - ;; We are not displaying helm-buffer in a frame and - ;; helm-window is already displayed. - (not helm--buffer-in-new-frame-p) - (helm-window) - (not (helm-action-window)))) - (with-helm-window (delete-other-windows))) - (with-current-buffer (helm-buffer-get) - (set (make-local-variable 'helm-input-local) helm-pattern) - (let ((ov '(nil))) - (unwind-protect - (let (sources matches) - ;; Collect sources ready to be updated. - (setq sources - (cl-loop for src in helm-sources - when (helm-update-source-p src) - collect src)) - ;; When no sources to update erase buffer to avoid duplication of - ;; header and candidates when next chunk of update will arrive, - ;; otherwise the buffer is erased AFTER [1] the results are - ;; computed. This is also needed when pattern is quickly deleted - ;; backward and we reach requires-pattern limit, in this case the helm - ;; buffer is not updated and stays with the results of the last - ;; matching pattern. - (unless sources (erase-buffer)) - (helm-maybe-dim-prompt-on-update ov) - ;; Compute matches without rendering the sources. - ;; This prevent the helm-buffer flickering when constantly - ;; updating. - (setq matches (or candidates (helm--collect-matches sources))) - ;; If computing matches finished and is not interrupted - ;; erase the helm-buffer and render results (Fix bug#1157). - (when matches ;; nil only when interrupted by while-no-input. - (erase-buffer) - (cl-loop for src in sources - for mtc in matches - do (helm-render-source src mtc)) - ;; Move to first line only when there is matches - ;; to avoid cursor moving upside down (Bug#1703). - (helm--update-move-first-line))) - ;; When there is only one async source, update mode-line and run - ;; `helm-after-update-hook' in `helm-output-filter--post-process', - ;; when there is more than one source, update mode-line and run - ;; `helm-after-update-hook' now even if an async source is - ;; present and running in BG. - (let ((src (or source (helm-get-current-source)))) - (unless (assq 'candidates-process src) - (helm-display-mode-line src 'force) - (and (car ov) (delete-overlay (car ov))) - (helm-log-run-hook "helm-update" 'helm-after-update-hook))) - (when preselect - (helm-log "helm-update" "Update preselect candidate %s" preselect) - (if (helm-window) - (with-helm-window (helm-preselect preselect source)) - (helm-preselect preselect source))) - (setq helm--force-updating-p nil) - (helm--reset-update-flag)) - (helm-log "helm-update" "end update")))) - -(defun helm-maybe-dim-prompt-on-update (overlay) - "Make minibuffer foreground gray while updating. -Argument OVERLAY is a ref-cell." - (when (and helm-dim-prompt-on-update - ;; Avoid an empty window when coming from bookmarks. - (not (helm-empty-buffer-p)) - (consp overlay)) ;; Ensure OVERLAY is a ref-cell. - (with-selected-window (minibuffer-window) - (setcar overlay (make-overlay (minibuffer-prompt-end) (point-max))) - (overlay-put (car overlay) 'face 'helm-dim-prompt) - (redisplay)))) - -(defun helm-update-source-p (source) - "Whether SOURCE needs updating or not." - (let ((len (string-width - (if (assq 'multimatch source) - ;; Don't count spaces entered when using - ;; multi-match. - (replace-regexp-in-string " " "" helm-pattern) - helm-pattern)))) - (and (or (not helm-source-filter) - (member (assoc-default 'name source) helm-source-filter)) - (>= len - (helm-aif (assq 'requires-pattern source) (or (cdr it) 1) 0)) - ;; bugs were mentioned here before: Bug#1802, bug#2423 - ;; must be fixed already by 'helm-re-search-forward' - ;; - ;; short patterns that are alone not expected to return any results, - ;; ignore in order to not erase Helm buffer on such patterns. - (cl-loop for p in (helm-mm-split-pattern helm-pattern) - never (member p '("!" "!^" "?" "@!")))))) - -(defun helm--update-move-first-line () - "Goto first line of `helm-buffer'." - (goto-char (point-min)) - (if (helm-window) - (helm-move-selection-common :where 'line - :direction 'next - :follow t) - (forward-line 1) - (helm-mark-current-line) - ;; If we are here, it is because helm-window is not ready, if one of the - ;; functions in `helm-move-selection-after-hook' is called with - ;; `with-helm-window' (it shouldn't but never know) we will have an error. - (condition-case-unless-debug _err - (helm-log-run-hook "helm--update-move-first-line" - 'helm-move-selection-after-hook) - (error nil)) - (helm-follow-execute-persistent-action-maybe))) - -(cl-defun helm-force-update (&optional (preselect nil spreselect) (recenter t)) - "Force recalculation and update of candidates. - -Unlike `helm-update', this function re-evaluates `init' and -`update' attributes when present; also `helm-candidate-cache' is -not reinitialized, meaning candidates are not recomputed unless -pattern has changed. - -Selection is preserved to current candidate if it still exists after -update or moved to PRESELECT, if specified. If PRESELECT is specified with a -nil value no preselection at all is done. -The helm-window is re-centered at the end when RECENTER is t which -is the default. RECENTER can be also a number in this case it is -passed as argument to `recenter'." - (with-helm-buffer - (let* ((source (helm-get-current-source)) - (selection (helm-aif (helm-get-selection nil t source) - (regexp-quote it)))) - (setq helm--force-updating-p t) - (mapc 'helm-force-update--reinit helm-sources) - (helm-update (if spreselect preselect selection) source) - (when (and (helm-window) recenter) - (with-helm-window - (recenter (and (numberp recenter) recenter))))))) - -(defun helm-refresh () - "Force recalculation and update of candidates." - (interactive) - (with-helm-alive-p - (helm-force-update))) -(put 'helm-refresh 'helm-only t) - -(defun helm-force-update--reinit (source) - "Reinit SOURCE by calling its update and init functions." - ;; When using a specific buffer as cache, don't kill it. - (helm-aif (and (null (bufferp (assoc-default - (helm-get-attr 'name source) - helm--candidate-buffer-alist))) - (helm-apply-functions-from-source - source 'helm-candidate-buffer)) - (kill-buffer it)) - (dolist (attr '(update init)) - (helm-aif (assoc-default attr source) - (helm-apply-functions-from-source source it))) - (helm-remove-candidate-cache source)) - -(defun helm-redisplay-buffer () - "Redisplay candidates in `helm-buffer'. - -Candidates are not recomputed, only redisplayed after modifying -the whole list of candidates in each source with functions found -in `redisplay' attribute of current source. Note that candidates -are redisplayed with their display part with all properties -included only. This function is used in async sources to -transform the whole list of candidates from the sentinel -functions (i.e. when all candidates have been computed) because -other filters like `candidate-transformer' are modifying only -each chunk of candidates from `process-filter' as they come in -and not the whole list. Use this for e.g. sorting the whole list -of async candidates once computed. - -Note: To ensure redisplay is done in async sources after Helm -reached `candidate-number-limit' you will have also to redisplay -your candidates from `helm-async-outer-limit-hook'." - (with-helm-buffer - (let ((get-cands (lambda (source) - (let ((fns (assoc-default 'redisplay source)) - candidates - helm-move-to-line-cycle-in-source - helm-allow-mouse) - (helm-goto-source source) - (helm-next-line) - (helm-awhile (condition-case-unless-debug nil - (and (not (helm-pos-header-line-p)) - (helm-get-selection - nil 'withprop source)) - (error nil)) - (push it candidates) - (when (save-excursion - (forward-line 1) (helm-end-of-source-p t)) - (cl-return nil)) - (helm-next-line)) - (helm-apply-functions-from-source - source fns (nreverse candidates))))) - (get-sources (lambda () - (let (sources helm-move-to-line-cycle-in-source) - (helm-awhile (helm-get-current-source) - (push it sources) - (when (save-excursion - (helm-move--end-of-source) - (forward-line 1) (eobp)) - (cl-return nil)) - (helm-next-source)) - (nreverse sources))))) - (goto-char (point-min)) - (helm-update nil (helm-get-current-source) - (cl-loop with sources = (funcall get-sources) - for s in helm-sources - for name = (assoc-default 'name s) collect - (when (cl-loop for src in sources thereis - (string= name - (assoc-default 'name src))) - (funcall get-cands s))))))) - -(defun helm-remove-candidate-cache (source) - "Remove SOURCE from `helm-candidate-cache'." - (remhash (assoc-default 'name source) helm-candidate-cache)) - -(defvar helm-drag-mouse-1-fn 'ignore) -(defun helm-insert-match (match insert-function &optional num source) - "Insert MATCH into `helm-buffer' with INSERT-FUNCTION. -If MATCH is a cons cell then insert the car as display with the -cdr stored as real value in a `helm-realvalue' text property. -Args NUM and SOURCE are also stored as text property when -specified as respectively `helm-cand-num' and `helm-cur-source'." - (let ((start (pos-bol (point))) - (dispvalue (helm-candidate-get-display match)) - (realvalue (cdr-safe match)) - (map (when helm-allow-mouse (make-sparse-keymap))) - (inhibit-read-only t) - end) - (when (and (stringp dispvalue) - (not (zerop (length dispvalue)))) - (funcall insert-function dispvalue) - (setq end (pos-eol)) - ;; Some strings may handle another keymap prop. - (remove-text-properties start end '(keymap nil)) - (put-text-property start end 'read-only nil) - ;; Some sources with candidates-in-buffer have already added - ;; 'helm-realvalue property when creating candidate buffer. - (unless (get-text-property start 'helm-realvalue) - (and realvalue - (put-text-property start end - 'helm-realvalue realvalue))) - (when map - (define-key map [drag-mouse-1] 'ignore) - (define-key map [mouse-1] 'helm-mouse-select-candidate) - (define-key map [mouse-2] 'ignore) - (define-key map [mouse-3] 'helm-menu-select-action) - (add-text-properties - start end - `(mouse-face highlight - keymap ,map - ;; At 0 we might have an icon, so match at end. - help-echo ,(helm-acase (get-text-property (1- end) 'help-echo) - ((guard* (stringp it)) - (concat it "\nmouse-1: select candidate\nmouse-3: menu actions")) - (t "mouse-1: select candidate\nmouse-3: menu actions"))))) - (when num - (put-text-property start end 'helm-cand-num num)) - (when source - (put-text-property start end 'helm-cur-source source)) - (funcall insert-function "\n")))) - -(defun helm--mouse-reset-selection-help-echo () - (let* ((inhibit-read-only t) - (start (overlay-start helm-selection-overlay)) - (end (overlay-end helm-selection-overlay)) - (help-echo (get-text-property start 'help-echo))) - (when (and (stringp help-echo) - (string-match "mouse-2: execute action" help-echo)) - (put-text-property - start end - 'help-echo (replace-match "mouse-1: select candidate" - t t help-echo))))) - -(defun helm--bind-mouse-for-selection (pos) - (let ((inhibit-read-only t) - (map (get-text-property pos 'keymap))) - (when map - (define-key map [down-mouse-1] helm-drag-mouse-1-fn) - (define-key map [mouse-2] 'helm-maybe-exit-minibuffer) - (put-text-property - helm-selection-point - (overlay-end helm-selection-overlay) - 'help-echo (helm-aif (get-text-property pos 'help-echo) - (if (and (stringp it) - (string-match "mouse-1: select candidate" it)) - (replace-match "mouse-2: execute action" t t it) - "mouse-2: execute action\nmouse-3: menu actions") - "mouse-2: execute action\nmouse-3: menu actions"))))) - -(defun helm-mouse-select-candidate (event) - (interactive "e") - (let* ((window (posn-window (event-end event))) - (pos (posn-point (event-end event)))) - (unwind-protect - (with-current-buffer (window-buffer window) - (if (and (helm-action-window) - (eql window (get-buffer-window helm-buffer))) - (user-error "selection in helm-window not available while selecting action") - (helm--mouse-reset-selection-help-echo) - (goto-char pos) - (when (helm-pos-multiline-p) - (goto-char (or (helm-get-previous-candidate-separator-pos) - (helm-get-previous-header-pos))) - (forward-line 1))) - (helm-mark-current-line) - (when helm-popup-tip-mode - (helm-maybe-show-popup-tip-info)) - (helm-follow-execute-persistent-action-maybe)) - (select-window (minibuffer-window)) - (set-buffer (window-buffer window))))) -(put 'helm-mouse-select-candidate 'helm-only t) - -(defun helm-insert-header-from-source (source) - "Insert SOURCE name in `helm-buffer' header. -Maybe insert, by overlay, additional info after the source name -if SOURCE has header-name attribute." - (let ((name (assoc-default 'name source))) - (helm-insert-header - name - (helm-aif (assoc-default 'header-name source) - (helm-apply-functions-from-source source it name))))) - -(defun helm-insert-header (name &optional display-string) - "Insert header of source NAME into the helm buffer. -If DISPLAY-STRING is non-nil and a string value then display this -additional info after the source name by overlay." - (unless (bobp) - (let ((start (point))) - (insert (propertize "\n" 'face 'helm-eob-line)) - (put-text-property start (point) 'helm-header-separator t))) - (let ((start (point))) - (insert name) - (put-text-property (pos-bol) - (pos-eol) 'helm-header t) - (when display-string - (overlay-put (make-overlay (pos-bol) (pos-eol)) - 'display display-string)) - (insert "\n") - (add-text-properties start (point) '(face helm-source-header - ;; Disable line numbers on - ;; source headers. - display-line-numbers-disable t)))) - -(defun helm-insert-candidate-separator () - "Insert separator of candidates into the Helm buffer." - (insert (propertize helm-candidate-separator 'face 'helm-separator)) - (put-text-property (pos-bol) - (pos-eol) 'helm-candidate-separator t) - (insert "\n")) - -(defun helm-init-relative-display-line-numbers () - "Enable `display-line-numbers' for Helm buffers. -This is intended to be added to `helm-after-initialize-hook'. -This will work only in Emacs-26+, i.e. Emacs versions that have -`display-line-numbers-mode'." - (when (boundp 'display-line-numbers) - (with-helm-buffer - (setq display-line-numbers 'relative)))) - -(define-minor-mode helm-display-line-numbers-mode - "Toggle display of line numbers in current Helm buffer." - :group 'helm - (with-helm-alive-p - (cl-assert (boundp 'display-line-numbers) nil - "`display-line-numbers' not available") - (if helm-display-line-numbers-mode - (with-helm-buffer - (setq display-line-numbers 'relative) - (helm--action-at-nth-set-fn+ - helm-action-at-nth-positive-prefix-key) - (helm--action-at-nth-set-fn- - helm-action-at-nth-negative-prefix-key)) - (with-helm-buffer - (setq display-line-numbers nil) - (helm--action-at-nth-set-fn+ - helm-action-at-nth-positive-prefix-key 'unset) - (helm--action-at-nth-set-fn- - helm-action-at-nth-negative-prefix-key 'unset))))) -(put 'helm-display-line-numbers-mode 'helm-only t) - - - -;;; Async process -;; -(defun helm-output-filter (process output) - "The default `process-filter' function for Helm async sources. -See `helm-default-output-filter'." - (with-local-quit - (let* ((process-assoc (assoc process helm-async-processes)) - (source (cdr process-assoc)) - (insertion-marker (cdr (assq 'insertion-marker source))) - (incomplete-line-info (assq 'incomplete-line source)) - (item-count-info (assq 'item-count source)) - (multiline (assq 'multiline source))) - (with-helm-buffer - (save-excursion - (if insertion-marker - (prog1 - ;; Marker position is constantly updated while - ;; text is inserted by `insert-before-markers' which ignore - ;; its type. - (goto-char insertion-marker) - (helm-log "helm-output-filter" - "Goto insertion marker at %S" insertion-marker)) - (goto-char (point-max)) - (helm-insert-header-from-source source) - (helm-log "helm-output-filter" - "Inserting source header name = %S" (assq 'name source)) - (setcdr process-assoc - (append source `((insertion-marker . ,(point-marker)))))) - ;; Split output and treat incomplete lines one by one. We don't use - ;; OMIT-NULLS deliberately to have ("output" "") when splitting - ;; "output\n". - (let ((lines (split-string output "\n")) - candidates) - (while lines - (if (not (cdr lines)) ; An incomplete line. - ;; store it until new output arrives. - (setcdr incomplete-line-info (pop lines)) - (helm-aif (cdr incomplete-line-info) - (let ((head (pop lines))) - (helm-log "helm-output-filter" - "incomplete-line-info(1) = %S" it) - (helm-log "helm-output-filter" - "incomplete-line-info(2) = %S" head) - (push (concat it head) candidates) - ;; Previously we were setting incomplete-line-info to line - ;; and later to (concat incomplete-line-info line) to fix - ;; Bug#1187, it seems both were wrong. - (setcdr incomplete-line-info nil)) - (push (pop lines) candidates)))) - ;; Transform candidates. - (setq candidates (helm-transform-candidates - (nreverse candidates) source t)) - ;; Now insert each candidate in helm buffer. - (catch 'reach-limit - (dolist (candidate candidates) - (setq candidate (helm--maybe-process-filter-one-by-one-candidate - candidate source)) - (let ((start (point))) - (unless (or (not multiline) - (zerop (cdr (assq 'item-count source)))) - (helm-insert-candidate-separator)) - (helm-insert-match candidate 'insert-before-markers - (1+ (cdr (assq 'item-count source))) - source) - (when multiline - (put-text-property start (point) 'helm-multiline t))) - (cl-incf (cdr item-count-info)) - ;; Exit when we reach candidate-number-limit. - (when (>= (cdr item-count-info) (helm-candidate-number-limit source)) - (process-put process 'reach-limit t) - (helm-kill-async-process process #'kill-process) ; SIGKILL (9). - (helm-log-run-hook "helm-output-filter" - 'helm-async-outer-limit-hook) - (throw 'reach-limit nil)))))))) - (helm-output-filter--post-process))) - -(defun helm-output-filter--post-process () - (helm-aif (get-buffer-window helm-buffer 'visible) - (with-selected-window it - (helm-skip-noncandidate-line 'next) - (helm-mark-current-line nil 'nomouse) - (helm-follow-execute-persistent-action-maybe) - (helm-display-mode-line (helm-get-current-source)) - (helm-log-run-hook "helm-output-filter--post-process" - 'helm-after-update-hook) - (helm--reset-update-flag)))) - -(defun helm-kill-async-processes () - "Kill all asynchronous processes registered in `helm-async-processes'." - (cl-loop for (proc . _src) in helm-async-processes - do (helm-kill-async-process proc) - finally (setq helm-async-processes nil))) - -(defun helm-kill-async-process (process &optional kill-fn) - "Stop output from `helm-output-filter' and kill associated PROCESS." - (set-process-filter process t) - (funcall (or kill-fn #'delete-process) process)) - -(defun helm-process-deferred-sentinel-hook (process event file) - "Defer remote processes in sentinels. -Meant to be called at the beginning of a sentinel process -function." - (when (and (not (zerop helm-tramp-connection-min-time-diff)) - (string= event "finished\n") - (or (file-remote-p file) - ;; `helm-suspend-update-flag' - ;; is non-`nil' here only during a - ;; running process, this will never be called - ;; when user set it explicitly with `C-!'. - helm-suspend-update-flag)) - (setq helm-suspend-update-flag t) - ;; Kill the process but don't delete entry in - ;; `helm-async-processes'. - (helm-kill-async-process process) - ;; When tramp opens the same connection twice in less than 5 - ;; seconds, it throws 'suppress, which calls the real-handler on - ;; the main "Emacs". To avoid this [1] helm waits for 5 seconds - ;; before updates yet allows user input during this delay. [1] In - ;; recent Emacs versions, this has been fixed so tramp returns nil - ;; in such conditions. Note: `tramp-connection-min-time-diff' cannot - ;; have values less than 5 seconds otherwise the process dies. - (run-at-time helm-tramp-connection-min-time-diff - nil (lambda () - (when helm-alive-p ; Don't run timer fn after quit. - (setq helm-suspend-update-flag nil) - (helm-check-minibuffer-input)))))) - -;;; Actions -;; -(defun helm-execute-selection-action () - "Execute current action." - (helm-log-run-hook "helm-execute-selection-action" - 'helm-before-action-hook) - ;; Position can be change when `helm-current-buffer' - ;; is split, so jump to this position before executing action. - (helm-current-position 'restore) - (unwind-protect - (prog1 (helm-execute-selection-action-1) - (helm-log-run-hook "helm-execute-selection-action" - 'helm-after-action-hook)) - (setq helm--executing-helm-action nil))) - -(defun helm-execute-selection-action-1 (&optional - selection action - preserve-saved-action) - "Execute ACTION on current SELECTION. -If PRESERVE-SAVED-ACTION is non-nil, then save the action." - (helm-log "helm-execute-selection-action-1" "executing action") - (setq action (helm-get-default-action - (or action - helm-saved-action - (if (get-buffer helm-action-buffer) - (helm-get-selection helm-action-buffer) - (helm-get-actions-from-current-source))))) - (helm-aif (and (not helm-in-persistent-action) - (get-buffer helm-action-buffer)) - (kill-buffer it)) - (let ((source (or helm-saved-current-source - (helm-get-current-source))) - non-essential) - (setq selection (helm-coerce-selection - (or selection - helm-saved-selection - (helm-get-selection nil nil source) - (and (assq 'accept-empty source) "")) - source)) - (unless preserve-saved-action (setq helm-saved-action nil)) - (when (and selection action) (funcall action selection)))) - -(defun helm-coerce-selection (selection source) - "Apply coerce attribute function to SELECTION in SOURCE. -Coerce source with coerce function." - (helm-aif (assoc-default 'coerce source) - (helm-apply-functions-from-source source it selection) - selection)) - -(defun helm-get-default-action (action) - "Get the first ACTION value of action list in source." - (if (and (listp action) (not (functionp action))) - (cdar action) - action)) - -(defun helm--show-action-window-other-window-p () - "Decide if window layout is suitable for showing action buffer. -Note that the return value is meaningful only at some point in the code, -i.e. before displaying action menu." - (when helm-show-action-window-other-window - ;; We were previously checking helm-split-window-state (eq vertical) to - ;; decide to show action window, we now show it inconditionally in such case - ;; but 'below'. - (if (< (window-width (helm-window)) - (or split-width-threshold 160)) - 'below - helm-show-action-window-other-window))) - -(defun helm-select-action () - "Select an action for the currently selected candidate. -If action buffer is selected, back to the Helm buffer." - (interactive) - (with-helm-alive-p - (let ((src (helm-get-current-source))) - (helm-log-run-hook "helm-select-action" 'helm-select-action-hook) - (setq helm-saved-selection (helm-get-selection nil nil src)) - (with-selected-frame (with-helm-window (selected-frame)) - (prog1 - (helm-acond ((get-buffer-window helm-action-buffer 'visible) - (let ((delta (window-total-height it))) - (set-window-buffer it helm-buffer) - (helm--set-action-prompt 'restore) - ;; If `helm-show-action-window-other-window' is non nil - ;; we should have now two windows displaying - ;; helm-buffer, delete the one that was handling - ;; previously action buffer. - (when (helm--show-action-window-other-window-p) - (delete-window it)) - ;; Resize window on horizontal split, though for some - ;; reasons only 'above' needs to be resized. - (when (memq helm-show-action-window-other-window '(below above)) - (window-resize (get-buffer-window helm-buffer) delta)) - (kill-buffer helm-action-buffer) - (setq helm-saved-selection nil) - (helm-set-pattern helm-input 'noupdate) - ;; Maybe hide minibuffer if helm was showing - ;; minibuffer in header-line and we are just toggling - ;; menu [1]. - (helm-hide-minibuffer-maybe))) - (helm-saved-selection - (setq helm-saved-current-source src) - (let ((actions (helm-get-actions-from-current-source src)) - helm-onewindow-p) - (if (functionp actions) - (message "Sole action: %s" - ;; lambdas are no more represented as list in - ;; Emacs-29+ Bug#2666. - (if (or (not (symbolp actions)) - (byte-code-function-p actions) - (helm-subr-native-elisp-p actions)) - "Anonymous" actions)) - (helm-show-action-buffer actions) - ;; Be sure the minibuffer is entirely deleted - ;; (bug#907). Previously this was done from - ;; `helm--delete-minibuffer-contents-from' which - ;; was itself force updating, now do it explicitely - ;; from here. - (helm-set-pattern "" t) - (helm-force-update nil) - ;; Unhide minibuffer to make visible action prompt [1]. - (with-selected-window (minibuffer-window) - (remove-overlays) (setq cursor-type t)) - (helm--set-action-prompt) - (helm-check-minibuffer-input)))) - (t (message "No Actions available"))) - (helm-display-mode-line (helm-get-current-source)) - (run-hooks 'helm-window-configuration-hook)))))) -(put 'helm-select-action 'helm-only t) - -(defun helm-menu-select-action (_event) - "Popup action menu from mouse-3." - (interactive "e") - (if (get-buffer-window helm-action-buffer 'visible) - (helm-select-action) - (let ((src (helm-get-current-source))) - (helm-aif (helm-get-actions-from-current-source src) - (progn - (setq helm-saved-current-source src) - (if (functionp it) - (message "Sole action: %s" - ;; lambdas are no more represented as list in - ;; Emacs-29+ Bug#2666. - (if (or (not (symbolp it)) - (byte-code-function-p it) - (helm-subr-native-elisp-p it)) - "Anonymous" it)) - (setq helm-saved-action - (x-popup-menu - t (list "Available Actions" - (cons "" it)))) - (helm-maybe-exit-minibuffer)) - (message "No Actions available")))))) -(put 'helm-menu-select-action 'helm-only t) - -(defun helm--set-action-prompt (&optional restore) - (with-selected-window (minibuffer-window) - (let ((inhibit-read-only t) - (props '(face minibuffer-prompt - field t - read-only t - rear-nonsticky t - front-sticky t)) - (prt (if restore helm--prompt helm--action-prompt))) - (erase-buffer) - (insert (apply #'propertize prt props)) - ;; Restore minibuffer depth indicator if the mode is enabled. - (when minibuffer-depth-indicate-mode - (minibuffer-depth-setup))))) - -(defun helm-show-action-buffer (actions) - (with-current-buffer (get-buffer-create helm-action-buffer) - (erase-buffer) - (buffer-disable-undo) - (setq cursor-type nil) - ;; Maybe display action buffer 'below' if window isn't large enough - ;; (bug#2635). - (set-window-buffer (helm-aif (helm--show-action-window-other-window-p) - (split-window (get-buffer-window helm-buffer) nil it) - (get-buffer-window helm-buffer)) - helm-action-buffer) - (set (make-local-variable 'helm-sources) - (list - (helm-build-sync-source "Actions" - :volatile t - :nomark t - :persistent-action #'ignore - :persistent-help "DoNothing" - :keymap 'helm-map - :candidates actions - :mode-line '("Action(s)" "\\\\[helm-select-action]:BackToCands RET/f1/f2/fn:NthAct") - :candidate-transformer - (lambda (candidates) - (cl-loop for (i . j) in candidates - for count from 1 - collect - (cons (concat (cond ((> count 12) - " ") - ((< count 10) - (format "[f%s] " count)) - (t (format "[f%s] " count))) - (propertize i 'face 'helm-action)) - j))) - :candidate-number-limit nil))) - (set (make-local-variable 'helm-source-filter) nil) - (set (make-local-variable 'helm-selection-overlay) nil) - (helm-initialize-overlays helm-action-buffer))) - - -;; Selection of candidates - -(defun helm-display-source-at-screen-top-maybe (unit) - "Display source at the top of screen when UNIT value is \\='source. -Return nil for any other value of UNIT." - (when (and helm-display-source-at-screen-top (eq unit 'source)) - (set-window-start (selected-window) - (save-excursion (forward-line -1) (point))))) - -(defun helm-skip-noncandidate-line (direction) - "Skip source header or candidates separator when going in DIRECTION. -DIRECTION is either \\='next or \\='previous. -Same as `helm-skip-header-and-separator-line' but ensure point is -moved to the right place when at bob or eob." - (helm-skip-header-and-separator-line direction) - (and (bobp) (forward-line 1)) ; Skip first header. - (and (eobp) (forward-line -1))) ; Avoid last empty line. - -(defun helm-skip-header-and-separator-line (direction) - "Skip source header or candidate separator when going to next/previous line. -DIRECTION is either \\='next or \\='previous." - (let ((fn (cl-ecase direction - (next 'eobp) - (previous 'bobp)))) - (while (and (not (funcall fn)) - (or (helm-pos-header-line-p) - (helm-pos-candidate-separator-p))) - (forward-line (if (and (eq direction 'previous) - (not (eq (pos-bol) (point-min)))) - -1 1))))) - -(defun helm-display-mode-line (source &optional force) - "Set up mode-line and header-line for `helm-buffer'. - -SOURCE is a Helm source object. - -Optional argument FORCE forces redisplay of the Helm buffer's -mode and header lines." - (set (make-local-variable 'helm-mode-line-string) - (helm-interpret-value (or (and (listp source) ; Check if source is empty. - (assoc-default 'mode-line source)) - (default-value 'helm-mode-line-string)) - source)) - (let* ((src-name (assoc-default 'name source)) - (follow (and (or (helm-follow-mode-p source) - (and helm-follow-mode-persistent - (member src-name helm-source-names-using-follow))) - " (HF)")) - (marked (if (assoc-default 'all-marked source) - helm-marked-candidates - (cl-loop for c in helm-marked-candidates - for name = (assoc-default 'name (car c)) - when (string= name src-name) - collect c)))) - ;; Setup mode-line. - (if helm-mode-line-string - (setq mode-line-format - `(:propertize - (" " mode-line-buffer-identification " " - (:eval (format "L%-3d" (helm-candidate-number-at-point))) - ,follow - " " - (:eval ,(and marked - (propertize - (format "M%d" (length marked)) - 'face 'helm-visible-mark))) - (:eval (when ,helm--mode-line-display-prefarg - (let ((arg (prefix-numeric-value - (or prefix-arg current-prefix-arg)))) - (unless (= arg 1) - (propertize (format " [prefarg:%s]" arg) - 'face 'helm-prefarg))))) - " " - (:eval (with-helm-buffer - (helm-show-candidate-number - (car-safe helm-mode-line-string)))) - " " helm--mode-line-string-real " " - (:eval (make-string (window-width) ? ))) - keymap (keymap (mode-line keymap - (mouse-1 . ignore) - (down-mouse-1 . ignore) - (drag-mouse-1 . ignore) - (mouse-2 . ignore) - (down-mouse-2 . ignore) - (drag-mouse-2 . ignore) - (mouse-3 . ignore) - (down-mouse-3 . ignore) - (drag-mouse-3 . ignore)))) - helm--mode-line-string-real - (substitute-command-keys (if (listp helm-mode-line-string) - (cadr helm-mode-line-string) - helm-mode-line-string))) - (setq mode-line-format (default-value 'mode-line-format))) - ;; Setup header-line. - (cond (helm-echo-input-in-header-line - (setq force t) - (helm--set-header-line)) - (helm-display-header-line - (let ((hlstr (helm-interpret-value - (and (listp source) - (assoc-default 'header-line source)) - source)) - (endstr (make-string (window-width) ? ))) - (setq header-line-format - (propertize (concat " " hlstr endstr) - 'face 'helm-header)))))) - (when force (force-mode-line-update))) - -(defun helm--set-header-line (&optional update) - (with-selected-window (minibuffer-window) - (when helm-display-header-line - ;; Prevent cursor movement over the overlay displaying - ;; persistent-help in minibuffer (Bug#2108). - (setq-local disable-point-adjustment t)) - (let* ((beg (save-excursion (vertical-motion 0 (helm-window)) (point))) - (end (save-excursion (end-of-visual-line) (point))) - ;; The visual line where the cursor is. - (cont (buffer-substring beg end)) - (pref (propertize - " " - 'display (if (string-match-p (regexp-opt `(,helm--prompt - ,helm--action-prompt)) - cont) - `(space :width ,helm-header-line-space-before-prompt) - (propertize - "->" - 'face 'helm-header-line-left-margin)))) - (pos (- (point) beg))) - ;; Increment pos each time we find a "%" up to current-pos (bug#1648). - (cl-loop for c across (buffer-substring-no-properties beg (point)) - when (eql c ?%) do (cl-incf pos)) - ;; Increment pos when cursor is on a "%" to make it visible in header-line - ;; i.e "%%|" and not "%|%" (bug#1649). - (when (eql (char-after) ?%) (setq pos (1+ pos))) - (setq cont (replace-regexp-in-string "%" "%%" cont)) - (with-helm-buffer - (setq header-line-format (concat pref cont " ")) - (funcall helm-default-prompt-display-function pos) - (when update (force-mode-line-update)))))) - -(defun helm-set-default-prompt-display (pos) - (put-text-property - ;; Increment pos to handle the space before prompt (i.e `pref'). - (+ 1 pos) (+ 2 pos) - 'face - ;; Don't just use cursor face, this can hide the current character. - (list :inverse-video t - :foreground (face-background 'cursor) - :background (face-background 'default)) - header-line-format)) - -(defun helm-exchange-minibuffer-and-header-line () - "Display minibuffer in header-line and vice versa for current Helm session. - -This is a toggle command." - (interactive) - (cl-assert (not (eq (helm-get-attr 'echo-input-in-header-line) 'never)) - nil "echo-input-in-header-line not allowed in this source") - (with-helm-window - (add-hook 'helm-minibuffer-set-up-hook 'helm-hide-minibuffer-maybe) - (setq-local helm-echo-input-in-header-line - (not helm-echo-input-in-header-line)) - (with-selected-window (minibuffer-window) - (if (with-helm-buffer helm-echo-input-in-header-line) - (helm-hide-minibuffer-maybe) - (remove-overlays) - (setq cursor-type t))) - (helm-display-mode-line (helm-get-current-source) t))) -(put 'helm-exchange-minibuffer-and-header-line 'helm-only t) - -(defun helm--update-header-line () - ;; This is already called in `post-command-hook', - ;; so it should not be called elsewhere. - (when (with-helm-buffer helm-echo-input-in-header-line) - (helm--set-header-line t))) - -;; We were previously let-binding `resize-mini-windows' in -;; `helm-read-from-minibuffer', this to prevent minibuffer resizing when -;; inserting multiline string in fake minibuffer (header-line). -;; I seems it had no effect see bug#2638. -(defun helm-hide-minibuffer-maybe () - "Hide minibuffer contents in a Helm session. -This function should normally go to `helm-minibuffer-set-up-hook'. -It has no effect if `helm-echo-input-in-header-line' is nil." - (when (with-helm-buffer helm-echo-input-in-header-line) - (let ((ov (make-overlay (point-min) (point-max) nil nil t))) - (overlay-put ov 'window (selected-window)) - (helm-aif (and helm-display-header-line - (helm-get-attr 'persistent-help)) - (progn - (overlay-put ov 'display - (truncate-string-to-width - (substitute-command-keys - (concat "\\\\[helm-execute-persistent-action]: " - (format "%s (keeping session)" it))) - (- (window-width) 1))) - (overlay-put ov 'face 'helm-header)) - (overlay-put ov 'face (let ((bg-color (face-background 'default nil))) - `(:background ,bg-color :foreground ,bg-color)))) - - (setq cursor-type nil)))) - -(defun helm-show-candidate-number (&optional name) - "Used to display candidate number in mode-line. -You can specify NAME of candidates e.g. \"Buffers\" otherwise it -is \"Candidate(s)\" by default." - (when helm-alive-p - (unless (helm-empty-source-p) - ;; Build a fixed width string when candidate-number < 1000 - (let* ((cand-name (or name "Candidate(s)")) - (width (length (format "[999 %s]" cand-name)))) - (propertize - (format (concat "%-" (number-to-string width) "s") - (format "[%s %s]" - (helm-get-candidate-number 'in-current-source) - cand-name)) - 'face (if helm-suspend-update-flag - 'helm-candidate-number-suspended - 'helm-candidate-number)))))) - -(defun helm-move-selection-common (&rest args) - "Move the selection marker to a new position. -Position is determined by WHERE and DIRECTION. -When FOLLOW is specified execute `helm-follow-execute-persistent-action-maybe'. -Key arg WHERE can be one of: - - line - - page - - edge - - source -Key arg DIRECTION can be one of: - - previous - - next - - A source or a source name when used with :WHERE \\='source. - -\(fn &key WHERE DIRECTION FOLLOW)" - (apply #'helm-move-selection-common-1 - (mapcar (lambda (kw) - (plist-get args kw)) - '(:where :direction :follow)))) - -(defun helm-move-selection-common-1 (where direction follow) - (unless follow (setq follow t)) - (let ((move-func (cl-case where - (line (cl-ecase direction - (previous 'helm-move--previous-line-fn) - (next 'helm-move--next-line-fn))) - (page (cl-ecase direction - (previous 'helm-move--previous-page-fn) - (next 'helm-move--next-page-fn))) - (edge (cl-ecase direction - (previous 'helm-move--beginning-of-buffer-fn) - (next 'helm-move--end-of-buffer-fn))) - (source (cl-case direction - (previous 'helm-move--previous-source-fn) - (next 'helm-move--next-source-fn) - (t (lambda () ; A source is passed as DIRECTION arg. - (helm-move--goto-source-fn direction))))))) - source) - (unless (or (helm-empty-buffer-p (helm-buffer-get)) - (not (helm-window))) - (with-helm-window - (when helm-allow-mouse - (helm--mouse-reset-selection-help-echo)) - (helm-log-run-hook "helm-move-selection-common" - 'helm-move-selection-before-hook) - (funcall move-func) - (and (memq direction '(next previous)) - (helm-skip-noncandidate-line direction)) - (when (helm-pos-multiline-p) - (helm-move--beginning-of-multiline-candidate)) - (helm-display-source-at-screen-top-maybe where) - (helm-mark-current-line) - (when follow - (helm-follow-execute-persistent-action-maybe)) - (helm-display-mode-line (setq source (helm-get-current-source))) - (helm-log-run-hook "helm-move-selection-common" - 'helm-move-selection-after-hook) - (helm--set-minibuffer-completion-confirm source))))) - -(defun helm-move--beginning-of-multiline-candidate () - (let ((header-pos (helm-get-previous-header-pos)) - (separator-pos (helm-get-previous-candidate-separator-pos))) - (when header-pos - (goto-char (if (or (null separator-pos) - (< separator-pos header-pos)) - header-pos - separator-pos)) - (forward-line 1)))) - -(defun helm-move--previous-multi-line-fn () - (forward-line -1) - (unless (helm-pos-header-line-p) - (helm-skip-header-and-separator-line 'previous) - (helm-move--beginning-of-multiline-candidate))) - -(defun helm-move--previous-line-fn () - (if (not (helm-pos-multiline-p)) - (forward-line -1) - (helm-move--previous-multi-line-fn)) - (when (and helm-move-to-line-cycle-in-source - (helm-pos-header-line-p)) - (forward-line 1) - (helm-move--end-of-source) - ;; We are at end of helm-buffer - ;; check if last candidate is a multiline candidate - ;; and jump to it - (when (and (eobp) - (save-excursion (forward-line -1) (helm-pos-multiline-p))) - (helm-move--previous-multi-line-fn)))) - -(defun helm-move--next-multi-line-fn () - (let ((header-pos (helm-get-next-header-pos)) - (separator-pos (helm-get-next-candidate-separator-pos))) - (cond ((and separator-pos - (or (null header-pos) (< separator-pos header-pos))) - (goto-char separator-pos)) - (header-pos - (goto-char header-pos))))) - -(defun helm-move--next-line-fn () - (if (not (helm-pos-multiline-p)) - (forward-line 1) - (helm-move--next-multi-line-fn)) - (when (and helm-move-to-line-cycle-in-source - (or (save-excursion (and (helm-pos-multiline-p) - (goto-char (overlay-end - helm-selection-overlay)) - (helm-end-of-source-p t))) - (helm-end-of-source-p t))) - (helm-move--beginning-of-source) - (helm-display-source-at-screen-top-maybe 'source))) - -(defun helm-move--previous-page-fn () - (condition-case nil - (scroll-down helm-scroll-amount) - (beginning-of-buffer (goto-char (point-min))))) - -(defun helm-move--next-page-fn () - (condition-case nil - (scroll-up helm-scroll-amount) - (end-of-buffer (goto-char (point-max))))) - -(defun helm-move--beginning-of-buffer-fn () - (goto-char (point-min))) - -(defun helm-move--end-of-buffer-fn () - (goto-char (point-max))) - -(defun helm-move--end-of-source () - (helm-aif (helm-get-next-header-pos) - (progn (goto-char it) (forward-line -2)) - (goto-char (point-max)))) - -(defun helm-move--beginning-of-source () - (helm-aif (helm-get-previous-header-pos) - (progn (goto-char it) - (forward-line 1)) - (goto-char (point-min)))) - -(defun helm-move--previous-source-fn () - (forward-line -1) - (if (bobp) - (goto-char (point-max)) - (helm-skip-header-and-separator-line 'previous)) - (goto-char (helm-get-previous-header-pos)) - (forward-line 1)) - -(defun helm-move--next-source-fn () - (goto-char (or (and (not (save-excursion - (forward-line 1) (eobp))) - ;; Empty source at eob are just - ;; not displayed unless they are dummy. - ;; Bug#1117. - (helm-get-next-header-pos)) - (point-min)))) - -(defun helm-move--goto-source-fn (source-or-name) - (goto-char (point-min)) - (let ((name (if (stringp source-or-name) - source-or-name - (assoc-default 'name source-or-name)))) - (if (or (null name) (string= name "")) - (forward-line 1) - (condition-case err - (while (not (string= name (helm-current-line-contents))) - (goto-char (helm-get-next-header-pos))) - (error (helm-log "helm-move--goto-source-fn" "%S" err)))))) - -(defun helm-candidate-number-at-point () - (if helm-alive-p - (with-helm-buffer - (or (get-text-property (point) 'helm-cand-num) 1)) - (or (get-text-property (point) 'helm-cand-num) 1))) - -(defun helm--next-or-previous-line (direction &optional arg) - ;; Be sure to not use this in non--interactives calls. - (let ((helm-move-to-line-cycle-in-source - (and helm-move-to-line-cycle-in-source arg))) - (if (and arg (> arg 1)) - (cl-loop with pos = (helm-candidate-number-at-point) - with cand-num = (helm-get-candidate-number t) - with iter = (min arg (if (eq direction 'next) - (- cand-num pos) - (min arg (1- pos)))) - for count from 1 - while (<= count iter) - do - (helm-move-selection-common :where 'line :direction direction)) - (helm-move-selection-common :where 'line :direction direction)))) - -(defun helm-previous-line (&optional arg) - "Move selection to the ARG previous line(s). -Same behavior as `helm-next-line' when called with a numeric -prefix arg." - (interactive "p") - (with-helm-alive-p - (helm--next-or-previous-line 'previous arg))) -(put 'helm-previous-line 'helm-only t) - -(defun helm-next-line (&optional arg) - "Move selection to the next ARG line(s). -When numeric prefix arg is > than the number of candidates, then -move to the last candidate of current source (i.e. don't move to -next source)." - (interactive "p") - (with-helm-alive-p - (helm--next-or-previous-line 'next arg))) -(put 'helm-next-line 'helm-only t) - -(defun helm-scroll-up () - "Scroll up helm-buffer by `helm-scroll-amount' lines." - (interactive) - (with-helm-alive-p - (helm-move-selection-common :where 'page :direction 'previous))) -(put 'helm-scroll-up 'helm-only t) - -(defun helm-previous-page () - "Move selection back with a pageful." - (interactive) - (with-helm-alive-p - (let (helm-scroll-amount) - (helm-move-selection-common :where 'page :direction 'previous)))) -(put 'helm-previous-page 'helm-only t) - -(defun helm-scroll-down () - "Scroll down helm-buffer by `helm-scroll-amount' lines." - (interactive) - (with-helm-alive-p - (helm-move-selection-common :where 'page :direction 'next))) -(put 'helm-scroll-down 'helm-only t) - -(defun helm-next-page () - "Move selection forward with a pageful." - (interactive) - (with-helm-alive-p - (let (helm-scroll-amount) - (helm-move-selection-common :where 'page :direction 'next)))) -(put 'helm-next-page 'helm-only t) - -(defun helm-beginning-of-buffer () - "Move selection at the top." - (interactive) - (with-helm-alive-p - (helm-move-selection-common :where 'edge :direction 'previous))) -(put 'helm-beginning-of-buffer 'helm-only t) - -(defun helm-end-of-buffer () - "Move selection at the bottom." - (interactive) - (with-helm-alive-p - (helm-move-selection-common :where 'edge :direction 'next))) -(put 'helm-end-of-buffer 'helm-only t) - -(defun helm-previous-source () - "Move selection to the previous source." - (interactive) - (with-helm-alive-p - (helm-move-selection-common :where 'source :direction 'previous))) -(put 'helm-previous-source 'helm-only t) - -(defun helm-next-source () - "Move selection to the next source." - (interactive) - (with-helm-alive-p - (helm-move-selection-common :where 'source :direction 'next))) -(put 'helm-next-source 'helm-only t) - -(defun helm-goto-source (&optional source-or-name) - "Move the selection to the source named SOURCE-OR-NAME. - -If SOURCE-OR-NAME is empty string or nil go to the first -candidate of first source." - (helm-move-selection-common :where 'source :direction source-or-name)) - -(defvar helm-follow-action-white-list-commands - '(helm-ff-decrease-image-size-persistent - helm-ff-increase-image-size-persistent - helm-ff-rotate-left-persistent - helm-ff-rotate-right-persistent) - "Allow `helm-follow-action-forward/backward' switching to next file -when one of these commands is the `last-command'. - -For example when browsing files with `C-` and rotate the current file, -hitting `C-` again will not switch to next file but kill its buffer.") - -(defun helm--follow-action (arg) - (let ((helm--temp-follow-flag t) ; Needed in HFF. - (in-follow-mode (helm-follow-mode-p))) - ;; When follow-mode is already enabled, just go to next or - ;; previous line. - (when (or (eq last-command 'helm-follow-action-forward) - (eq last-command 'helm-follow-action-backward) - (eq last-command 'helm-execute-persistent-action) - (memq last-command helm-follow-action-white-list-commands) - in-follow-mode) - (if (> arg 0) - (helm-move-selection-common :where 'line - :direction 'next - :follow nil) - (helm-move-selection-common :where 'line - :direction 'previous - :follow nil))) - (unless in-follow-mode - (helm-execute-persistent-action)))) - -(defun helm-follow-action-forward () - "Go to next line and execute persistent action." - (interactive) - (with-helm-alive-p (helm--follow-action 1))) -(put 'helm-follow-action-forward 'helm-only t) - -(defun helm-follow-action-backward () - "Go to previous line and execute persistent action." - (interactive) - (with-helm-alive-p (helm--follow-action -1))) -(put 'helm-follow-action-backward 'helm-only t) - -(defun helm-mark-current-line (&optional resumep nomouse) - "Move `helm-selection-overlay' to current line. -When RESUMEP is non nil move overlay to `helm-selection-point'. -When NOMOUSE is specified do not set mouse bindings. - -Note that selection is unrelated to visible marks used for -marking candidates." - (with-helm-buffer - (when resumep - (goto-char helm-selection-point)) - (move-overlay - helm-selection-overlay (pos-bol) - (if (helm-pos-multiline-p) - (let ((header-pos (helm-get-next-header-pos)) - (separator-pos (helm-get-next-candidate-separator-pos))) - (or (and (null header-pos) separator-pos) - (and header-pos separator-pos - (< separator-pos header-pos) - separator-pos) - header-pos - (point-max))) - (1+ (pos-eol)))) - (setq helm-selection-point (overlay-start helm-selection-overlay)) - (when (and helm-allow-mouse (null nomouse) (not resumep)) - (helm--bind-mouse-for-selection helm-selection-point)))) - -(defun helm-confirm-and-exit-minibuffer () - "Maybe ask for confirmation when exiting helm. -It is similar to `minibuffer-complete-and-exit' adapted to Helm. -If `minibuffer-completion-confirm' value is \\='confirm, send -minibuffer confirm message and exit on next hit. If -`minibuffer-completion-confirm' value is t, don't exit and send -message \\='no match'." - (interactive) - (with-helm-alive-p - (if (and (helm--updating-p) - (null helm--reading-passwd-or-string)) - (progn (message "[Display not ready]") - (sit-for 0.5) (message nil) - (helm-update)) - (let* ((src (helm-get-current-source)) - (empty-buffer-p (with-current-buffer helm-buffer - (eq (point-min) (point-max)))) - (unknown (and (not empty-buffer-p) - ;; Now such candidates have a helm-new-file or an - ;; unknown text property (we were testing if string - ;; match [?] previously). - (helm-candidate-prefixed-p - (helm-get-selection nil 'withprop src))))) - (cond ((and (or empty-buffer-p unknown) - (memq minibuffer-completion-confirm - '(confirm confirm-after-completion))) - (setq helm-minibuffer-confirm-state - 'confirm) - (setq minibuffer-completion-confirm nil) - (minibuffer-message " [confirm]")) - ;; 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. - ;; When `minibuffer-completion-confirm' is set to 'noexit or - ;; 'exit, that's mean MUST-MATCH is a function and we use its - ;; return value to set `minibuffer-completion-confirm', this is - ;; done in `helm--set-minibuffer-completion-confirm'. - ((or (eq minibuffer-completion-confirm 'noexit) - (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))))))) -(put 'helm-confirm-and-exit-minibuffer 'helm-only t) - -(defun helm-confirm-and-exit-hook () - "Restore `minibuffer-completion-confirm' when helm update." - (unless (or (eq minibuffer-completion-confirm t) - (not helm-minibuffer-confirm-state)) - (setq minibuffer-completion-confirm - helm-minibuffer-confirm-state))) -(add-hook 'helm-after-update-hook 'helm-confirm-and-exit-hook) - -(defun helm--set-minibuffer-completion-confirm (src) - "Return the value of a REQUIRE-MATCH arg in a `completing-read'." - ;; Set `minibuffer-completion-confirm' to 'noexit,'exit or 'confirm according - ;; to MUST-MATCH value (possibly a function). - (with-helm-buffer - (setq minibuffer-completion-confirm - (helm-acase (helm-get-attr 'must-match src) - ((guard* (and (functionp it) - (helm-get-selection nil nil src))) - (helm-acase (funcall it guard) - ;; Alow using 'confirm as the output of a REQUIRE-MATCH fn even - ;; if this feature is not available in Emacs. - ((confirm confirm-after-completion) it) - ((guard* (eq nil it)) 'noexit) - (t 'exit))) - (t it))))) - -(defun helm-read-string (prompt &optional initial-input history - default-value inherit-input-method) - "Same as `read-string' but for reading string from a helm session." - (let ((helm--reading-passwd-or-string t)) - (read-string - prompt initial-input history default-value inherit-input-method))) - -(defun helm--updating-p () - ;; helm timer is between two cycles. - ;; IOW `helm-check-minibuffer-input' hasn't yet compared input - ;; and `helm-pattern'. - (or (not (equal (minibuffer-contents) helm-pattern)) - ;; `helm-check-minibuffer-input' has launched `helm-update'. - helm--in-update)) - -(defun helm-maybe-exit-minibuffer () - (interactive) - (with-helm-alive-p - (if (and (helm--updating-p) - (null helm--reading-passwd-or-string)) - (progn - (message "[Display not ready]") - (sit-for 0.5) (message nil) - (helm-update)) - (helm-exit-minibuffer)))) -(put 'helm-maybe-exit-minibuffer 'helm-only t) - -(defun helm-exit-minibuffer () - "Select the current candidate by exiting the minibuffer." - (unless helm-current-prefix-arg - (setq helm-current-prefix-arg current-prefix-arg)) - (setq helm-exit-status 0) - (helm-log-run-hook "helm-exit-minibuffer" - 'helm-exit-minibuffer-hook) - (exit-minibuffer)) - -(defun helm-keyboard-quit () - "Quit minibuffer in helm. -If action buffer is displayed, kill it." - (interactive) - (with-helm-alive-p - (when (get-buffer-window helm-action-buffer 'visible) - (kill-buffer helm-action-buffer)) - (setq helm-exit-status 1) - (abort-recursive-edit))) -(put 'helm-keyboard-quit 'helm-only t) - -(defun helm-get-next-header-pos () - "Return the position of the next header from point." - (next-single-property-change (point) 'helm-header)) - -(defun helm-get-previous-header-pos () - "Return the position of the previous header from point." - (previous-single-property-change (point) 'helm-header)) - -(defun helm-pos-multiline-p () - "Return non-`nil' if the current position is in the multiline source region." - (get-text-property (point) 'helm-multiline)) - -(defun helm-get-next-candidate-separator-pos () - "Return the position of the next candidate separator from point." - (let ((hp (helm-get-next-header-pos))) - (helm-aif (next-single-property-change (point) 'helm-candidate-separator) - (or - ;; Be sure we don't catch - ;; the separator of next source. - (and hp (< it hp) it) - ;; The separator found is in next source - ;; we are at last cand, so use the header pos. - (and hp (< hp it) hp) - ;; A single source, just try next separator. - it)))) - -(defun helm-get-previous-candidate-separator-pos () - "Return the position of the previous candidate separator from point." - (previous-single-property-change (point) 'helm-candidate-separator)) - -(defun helm-pos-header-line-p () - "Return t if the current line is a header line." - (or (get-text-property (pos-bol) 'helm-header) - (get-text-property (pos-bol) 'helm-header-separator))) - -(defun helm-pos-candidate-separator-p () - "Return t if the current line is a candidate separator." - (get-text-property (pos-bol) 'helm-candidate-separator)) - - -;;; Debugging -;; -;; -(defun helm-debug-output () - "Show all Helm locals variables and output of `helm-debug-function'." - (interactive) - (with-helm-alive-p - (helm-help-internal helm-debug-output-buffer 'helm-debug-output-function))) -(put 'helm-debug-output 'helm-only t) - -(defun helm-default-debug-function () - "Collect sources of helm current session without their keymap. -This is the default function for `helm-debug-function'." - (with-helm-buffer helm-sources)) - -(defun helm-debug-output-function () - (let ((local-vars (buffer-local-variables (get-buffer helm-buffer))) - (count 1)) - (insert (format "* Helm debug from `%s' buffer\n\n" helm-buffer)) - (insert "** Local variables\n\n#+begin_src elisp\n" - (pp-to-string (remove (assq 'helm-sources local-vars) local-vars)) - "\n#+end_src\n") - (dolist-with-progress-reporter (v (helm-interpret-value helm-debug-function)) - "Calculating all helm-related values..." - (insert (format "** Value%s\n" count) - "#+begin_src elisp\n" (pp-to-string v) "\n#+end_src\n") - (cl-incf count)))) - -(defun helm-enable-or-switch-to-debug () - "First hit enable helm debugging, second hit switch to debug buffer." - (interactive) - (with-helm-alive-p - (if helm-debug - (helm-run-after-exit - #'helm-debug-open-last-log) - (setq helm-debug t) - (with-helm-buffer (setq truncate-lines nil)) - (message "Debugging enabled")))) -(put 'helm-enable-or-switch-to-debug 'helm-only t) - - -;; Misc - -(defun helm-preselect (candidate-or-regexp &optional source) - "Move selection to CANDIDATE-OR-REGEXP. - -CANDIDATE-OR-REGEXP can be a: - -- String -- Cons cell of two strings -- Nullary function, which moves to a candidate - -When CANDIDATE-OR-REGEXP is a cons cell, tries moving to first -element of the cons cell, then the second, and so on. This -allows selection of duplicate candidates after the first. - -When SOURCE is specified, move to it and search -CANDIDATE-OR-REGEXP from there." - (with-helm-buffer - (when candidate-or-regexp - (if source - (progn (helm-goto-source source) (forward-line 1)) - (goto-char (point-min)) - (forward-line 1)) - (if (functionp candidate-or-regexp) - (funcall candidate-or-regexp) - (let ((start (point)) mp) - (helm-awhile (if (consp candidate-or-regexp) - (and (re-search-forward (car candidate-or-regexp) nil t) - (re-search-forward (cdr candidate-or-regexp) nil t)) - (re-search-forward candidate-or-regexp nil t)) - ;; If search fall on an header line continue loop - ;; until it match or fail (Bug#1509). - (unless (helm-pos-header-line-p) (cl-return (setq mp it)))) - (goto-char (or mp start))))) - (forward-line 0) ; Avoid scrolling right on long lines. - (when (helm-pos-multiline-p) - (helm-move--beginning-of-multiline-candidate)) - (when (helm-pos-header-line-p) (forward-line 1)) - (when helm-allow-mouse - (helm--mouse-reset-selection-help-echo)) - (helm-mark-current-line) - (when helm--deleting-minibuffer-contents-from (recenter)) - (helm-display-mode-line (or source (helm-get-current-source))) - (helm-log-run-hook "helm-preselect" 'helm-after-preselection-hook))) - -(defun helm-delete-current-selection () - "Delete the currently selected item." - (with-helm-window - (cond ((helm-pos-multiline-p) - (helm-aif (helm-get-next-candidate-separator-pos) - (delete-region (pos-bol) - (1+ (progn (goto-char it) (pos-eol)))) - ;; last candidate - (goto-char (helm-get-previous-candidate-separator-pos)) - (delete-region (pos-bol) (point-max))) - (when (helm-end-of-source-p) - (goto-char (or (helm-get-previous-candidate-separator-pos) - (point-min))) - (forward-line 1))) - (t - (delete-region (pos-bol) (1+ (pos-eol))) - (when (helm-end-of-source-p t) - (let ((headp (save-excursion - (forward-line -1) - (not (helm-pos-header-line-p))))) - (and headp (forward-line -1)))))) - (unless (helm-end-of-source-p t) - (helm-mark-current-line)))) - -(defun helm-end-of-source-1 (n at-point) - (save-excursion - (if (and (helm-pos-multiline-p) (null at-point)) - (null (helm-get-next-candidate-separator-pos)) - (forward-line (if at-point 0 n)) - (or (eq (pos-bol) (pos-eol)) - (helm-pos-header-line-p) - (if (< n 0) (bobp) (eobp)))))) - -(defun helm-end-of-source-p (&optional at-point) - "Return non-nil if we are at EOB or end of source." - (helm-end-of-source-1 1 at-point)) - -(defun helm-beginning-of-source-p (&optional at-point) - "Return non-nil if we are at BOB or beginning of source." - (helm-end-of-source-1 -1 at-point)) - -(defun helm--edit-current-selection-internal (func) - (with-helm-window - (forward-line 0) - (let ((realvalue (get-text-property (point) 'helm-realvalue)) - (multiline (get-text-property (point) 'helm-multiline))) - (funcall func) - (forward-line 0) - (and realvalue - (put-text-property (point) (pos-eol) - 'helm-realvalue realvalue)) - (and multiline - (put-text-property (point) - (or (helm-get-next-candidate-separator-pos) - (point-max)) - 'helm-multiline multiline)) - (helm-mark-current-line)))) - -(defmacro helm-edit-current-selection (&rest forms) - "Evaluate FORMS at current selection in the helm buffer. -Used generally to modify current selection." - (declare (indent 0) (debug t)) - `(helm--edit-current-selection-internal - (lambda () ,@forms))) - -(defun helm--delete-minibuffer-contents-from (from-str &optional presel) - ;; Giving an empty string value to FROM-STR delete all. - (let ((input (minibuffer-contents)) - (src (and presel (helm-get-current-source))) - (helm--deleting-minibuffer-contents-from presel) - helm-move-to-line-cycle-in-source) - (helm-reset-yank-point) - (unless (zerop (length input)) - ;; minibuffer is not empty, delete contents from end - ;; or FROM-STR and update. - (helm-set-pattern from-str t) - (setq helm-input from-str) ; Needed by helm-fuzzy-matching-highlight-fn. - (helm-update presel src)))) - -(defun helm-delete-minibuffer-contents (&optional arg) - "Delete minibuffer contents. -When `helm-delete-minibuffer-contents-from-point' is non-nil, delete -minibuffer contents from point instead of deleting all. When at the end -of minibuffer, delete all but if a prefix ARG were given also preselect -current selection when updating if possible (selection may be beyond -candidate-number-limit, or display may have completely changed e.g. HFF)." - (interactive "P") - (with-helm-alive-p - (let ((str (if (or (eobp) (not helm-delete-minibuffer-contents-from-point)) - "" (helm-minibuffer-completion-contents))) - (presel (and arg - (concat "^" (regexp-quote (helm-get-selection nil t)) "$")))) - (helm--delete-minibuffer-contents-from str presel)))) -(put 'helm-delete-minibuffer-contents 'no-helm-mx t) - - -;;; helm-source-in-buffer. -;; -(defun helm-candidates-in-buffer (&optional source) - "The top level function used to store candidates with `helm-source-in-buffer'. - -Candidates are stored in a buffer generated internally by -`helm-candidate-buffer' function. Each candidate must be placed -in one line. - -The buffer is created and fed in the init attribute function of -Helm. - -E.g.: - - (helm-build-in-buffer-source \"test\" - :init (lambda () - (helm-init-candidates-in-buffer - \\='global \\='(foo foa fob bar baz)))) - -A shortcut can be used to simplify: - - (helm-build-in-buffer-source \"test\" - :data \\='(foo foa fob bar baz)) - -By default, Helm makes candidates by evaluating the candidates -function, then narrows them by `string-match' for each candidate. - -But this is slow for large number of candidates. The new way is -to store all candidates in a buffer and then narrow with -`re-search-forward'. Search function is customizable by search -attribute. The important point is that buffer processing is MUCH -FASTER than string list processing and is the Emacs way. - -The init function writes all candidates to a newly-created -candidate buffer. The candidates buffer is created or specified -by `helm-candidate-buffer'. Candidates are stored in a line. - -The candidates function narrows all candidates, IOW creates a -subset of candidates dynamically. - -Class `helm-source-in-buffer' is implemented with three attributes: - - (candidates . helm-candidates-in-buffer) - (volatile) - (match identity) - -The volatile attribute is needed because -`helm-candidates-in-buffer' creates candidates dynamically and -need to be called every time `helm-pattern' changes. - -Because `helm-candidates-in-buffer' plays the role of `match' -attribute function, specifying `(match identity)' makes the -source slightly faster. - -However if source contains `match-part' attribute, match is -computed only on part of candidate returned by the call of -function provided by this attribute. The function should have one -arg, candidate, and return only a specific part of candidate. - -To customize `helm-candidates-in-buffer' behaviour, use `search', -`get-line' and `match-part' attributes." - (let ((src (or source (helm-get-current-source)))) - (helm-candidates-in-buffer-1 - (helm-candidate-buffer) - helm-pattern - (or (assoc-default 'get-line src) - #'buffer-substring-no-properties) - (or (assoc-default 'search src) - '(helm-candidates-in-buffer-search-default-fn)) - ;; When candidate-transformer is specified in source ALL candidates should - ;; be computed with the candidate-transformer function (in contrast with - ;; filtered-candidate-transformer). This to be consistent with what sync - ;; sources do. The car of the cons is used for initial fetching of - ;; candidates whereas the cdr is used after when searching (in this case - ;; the candidate number limit is used). - (if (helm-get-attr 'candidate-transformer src) - (cons 99999999 (helm-candidate-number-limit src)) - (helm-candidate-number-limit src)) - (helm-get-attr 'match-part) - src))) - -(defun helm-candidates-in-buffer-search-default-fn (pattern) - "Search PATTERN with `re-search-forward' with bound and noerror args." - (condition-case _err - ;; Use helm-re-search-forward to avoid infloop (bug#2657). - (helm-re-search-forward pattern nil t) - (invalid-regexp nil))) - -(defun helm-candidates-in-buffer-1 (buffer pattern get-line-fn - search-fns limit - match-part-fn source) - "Return the list of candidates inserted in BUFFER matching PATTERN." - (with-suppressed-warnings ((obsolete inhibit-point-motion-hooks)) - ;; buffer == nil when candidates buffer does not exist. - (when buffer - (with-current-buffer buffer - (let ((inhibit-point-motion-hooks t) - (start-point (1- (point-min)))) - (goto-char start-point) - (if (string= pattern "") - (helm-initial-candidates-from-candidate-buffer - get-line-fn (if (consp limit) (car limit) limit)) - (helm-search-from-candidate-buffer - pattern get-line-fn search-fns - (if (consp limit) (cdr limit) limit) - start-point match-part-fn source))))))) - - -(defun helm-search-from-candidate-buffer (pattern get-line-fn search-fns - limit start-point match-part-fn source) - (let ((inhibit-read-only t) - (diacritics (assoc-default 'diacritics source))) - (helm--search-from-candidate-buffer-1 - (lambda () - (cl-loop with hash = (make-hash-table :test 'equal) - with allow-dups = (assq 'allow-dups source) - with case-fold-search = (helm-set-case-fold-search) - with count = 0 - for iter from 1 - for searcher in search-fns - do (progn - (goto-char start-point) - ;; The character at start-point is a newline, - ;; if pattern match it that's mean we are - ;; searching for newline in buffer, in this - ;; case skip this false line. - ;; See comment >>>[1] in - ;; `helm--search-from-candidate-buffer-1'. - (and (condition-case nil - (looking-at pattern) - (invalid-regexp nil)) - (forward-line 1))) - nconc - (cl-loop with pos-lst - ;; POS-LST is used as a flag to decide if we - ;; run `helm-search-match-part' even if - ;; MATCH-PART isn't specified on source. This - ;; happen when fuzzy matching or using a - ;; negation (!) in one of the patterns, in - ;; these case the searcher returns a list - ;; '(BEG END) instead of an integer like - ;; `re-search-forward'. - while (and (setq pos-lst (funcall searcher pattern)) - ;; We were previously forwarding line from - ;; searcher and checking then for eobp, as a - ;; result the last candidate was always - ;; skipped. See bug#2650. - (if (consp pos-lst) - ;; With negation the searcher is not - ;; forwarding line, we do it from here. - ;; If forward-line doesn't return zero, - ;; we are at eob. - (zerop (forward-line 1)) - (not (eobp))) - (< count limit)) - for cand = (apply get-line-fn - (if (and pos-lst (listp pos-lst)) - pos-lst - (list (pos-bol) (pos-eol)))) - when (and match-part-fn - (not (get-text-property 0 'match-part cand))) - do (setq cand - (propertize cand 'match-part (funcall match-part-fn cand))) - for dup = (gethash cand hash) - when (and (or (and allow-dups dup (= dup iter)) - (null dup)) - ;; Happens with (buffer-substring 1 1) when - ;; setting cand above (bug#2651) and create a - ;; ghost candidate on top. - (not (string= cand "")) - (or - ;; Always collect when cand is matched - ;; by searcher funcs and match-part attr - ;; is not present. - (and (not match-part-fn) - (not (consp pos-lst))) - ;; If match-part attr is present, or if SEARCHER fn - ;; returns a cons cell, collect PATTERN only if it - ;; matches the part of CAND specified by - ;; the match-part func. - (helm-search-match-part cand pattern diacritics))) - do (progn - (puthash cand iter hash) - (setq cand (helm--maybe-process-filter-one-by-one-candidate - cand source)) - (cl-incf count)) - and collect cand)))))) - -(defun helm-search-match-part (candidate pattern diacritics) - "Match PATTERN only on match-part property value of CANDIDATE. - -Because `helm-search-match-part' may be called even if -unspecified in source (negation or fuzzy), the part to match -falls back to the whole candidate even if match-part hasn't been -computed by match-part-fn and stored in the match-part property." - (let ((part (or (get-text-property 0 'match-part candidate) - candidate)) - (fuzzy-regexp (cadr (gethash 'helm-pattern helm--fuzzy-regexp-cache))) - (matchfn (cond (helm-migemo-mode 'helm-mm-migemo-string-match) - (diacritics 'helm-mm-diacritics-string-match) - (t 'string-match)))) - (condition-case _err - (if (string-match " " pattern) - ;; FIXME use helm-mm-3-match here. - (cl-loop for i in (helm-mm-split-pattern pattern) always - (if (string-match "\\`!" i) - (not (funcall matchfn (substring i 1) part)) - (funcall matchfn i part))) - ;; A pattern with no spaces that starts with "!". - (if (string-match "\\`!" pattern) - (if helm--in-fuzzy - ;; Fuzzy regexp have already been - ;; computed with substring 1 i.e. the leading "!" has been - ;; removed. - (not (string-match fuzzy-regexp part)) - (not (funcall matchfn (substring pattern 1) part))) - (funcall matchfn (if helm--in-fuzzy fuzzy-regexp pattern) part))) - (invalid-regexp nil)))) - -(defun helm-initial-candidates-from-candidate-buffer (get-line-fn limit) - (cl-loop repeat limit - until (eobp) - for line = (funcall get-line-fn (pos-bol) (pos-eol)) - when line collect line - do (forward-line 1))) - -(defun helm--search-from-candidate-buffer-1 (search-fn) - ;; We are adding a newline at bob and at eol - ;; and removing these newlines afterward. - ;; This is a bad hack that should be removed. - ;; To avoid matching the empty line at first line - ;; when searching with e.g occur and "^$" just - ;; forward-line before searching (See >>>[1] above). - (goto-char (point-min)) - (insert "\n") - (goto-char (point-max)) - (insert "\n") - (unwind-protect - (funcall search-fn) - (goto-char (point-min)) - (delete-char 1) - (goto-char (1- (point-max))) - (delete-char 1) - (set-buffer-modified-p nil))) - -(defun helm-candidate-buffer (&optional buffer-spec) - "Register and return a buffer storing candidates of current source. - -This is used to initialize a buffer for storing candidates for a -candidates-in-buffer source, candidates will be searched in this -buffer and displayed in `helm-buffer'. This should be used only -in init functions, don't relay on this in other places unless you -know what you are doing. - -This function is still in public API only for backward -compatibility, you should use instead -`helm-init-candidates-in-buffer' for initializing your sources. - -Internally, this function is called without argument and returns -the buffer corresponding to current source i.e. -`helm--source-name' which is available in only some places. - -Acceptable values of BUFFER-SPEC: - -- global (a symbol) - Create a new global candidates buffer, - named \" *helm candidates:SOURCE*\". - This is used by `helm-init-candidates-in-buffer' and it is - the most common usage of BUFFER-SPEC. - The buffer will be killed and recreated at each new - helm-session. - -- local (a symbol) - Create a new local candidates buffer, - named \" *helm candidates:SOURCE*HELM-CURRENT-BUFFER\". - You may want to use this when you want to have a different - buffer each time source is used from a different - `helm-current-buffer'. - The buffer is erased and refilled at each new session but not - killed. You probably don't want to use this value for - BUFFER-SPEC. - -- nil (omit) - Only return the candidates buffer of current source if found. - -- A buffer - Register a buffer as a candidates buffer. - The buffer needs to exists, it is not created. - This allow you to use the buffer as a cache, it is faster - because the buffer is already drawn, but be careful when using - this as you may mangle your buffer depending on what you write - in your init(s) function, IOW don't modify the contents of the - buffer in init(s) function but in a transformer. - The buffer is not erased nor deleted. - Generally it is safer to use a copy of buffer inserted - in a global or local buffer. - -If for some reasons a global buffer and a local buffer exist and -are belonging to the same source, the local buffer takes -precedence on the global one and is used instead. - -When forcing update only the global and local buffers are killed -before running again the init function." - (let ((global-bname (format " *helm candidates:%s*" - helm--source-name)) - (local-bname (format " *helm candidates:%s*%s" - helm--source-name - (buffer-name helm-current-buffer)))) - (when buffer-spec - ;; Register buffer in `helm--candidate-buffer-alist'. - ;; This is used only to retrieve buffer associated to current source - ;; when using named buffer as value of BUFFER-SPEC. - (setq helm--candidate-buffer-alist - (cons (cons helm--source-name buffer-spec) - (delete (assoc helm--source-name - helm--candidate-buffer-alist) - helm--candidate-buffer-alist))) - ;; When using global or local as value of BUFFER-SPEC - ;; create the buffer global-bname or local-bname, otherwise - ;; reuse the buffer named BUFFER-SPEC. - (unless (bufferp buffer-spec) - ;; Global buffers are killed and recreated. - (and (eq buffer-spec 'global) - (buffer-live-p (get-buffer global-bname)) - (kill-buffer global-bname)) - ;; Create global or local buffer. - ;; Local buffer, once created are reused and a new one - ;; is created when `helm-current-buffer' change across sessions. - (with-current-buffer (get-buffer-create - (helm-acase buffer-spec - (global global-bname) - (local local-bname) - (t (and (stringp buffer-spec) - buffer-spec)))) - ;; We need a buffer not read-only to perhaps insert later - ;; text coming from read-only buffers (Bug#1176). - (set (make-local-variable 'buffer-read-only) nil) - ;; Undo is automatically disabled in buffer names starting - ;; with a space, so no need to disable it. - (erase-buffer) - (font-lock-mode -1)))) - ;; Finally return the candidates buffer. - (helm-acond ((get-buffer local-bname)) - ((get-buffer global-bname)) - ((assoc-default helm--source-name helm--candidate-buffer-alist) - (and (or (stringp it) (bufferp it)) - (buffer-live-p (get-buffer it)) - it))))) - -(defvar helm-candidate-buffer-longest-len 0 - "May store the longest length of candidates in a in-buffer source. -It is a local variable set from `helm-init-candidates-in-buffer' in -`helm-candidate-buffer'. -Allow getting the longest length of initial candidates in transformers -without looping again through the whole list. -It is useful to align extra informations after candidates in `helm-buffer'.") - -(defsubst helm-in-buffer-get-longest-candidate () - "Return the longest candidate recorded in `helm-candidate-buffer'." - (helm-aif (helm-candidate-buffer) - (buffer-local-value - 'helm-candidate-buffer-longest-len - (get-buffer it)) - 0)) - -(defun helm-make-separator (cand &optional longest) - "Create a separator to align candidates. -Longest candidate should have been calculated at initialization -of `helm-source-in-buffer' by `helm-init-candidates-in-buffer' , otherwise -LONGEST can be used to specify longest candidate." - (let ((lgst (or longest (helm-in-buffer-get-longest-candidate))) - (len (length cand))) - (if (zerop lgst) - " -- " ; For emacs style. - (make-string (1+ (if (>= lgst len) - (- lgst len) - 0)) - ? )))) - -(defun helm-init-candidates-in-buffer (buffer-spec data &optional force-longest) - "Register BUFFER-SPEC with DATA for a helm candidates-in-buffer session. - -Arg BUFFER-SPEC can be a `buffer-name' (stringp), a buffer-spec -object (bufferp), or a symbol, either \\='local or \\='global which is -passed to `helm-candidate-buffer'. -The most common usage of BUFFER-SPEC is \\='global. - -Arg DATA can be either a list or a plain string. -Returns the resulting buffer. - -Use this in your init function to register a buffer for a -`helm-source-in-buffer' session and feed it with DATA. You -probably don't want to bother with this and use the :data slot -when initializing a source with `helm-source-in-buffer' class. - -When inserting DATA in `helm-candidate-buffer', if DATA is a list the longest -candidate will be recorded in `helm-candidate-buffer-longest-len' local -variable. If DATA is a string, it is inserted directly in -`helm-candidate-buffer' and `helm-candidate-buffer-longest-len' is not computed -unless FORCE-LONGEST is non nil." - (declare (indent 1)) - (let ((caching (and (or (stringp buffer-spec) - (bufferp buffer-spec)) - (buffer-live-p (get-buffer buffer-spec)))) - (buf (helm-candidate-buffer buffer-spec))) - (unless caching - (with-current-buffer buf - (erase-buffer) - (cond ((listp data) - (insert (mapconcat (lambda (elm) - (let ((cand - (helm-acase elm - ((guard* (symbolp it)) - (symbol-name it)) - ((guard* (numberp it)) - (number-to-string it)) - ((dst* (disp . real)) - (propertize disp 'helm-realvalue real)) - (t it)))) - (setq-local helm-candidate-buffer-longest-len - (max helm-candidate-buffer-longest-len - (length cand))) - cand)) - data "\n"))) - ((stringp data) - (insert data) - (when force-longest - (setq-local helm-candidate-buffer-longest-len - (helm--get-longest-len-in-buffer)))))) - buf))) - -(defun helm--get-longest-len-in-buffer () - "Return length of the longest line in buffer." - (save-excursion - (goto-char (point-min)) - (let ((max 0) - len) - (while (not (eobp)) - (setq len (- (pos-eol) (pos-bol))) - (when (> len max) - (setq max len)) - (forward-line 1)) - max))) - - -;;; Actions on helm window -;; -;; -(defvar helm--resplit-window-iterator nil) -(defun helm-resplit-window-clockwise () - "Change the window split to move Helm window clockwise w.r.t the main window. -See `helm-resplit-window-1'." - (interactive) - (helm-resplit-window-1 1)) -(put 'helm-resplit-window-clockwise 'helm-only t) - -(defun helm-resplit-window-counterclockwise () - "Change the window split to move Helm window counterclockwise. -See `helm-resplit-window-1'." - (interactive) - (helm-resplit-window-1 -1)) -(put 'helm-resplit-window-counterclockwise 'helm-only t) - -(defun helm-resplit-window-1 (arg) - "Change the window split to move Helm window. - -At each call of this function, change the window split w.r.t the main -window to left, above, right or below direction remembering your -previous movement, this when there is only two windows. Split direction -is clockwise if ARG is positive and counterclockwise if -negative. Otherwise when there is more than two windows and the helm -buffer is displayed in one of those windows i.e. `helm-always-two-windows' is -nil, the helm buffer is moved in the next or previous window according to ARG -value." - (with-helm-alive-p - (cond ((> (length (window-list nil 1)) 2) - (helm-swap-windows arg)) - ((and (= (length (window-list nil 1)) 2) - (not (window-dedicated-p - (get-buffer-window helm-current-buffer)))) - (when helm-prevent-escaping-from-minibuffer - (helm-prevent-switching-other-window :enabled nil)) - (unwind-protect - (with-helm-window - (cond ((or helm-full-frame (one-window-p t)) - (user-error "Attempt to resplit a single window")) - ((helm-action-window) - (user-error "Can't resplit while selecting actions")) - ((window-parameter - (get-buffer-window helm-current-buffer) 'window-slot) - (user-error "Can't resplit a side window")) - (t (helm--resplit-window arg)))) - (when helm-prevent-escaping-from-minibuffer - (helm-prevent-switching-other-window :enabled t)))) - (t (error "current window configuration not suitable for splitting"))))) - -(defun helm--resplit-window (arg) - (let ((current-state (helm--get-window-side-state)) - new-state) - (unless (and (eq last-command this-command) - (eq current-state helm--window-side-state)) - (setq helm--resplit-window-iterator - (helm-iter-circular (helm--resplit-window-sides - current-state arg)))) - (setq new-state (helm-iter-next helm--resplit-window-iterator) - helm-split-window-state (helm-acase new-state - ((right left) 'horizontal) - ((below above) 'vertical))) - (delete-window) - (set-window-buffer - (select-window - (split-window (selected-window) nil new-state)) - helm-buffer) - (setq helm--window-side-state (helm--get-window-side-state)))) - -(defun helm--resplit-window-sides (state arg) - (let ((clockwise (helm-acase state - (right '(below left above)) - (left '(above right below)) - (below '(left above right)) - (above '(right below left))))) - (append (if (< arg 0) (reverse clockwise) clockwise) - (list state)))) - -;; Resize helm window. -(defun helm-enlarge-window-1 (n) - "Enlarge or narrow helm window. -If N is positive enlarge, if negative narrow." - (unless helm-full-frame - (let ((horizontal-p (eq helm-split-window-state 'horizontal))) - (with-helm-window - (enlarge-window n horizontal-p))))) - -(defun helm-narrow-window () - "Narrow helm window." - (interactive) - (with-helm-alive-p - (helm-enlarge-window-1 -1))) -(put 'helm-narrow-window 'helm-only t) - -(defun helm-enlarge-window () - "Enlarge helm window." - (interactive) - (with-helm-alive-p - (helm-enlarge-window-1 1))) -(put 'helm-enlarge-window 'helm-only t) - -(defun helm-toggle-full-frame (&optional arg) - "Toggle `helm-buffer' full-frame view." - (interactive "p") - (cl-assert (null (helm-action-window)) - nil "Unable to toggle full frame from action window") - (when arg ; Called interactively - (cl-assert (null helm--buffer-in-new-frame-p) - nil "Can't toggle full frame when using helm own frame")) - (if (or helm-onewindow-p - (buffer-local-value 'helm-full-frame (get-buffer helm-buffer))) - (with-helm-window - (setq-local helm-full-frame nil) - (setq helm-onewindow-p nil) - (let ((split-window-preferred-function - helm-split-window-preferred-function)) - (switch-to-buffer helm-current-buffer) - (helm-display-buffer helm-buffer) - (select-window (minibuffer-window)))) - (with-helm-window - (delete-other-windows) - (setq-local helm-full-frame t) - (setq helm-onewindow-p t)))) -(put 'helm-toggle-full-frame 'helm-only t) - -(defun helm-swap-windows (&optional arg) - "Swap window holding `helm-buffer' with other windows. -Start swapping in the same order of windows as window-list." - (interactive "p") - (with-helm-alive-p - (cond ((and helm-full-frame (one-window-p t)) - (user-error "Can't swap windows in a single window")) - ((helm-action-window) - (user-error "Can't swap windows while selecting actions")) - ((window-parameter (get-buffer-window helm-current-buffer) 'window-slot) - (user-error "Can't swap with a side window")) - (t - (let* ((w1 (helm-window)) - (split-state (eq helm-split-window-state 'horizontal)) - (w1size (window-total-size w1 split-state)) - (b1 (window-buffer w1)) ; helm-buffer - (s1 (window-start w1)) - (cur-frame (window-frame w1)) - (w2 (with-selected-window (helm-window) - ;; Don't try to display helm-buffer - ;; in a dedicated window. - (helm--get-window-with-predicate - (lambda (w) (not (window-dedicated-p w))) - 1 cur-frame nil arg))) - (w2size (window-total-size w2 split-state)) - (b2 (window-buffer w2)) ; probably helm-current-buffer - (s2 (window-start w2)) - resize) - (with-selected-frame (window-frame w1) - (helm-replace-buffer-in-window w1 b1 b2) - (helm-replace-buffer-in-window w2 b2 b1) - (setq resize - (cond (;; helm-window is smaller than other window. - (< w1size w2size) - (- (- (max w2size w1size) - (min w2size w1size)))) - (;; helm-window is larger than other window. - (> w1size w2size) - (- (max w2size w1size) - (min w2size w1size))) - (;; windows have probably same size. - t nil))) - ;; Maybe resize the window holding helm-buffer. - (and resize (window-resize w2 resize split-state)) - (set-window-start w1 s2 t) - (set-window-start w2 s1 t)) - (setq helm--window-side-state (helm--get-window-side-state) - helm--resplit-window-iterator nil)))))) -(put 'helm-swap-windows 'helm-only t) - -(defun helm--get-window-with-predicate (predicate &optional minibuf all-frames default arg) - "Same as `get-window-with-predicate' but allow changing direction with ARG." - (catch 'found - (dolist (window (window-list-1 - (if (< arg 0) - (previous-window nil minibuf all-frames) - (next-window nil minibuf all-frames)) - minibuf all-frames)) - (when (funcall predicate window) - (throw 'found window))) - default)) - -(defun helm--get-window-side-state () - "Return the position of `helm-window' w.r.t main window. -Main window can be the window handling `helm-current-buffer' but also the -persistent action window. -Possible values are \\='left \\='right \\='below or \\='above." - (let ((side-list '(left right below above))) - (cl-loop for side in side-list - thereis (and (equal (helm-window) - (window-in-direction - side (or (get-buffer-window helm-current-buffer t) - (helm-persistent-action-display-window)) - t)) - side)))) - -(defun helm-replace-buffer-in-window (window buffer1 buffer2) - "Replace BUFFER1 by BUFFER2 in WINDOW registering BUFFER1." - (when (get-buffer-window buffer1) - (unrecord-window-buffer window buffer1) - (set-window-buffer window buffer2))) - -;; select another action by key -(defun helm-select-nth-action (n) - "Select the N nth action for the currently selected candidate." - (let ((src (helm-get-current-source))) - (setq helm-saved-selection (helm-get-selection nil nil src)) - (unless helm-saved-selection - (error "Nothing is selected")) - (setq helm-saved-action - (helm-get-nth-action - n - (if (get-buffer-window helm-action-buffer 'visible) - (assoc-default 'candidates src) - (helm-get-actions-from-current-source src)))) - (helm-maybe-exit-minibuffer))) - -(defun helm-get-nth-action (n action) - "Return the nth N action from ACTION. -Argument ACTION can be a symbol or a list of actions." - (cond ((and (zerop n) (functionp action)) - action) - ((listp action) - (or (cdr (elt action n)) - (error "No such action"))) - ((and (functionp action) (> n 0)) - (error "Sole action")) - (t - (error "Error in `helm-select-nth-action'")))) - -(defun helm-execute-selection-action-at-nth (linum) - "Execute default action on candidate at LINUM lines from selection." - (let ((prefarg current-prefix-arg)) - (if (>= linum 0) - (helm-next-line linum) - (helm-previous-line (lognot (1- linum)))) - (setq current-prefix-arg prefarg) - (helm-exit-minibuffer))) - -;;; Persistent Action -;; -(defun helm-initialize-persistent-action () - (set (make-local-variable 'helm-persistent-action-display-window) nil)) - -(defun helm-execute-persistent-action (&optional attr split) - "Perform the associated action ATTR without quitting helm. - -Arg ATTR default will be `persistent-action' or -`persistent-action-if' if unspecified depending on what's found -in source, but it can be anything else. -In this case you have to add this new attribute to your source. -See `persistent-action' and `persistent-action-if' slot -documentation in `helm-source'. - -When `helm-full-frame' is non-nil, and `helm-buffer' is displayed -in only one window, the helm window is split to display -`helm-select-persistent-action-window' in other window to -maintain visibility. The argument SPLIT can be used to force -splitting inconditionally, it is unused currently." - (interactive) - (catch 'ignore - (with-suppressed-warnings ((obsolete special-display-regexps) - (obsolete special-display-buffer-names)) - (with-helm-alive-p - (let ((source (helm-get-current-source))) - (unless attr - (setq attr (or (car (assq 'persistent-action source)) - (car (assq 'persistent-action-if source))))) - (helm-log "helm-execute-persistent-action" "executing persistent-action") - (let* ((selection (and source (helm-get-selection nil nil source))) - (attr-val (if (eq attr 'persistent-action-if) - (funcall (assoc-default attr source) selection) - (assoc-default attr source))) - ;; If attr value is a cons, use its car as persistent function. - (fn (if (and (consp attr-val) - ;; maybe a lambda. - (not (functionp attr-val))) - (car attr-val) attr-val)) - ;; And its cdr to decide if helm window should be splitted. - (no-split (and (consp attr-val) - (not (functionp attr-val)) - (cdr attr-val))) - ;; Is next-window (from helm-window) a suitable window for PA? - (no-suitable-win - (helm-aand (not helm--buffer-in-new-frame-p) - (get-buffer-window helm-current-buffer) - (or (window-dedicated-p it) - (window-parameter it 'window-side)))) - (cursor-in-echo-area t) - mode-line-in-non-selected-windows) - (progn - (when (and helm-onewindow-p (null no-split) - (null helm--buffer-in-new-frame-p)) - (helm-toggle-full-frame)) - (when (eq fn 'ignore) - (throw 'ignore nil)) - (when source - (with-helm-window - (save-selected-window - ;; FIXME: Simplify SPLIT behavior, it is a mess currently. - (if no-split - (helm-select-persistent-action-window :split 'never) - (helm-select-persistent-action-window - :split (or split helm-onewindow-p no-suitable-win))) - (helm-log "helm-execute-persistent-action" - "current-buffer = %S" (current-buffer)) - (let ((helm-in-persistent-action t) - (display-buffer-alist '((".*" (display-buffer-same-window)))) - display-buffer-function pop-up-windows pop-up-frames - special-display-regexps special-display-buffer-names) - (helm-execute-selection-action-1 - selection (or fn (helm-get-actions-from-current-source source)) t) - (unless (helm-action-window) - (helm-log-run-hook "helm-execute-persistent-action" - 'helm-after-persistent-action-hook))) - ;; A typical case is when a persistent action delete - ;; the buffer already displayed in - ;; `helm-persistent-action-display-window' and `helm-full-frame' - ;; is enabled, we end up with the `helm-buffer' - ;; displayed in two windows. - (when (and helm-onewindow-p - (> (length (window-list)) 1) - (equal (buffer-name - (window-buffer - helm-persistent-action-display-window)) - (helm-buffer-get))) - (delete-other-windows)))))))))))) -(put 'helm-execute-persistent-action 'helm-only t) - -(cl-defun helm-persistent-action-display-window (&key split) - "Return the window that will be used for persistent action. -If SPLIT is t window is split in persistent action, if it has the -special symbol `never' don't split, if it is nil don't split either. -The symbol `never' is kept for backward compatibility." - (with-helm-window - (setq helm-persistent-action-display-window - (cond ((and (window-live-p helm-persistent-action-display-window) - (not (member helm-persistent-action-display-window - (get-buffer-window-list helm-buffer)))) - helm-persistent-action-display-window) - ((and helm--buffer-in-new-frame-p helm-initial-frame) - (with-selected-frame helm-initial-frame - (let ((win (selected-window))) - (if (or (window-dedicated-p win) - (window-parameter win 'window-side)) - (next-window win 1) - win)))) - ((and split (not (eq split 'never))) - (split-window)) - ((get-buffer-window helm-current-buffer)) - (t (previous-window (selected-window) 1)))))) - -(cl-defun helm-select-persistent-action-window (&key split) - "Select the window that will be used for persistent action. -See `helm-persistent-action-display-window' for how to use SPLIT." - (select-window (get-buffer-window (helm-buffer-get))) - (prog1 - (select-window - (setq minibuffer-scroll-window - (helm-persistent-action-display-window :split split)) - 'norecord) - (helm-log "helm-select-persistent-action-window" - "Selected window is %S" minibuffer-scroll-window))) - -;;; Scrolling - recentering -;; -;; -(defun helm-other-window-base (command &optional arg) - (let ((minibuffer-scroll-window - (helm-persistent-action-display-window))) - (funcall command (or arg helm-scroll-amount)))) - -(defun helm-scroll-other-window (&optional arg) - "Scroll other window upward ARG many lines. -When arg is not provided scroll `helm-scroll-amount' lines. -See `scroll-other-window'." - (interactive "P") - (with-helm-alive-p (helm-other-window-base 'scroll-other-window arg))) -(put 'helm-scroll-other-window 'helm-only t) - -(defun helm-scroll-other-window-down (&optional arg) - "Scroll other window downward ARG many lines. -When arg is not provided scroll `helm-scroll-amount' lines. -See `scroll-other-window-down'." - (interactive "P") - (with-helm-alive-p (helm-other-window-base 'scroll-other-window-down arg))) -(put 'helm-scroll-other-window-down 'helm-only t) - -(defun helm-recenter-top-bottom-other-window (&optional arg) - "Run `recenter-top-bottom' in other window. -Meaning of prefix ARG is the same as in `recenter-top-bottom'." - (interactive "P") - (with-helm-alive-p - (with-helm-window - (with-selected-window (helm-persistent-action-display-window) - (recenter-top-bottom arg))))) -(put 'helm-recenter-top-bottom-other-window 'helm-only t) - -(defun helm-reposition-window-other-window (&optional arg) - "Run `reposition-window' in other window. -Meaning of prefix ARG is the same as in `reposition-window'." - (interactive "P") - (with-helm-alive-p - (with-helm-window - (with-selected-window (helm-persistent-action-display-window) - (reposition-window arg))))) -(put 'helm-reposition-window-other-window 'helm-only t) - - -;; Visible Mark - -(defun helm-clear-visible-mark () - (with-current-buffer (helm-buffer-get) - (mapc 'delete-overlay helm-visible-mark-overlays) - (set (make-local-variable 'helm-visible-mark-overlays) nil))) - -(defun helm-this-visible-mark () - (cl-loop for o in (overlays-at (point)) - when (overlay-get o 'visible-mark) - return o)) - -(defun helm-delete-visible-mark (overlay) - (let ((src (helm-get-current-source))) - (setq helm-marked-candidates - (remove - (cons src (helm-get-selection nil nil src)) - helm-marked-candidates)) - (delete-overlay overlay) - (setq helm-visible-mark-overlays - (delq overlay helm-visible-mark-overlays)))) - -(defun helm-make-visible-mark (&optional src selection) - (let* ((source (or src (helm-get-current-source))) - (sel (or selection (helm-get-selection - nil (helm-get-attr 'marked-with-props source) - source))) - (selection-end (if (helm-pos-multiline-p) - ;; Stays within source - (or (helm-get-next-candidate-separator-pos) - (helm-get-next-header-pos) - (point-max)) - ;; Not multiline - (1+ (pos-eol)))) - (o (make-overlay (pos-bol) selection-end))) - (overlay-put o 'priority 0) - (overlay-put o 'face 'helm-visible-mark) - (overlay-put o 'source source) - (overlay-put o 'string (buffer-substring (overlay-start o) (overlay-end o))) - (overlay-put o 'real sel) - (overlay-put o 'before-string (propertize " " 'display - `((margin left-margin) - ,(propertize - helm-visible-mark-prefix - 'face 'helm-mark-prefix)))) - (overlay-put o 'visible-mark t) - (overlay-put o 'evaporate t) - (cl-pushnew o helm-visible-mark-overlays) - (push (cons source sel) helm-marked-candidates))) - -(defun helm-toggle-visible-mark (arg) - "Toggle Helm visible mark at point ARG times. -If ARG is negative toggle backward." - (interactive "p") - (with-helm-alive-p - (with-helm-window - (let ((nomark (assq 'nomark (helm-get-current-source))) - (next-fns (if (< arg 0) - '(helm-beginning-of-source-p . helm-previous-line) - '(helm-end-of-source-p . helm-next-line)))) - (if nomark - (message "Marking not allowed in this source") - (cl-loop with n = (if (< arg 0) (* arg -1) arg) - repeat n do - (progn - (helm-aif (helm-this-visible-mark) - (helm-delete-visible-mark it) - (helm-make-visible-mark)) - (if (funcall (car next-fns)) - (progn - (helm-display-mode-line (helm-get-current-source)) - (cl-return nil)) - (funcall (cdr next-fns))))) - (set-window-margins (selected-window) - (if helm-visible-mark-overlays - (+ (string-width helm-visible-mark-prefix) - helm-left-margin-width) - helm-left-margin-width))))))) -(put 'helm-toggle-visible-mark 'helm-only t) - -(defun helm-toggle-visible-mark-forward (&optional arg) - "Toggle visible mark forward ARG times." - (interactive "p") - (helm-toggle-visible-mark arg)) - -(defun helm-toggle-visible-mark-backward (&optional arg) - "Toggle visible mark backward ARG times." - (interactive "p") - (helm-toggle-visible-mark (- arg))) - -(defun helm-file-completion-source-p (&optional source) - "Return non-nil if current source is a file completion source." - (or helm--completing-file-name ; helm-read-file-name - (let ((cur-source (cdr (assq 'name - (or source (helm-get-current-source)))))) - (cl-loop for i in helm--file-completion-sources - thereis (string= cur-source i))))) - -(defun helm-mark-all (&optional all) - "Mark all visible unmarked candidates in current source. - -With a prefix arg mark all visible unmarked candidates in all -sources." - (interactive "P") - (with-helm-alive-p - (with-helm-window ; Using `with-helm-buffer' for some unknow - ; reasons infloop. - (set-window-margins (selected-window) - (+ (string-width helm-visible-mark-prefix) - helm-left-margin-width)) - (if (null all) - (helm-mark-all-1 t) - (let ((pos (point))) - (goto-char (point-min)) - (helm-awhile (helm-get-next-header-pos) - (goto-char it) - (forward-line 1) - (helm-mark-current-line) - (helm-mark-all-1)) - ;; `save-excursion' seems confused if used in addition of - ;; the one used in `helm-mark-all-1', so save POS and back - ;; to it when loop is finished. - (goto-char pos) - (helm-mark-current-line) - (helm-display-mode-line (helm-get-current-source) t)))))) -(put 'helm-mark-all 'helm-only t) - -(defun helm-mark-all-1 (&optional ensure-beg-of-source) - "Mark all visible unmarked candidates in current source. -Need to be wrapped in `with-helm-window'. -Arg ENSURE-BEG-OF-SOURCE ensure we are at beginning of source -when starting to mark candidates, if handled elsewhere before -starting it is not needed." - (let* ((src (helm-get-current-source)) - (follow (if (helm-follow-mode-p src) 1 -1)) - (nomark (assq 'nomark src)) - (src-name (assoc-default 'name src)) - (filecomp-p (or (helm-file-completion-source-p src) - (string= src-name "Files from Current Directory")))) - (helm-follow-mode -1) - (unwind-protect - (if nomark - (user-error "Marking not allowed in this source") - (save-excursion - (when ensure-beg-of-source - (goto-char (helm-get-previous-header-pos)) - (forward-line 1)) - (let* ((next-head (helm-get-next-header-pos)) - (end (and next-head - (save-excursion - (goto-char next-head) - (forward-line -1) - (point)))) - (maxpoint (or end (point-max)))) - (while (< (point) maxpoint) - (helm-mark-current-line) - (let* ((prefix (or (get-text-property (pos-bol) 'helm-new-file) - (get-text-property (pos-bol) 'unknown))) - (cand (helm-get-selection - nil (helm-get-attr 'marked-with-props src) - src)) - (bn (and filecomp-p (helm-basename cand)))) - ;; Don't mark possibles directories ending with . or .. - ;; autosave files/links and non--existent files. - (unless - (or (helm-this-visible-mark) - ;; Non existing files in HFF and - ;; RFN. Display may be an image. See - ;; https://github.com/yyoncho/helm-treemacs-icons/issues/5 - ;; and also Bug#2296. - prefix - (and filecomp-p (member bn '("." "..")))) - (helm-make-visible-mark src cand))) - (when (helm-pos-multiline-p) - (goto-char - (or (helm-get-next-candidate-separator-pos) - (point-max)))) - (forward-line 1)))) - (helm-mark-current-line)) - (helm-follow-mode follow)))) - -(defun helm-unmark-all () - "Unmark all candidates in all sources of current helm session." - (interactive) - (with-helm-alive-p - (with-helm-window - (save-excursion - (helm-clear-visible-mark)) - (setq helm-marked-candidates nil) - (helm-mark-current-line) - (helm-display-mode-line (helm-get-current-source)) - (set-window-margins (selected-window) helm-left-margin-width)))) -(put 'helm-unmark-all 'helm-only t) - -(defun helm-toggle-all-marks (&optional all) - "Toggle all marks. - -Mark all visible candidates of current source or unmark all -candidates visible or invisible in all sources of current Helm -session. - -With a prefix argument mark all candidates in all sources." - (interactive "P") - (with-helm-alive-p - (let ((marked (helm-marked-candidates))) - (if (and (>= (length marked) 1) - (with-helm-window helm-visible-mark-overlays)) - (helm-unmark-all) - (helm-mark-all all))))) -(put 'helm-toggle-all-marks 'helm-only t) - -(defun helm--compute-marked (real source &optional wildcard) - (let* ((coerced (helm-coerce-selection real source)) - (wilds (and wildcard - (condition-case nil - (helm-file-expand-wildcards - coerced t) - (error nil))))) - ;; Avoid returning a not expanded wildcard fname. - ;; e.g assuming "/tmp" doesn't contain "*.el" - ;; return nil when coerced is "/tmp/*.el". - (unless (or wilds (null wildcard) - (string-match-p helm--url-regexp coerced) - (file-exists-p coerced) - (and (stringp coerced) - (null (string-match-p "[[*?]" coerced)))) - (setq coerced nil)) - (or wilds (and coerced (list coerced))))) - -(cl-defun helm-marked-candidates (&key with-wildcard all-sources) - "Return marked candidates of current source, if any. - -Otherwise return one element list consisting of the current -selection. When key WITH-WILDCARD is specified, expand it. When -ALL-SOURCES key value is non-nil returns marked candidates of all -sources." - (with-current-buffer helm-buffer - (let* ((current-src (helm-get-current-source)) - (src-name (assq 'name current-src)) - (dummy (equal (helm-get-attr 'candidates current-src) '("dummy"))) - (candidates - (cl-loop for (source . real) in (reverse helm-marked-candidates) - for use-wc = (and with-wildcard - (string-match-p "[[*?]" real) - (null (file-exists-p real))) - when (or all-sources - (and - ;; Dummy sources use a unique candidate, two same - ;; dummy sources (or more) should share their - ;; (unique) marked candidate only when - ;; :all-marked is non nil. - (not dummy) - (equal (assq 'name source) src-name))) - nconc (helm--compute-marked real source use-wc) into mkds - finally return - (if (and with-wildcard all-sources) - (helm-fast-remove-dups mkds :test 'equal) - mkds))) - sel) - (unless candidates - (setq sel (helm-get-selection - nil (helm-get-attr 'marked-with-props current-src) - current-src)) - (setq candidates - (helm--compute-marked - sel current-src - (and with-wildcard (null (file-exists-p sel)))))) - (helm-log "helm-marked-candidates" - "Marked candidates = %S" candidates) - candidates))) - -(defun helm--remove-marked-and-update-mode-line (elm) - (with-helm-buffer - (setq helm-marked-candidates - (delete (rassoc elm helm-marked-candidates) - helm-marked-candidates)) - (helm-display-mode-line (helm-get-current-source)))) - -(defun helm-current-source-name= (name) - (save-excursion - (goto-char (helm-get-previous-header-pos)) - (equal name (helm-current-line-contents)))) - -(defun helm-revive-visible-mark () - "Restore marked candidates when helm updates display." - (with-current-buffer helm-buffer - (save-excursion - (dolist (o helm-visible-mark-overlays) - (let* ((source (overlay-get o 'source)) - (ov-src-name (assoc-default 'name source)) - (ov-str (overlay-get o 'string)) - (ov-real (overlay-get o 'real)) - (ov-ml-str (helm-aif (helm-get-attr 'multiline source) - (if (numberp it) - ;; Assume display have been computed - ;; against real e.g. kill-ring. - (helm--multiline-get-truncated-candidate - ov-real it) - ov-str) - ov-str)) - beg end) - ;; Move point to end of source header line. - (goto-char (point-min)) - (search-forward ov-src-name nil t) - (while (and (search-forward ov-ml-str nil t) - (cl-loop for ov in (overlays-at (pos-bol 0)) - never (overlay-get ov 'visible-mark)) - (helm-current-source-name= ov-src-name)) - (setq beg (match-beginning 0) - end (if (string= ov-ml-str ov-str) - (match-end 0) (1+ (match-end 0)))) - ;; Calculate real value of candidate. - ;; It can be nil if candidate have only a display value. - (let ((real (get-text-property (pos-bol 0) 'helm-realvalue))) - (if real - ;; Check if real value of current candidate is the same - ;; than the one stored in overlay. - ;; This is needed when some cands have same display names. - ;; Using equal allow testing any type of value for real cand. - ;; bug#706. - (and (equal ov-real real) - (move-overlay o beg end)) - (and (equal ov-str (buffer-substring beg end)) - (move-overlay o beg end)))))))))) -(add-hook 'helm-after-update-hook 'helm-revive-visible-mark) - -(defun helm-next-point-in-list (curpos points &optional prev) - (cond - ;; rule out special cases. - ((null points) curpos) - ((and prev (<= curpos (car points))) - (nth (1- (length points)) points)) - ((< (car (last points)) curpos) - (if prev (car (last points)) (nth 0 points))) - ((and (not prev) (>= curpos (car (last points)))) - (nth 0 points)) - (t - (nth (if prev - (cl-loop for pt in points - for i from 0 - if (<= curpos pt) return (1- i)) - (cl-loop for pt in points - for i from 0 - if (< curpos pt) return i)) - points)))) - -(defun helm-next-visible-mark (&optional prev) - "Move next Helm visible mark. -If PREV is non-nil move to precedent." - (interactive) - (with-helm-alive-p - (with-helm-window - (ignore-errors - (goto-char (helm-next-point-in-list - (point) - (sort (mapcar 'overlay-start helm-visible-mark-overlays) '<) - prev))) - (helm-mark-current-line)))) -(put 'helm-next-visible-mark 'helm-only t) - -(defun helm-prev-visible-mark () - "Move previous helm visible mark." - (interactive) - (with-helm-alive-p - (helm-next-visible-mark t))) -(put 'helm-prev-visible-mark 'helm-only t) - -;;; Kill/yank selection -;; -(defun helm-yank-selection (arg) - "Set minibuffer contents to current display selection. -With a prefix arg set to real value of current selection." - (interactive "P") - (with-helm-alive-p - (let ((str (format "%s" (helm-get-selection nil (not arg))))) - (kill-new str) - (helm-set-pattern str)))) -(put 'helm-yank-selection 'helm-only t) - -(defun helm-kill-selection-and-quit (arg) - "Store display value of current selection to kill ring. -Kill \\='display or \\='real value of candidate according to the value of -`helm-kill-real-or-display-selection'. A prefix arg reverse the behavior of -this variable." - (interactive "P") - (with-helm-alive-p - (helm-run-after-exit - (lambda (sel) - (kill-new sel) - ;; Return nil to force `helm-mode--keyboard-quit' - ;; in `helm-comp-read' otherwise the message itself - ;; is used as exit value for `helm-comp-read'. - (prog1 nil (message "Saved to kill-ring: %s" sel) (sit-for 1))) - (format "%s" (helm-get-selection - nil (helm-acase helm-kill-real-or-display-selection - (real arg) - (display (and (not arg) 'noicon)))))))) -(put 'helm-kill-selection-and-quit 'helm-only t) - -(defun helm-insert-or-copy (&optional arg) - "Insert selection or marked candidates in current buffer. - -With a prefix arg copy marked candidates to kill-ring. -The real value of each candidate is used." - (interactive "P") - (with-helm-alive-p - (helm-run-after-exit - (lambda (cands) - (with-helm-current-buffer - (let ((sels (mapconcat (lambda (c) - (format "%s" c)) - cands "\n"))) - (if arg (kill-new sels) (insert sels))))) - (helm-marked-candidates)))) -(put 'helm-insert-or-copy 'helm-only t) - - -;;; Follow-mode: Automatic execution of persistent-action -;; -;; -(defun helm-follow-mode (&optional arg) - "Execute persistent action every time the cursor is moved. - -This mode is source local, i.e. It applies on current source only. -\\ -This mode can be enabled or disabled interactively at anytime during -a helm session with \\[helm-follow-mode]. - -When enabling interactively `helm-follow-mode' in a source, you -can keep it enabled for next Emacs sessions by setting -`helm-follow-mode-persistent' to a non-nil value. - -When `helm-follow-mode' is called with a prefix arg and -`helm-follow-mode-persistent' is non-nil `helm-follow-mode' will -be persistent only for this Emacs session, but not for the next -Emacs sessions, i.e. the current source will not be saved to -`helm-source-names-using-follow'. - -A prefix arg with `helm-follow-mode' already enabled will have no -effect. - -Note that you can use instead of this mode the commands -`helm-follow-action-forward' and `helm-follow-action-backward' at -anytime in all Helm sessions. - -They are bound by default to \\[helm-follow-action-forward] and -\\[helm-follow-action-backward]." - (interactive (list (helm-aif (and current-prefix-arg - (prefix-numeric-value current-prefix-arg)) - (unless (helm-follow-mode-p) it)))) - (with-helm-alive-p - (with-current-buffer helm-buffer - (let* ((src (helm-get-current-source)) - (name (assoc-default 'name src)) - (fol-attr (assq 'follow src)) - (enabled (or (helm-follow-mode-p src) - (and helm-follow-mode-persistent - (member (assoc-default 'name src) - helm-source-names-using-follow)))) - ;; No messages when called non interactively. - (set-message-function (lambda (msg) - (if (and (not current-prefix-arg) arg) - 1 msg)))) - (if src - (progn - (if (eq (cdr fol-attr) 'never) - (message "helm-follow-mode not allowed in this source") - ;; Make follow attr persistent for this emacs session. - (helm-follow-mode-set-source - (if (or enabled (and (numberp arg) (< arg 0))) -1 1) - src) - ;; When called from lisp (non--interactive) src-name - ;; will never be saved. - ;; When arg is nil assume the call is interactive and save - ;; src-name to `helm-source-names-using-follow'. - ;; However if user call helm-follow-mode with a prefix arg, - ;; behave like a non--interactive call and - ;; DONT save src-name to `helm-source-names-using-follow'. - (when (and helm-follow-mode-persistent (null arg)) - (if (null enabled) - (unless (member name helm-source-names-using-follow) - (push name helm-source-names-using-follow) - (customize-save-variable 'helm-source-names-using-follow - helm-source-names-using-follow)) - (when (member name helm-source-names-using-follow) - (setq helm-source-names-using-follow - (delete name helm-source-names-using-follow)) - (customize-save-variable 'helm-source-names-using-follow - helm-source-names-using-follow)))) - (message "helm-follow-mode is %s" - (if (helm-follow-mode-p src) - "enabled" "disabled")) - (helm-display-mode-line src t))) - (message "Not enough candidates for helm-follow-mode")))))) -(put 'helm-follow-mode 'helm-only t) - -(defun helm-follow-execute-persistent-action-maybe (&optional delay) - "Execute persistent action in mode `helm-follow-mode'. - -This happen after: DELAY or the \\='follow-attr value of current -source or `helm-follow-input-idle-delay'." - (let* ((src (helm-get-current-source)) - (suspend (and helm--in-update - ;; Specific to helm-find-files. - (assoc-default 'suspend-follow-in-update src)))) - (when (and (not suspend) - (not (get-buffer-window helm-action-buffer 'visible)) - (not (helm-pos-header-line-p)) - (or (helm-follow-mode-p src) - (and helm-follow-mode-persistent - (member (assoc-default 'name src) - helm-source-names-using-follow))) - (null (eq (assoc-default 'follow src) 'never)) - (helm-get-selection nil nil src)) - (helm-follow-mode-set-source 1 src) - (helm--execute-persistent-action-when-idle delay src)))) - -;; We could use a simple idle timer here as before with a delay fixed at minimum -;; 0.5, the effect is the same but it creates a timer at each call, with this -;; code a new timer is created only after being idle 0.5 and restarting -;; scrolling. That's mean that when hitting C-n continuously no new timer is -;; created, we reuse `helm--execute-persistent-action-timer' until it is not -;; consumed i.e. the PA is executed because we are idle. -(defvar helm--execute-persistent-action-timer nil) -(defun helm--execute-persistent-action-when-idle (&optional delay src) - "Call persistent action only once idle DELAY that many seconds. -SRC is used to check if there is a delay specified for this source. -Also avoid creating needlessly a timer at each call." - ;; More or less similar to what the debounce fn in timeout package does, - ;; except the timer is stored in a global var instead of beeing stored in a - ;; closure and there is no default output, we just execute - ;; helm-execute-persistent-action once emacs is idle. - (when helm-alive-p - (let ((at (or delay - (assoc-default 'follow-delay src) - helm-follow-input-idle-delay))) - (unless (timerp helm--execute-persistent-action-timer) - (setq helm--execute-persistent-action-timer - (run-with-idle-timer - at nil - (lambda () - (cancel-timer helm--execute-persistent-action-timer) - (setq helm--execute-persistent-action-timer nil) - (helm-execute-persistent-action)))))))) - -(defun helm-follow-mode-p (&optional source) - (with-helm-buffer - (eq (helm-get-attr 'follow (or source (helm-get-current-source))) 1))) - -(defun helm-follow-mode-set-source (value &optional source) - (with-helm-buffer - (helm-set-attr 'follow value (or source (helm-get-current-source))))) - -;;; Auto-resize mode -;; -(defun helm--autoresize-hook (&optional max-height min-height) - (when (if (helm--show-action-window-other-window-p) - (and (helm-window) - (not (get-buffer-window helm-action-buffer 'visible))) - (helm-window)) - (with-helm-window - (fit-window-to-buffer nil - (/ (* (frame-height) - (or max-height helm-autoresize-max-height)) - 100) - (/ (* (frame-height) - (or min-height helm-autoresize-min-height)) - 100))))) - -(define-minor-mode helm-autoresize-mode - "Auto resize helm window when enabled. -Helm window is re-sized according to `helm-autoresize-max-height' -and `helm-autoresize-min-height'. Note that when this mode is -enabled, Helm behaves as if `helm-always-two-windows' is enabled. - -See `fit-window-to-buffer' for more infos." - :group 'helm - :global t - (if helm-autoresize-mode - (progn (add-hook 'helm-after-update-hook 'helm--autoresize-hook) - (add-hook 'helm-window-configuration-hook 'helm--autoresize-hook)) - (remove-hook 'helm-after-update-hook 'helm--autoresize-hook) - (remove-hook 'helm-window-configuration-hook 'helm--autoresize-hook))) - -(defun helm-help () - "Generate Helm's help according to `help-message' attribute. - -If `helm-buffer' is empty, provide completions on `helm-sources' -to choose its local documentation. -If source doesn't have any `help-message' attribute, a generic -message explaining this is added instead. -The global `helm-help-message' is always added after this local -help." - (interactive) - (require 'helm-mode nil t) ; for helm-comp-read. - (with-helm-alive-p - (let ((source (or (helm-get-current-source) ; nil when helm-buffer is empty. - (and (fboundp 'helm-comp-read) - (helm-comp-read - "Help for: " - (cl-loop for src in (with-helm-buffer helm-sources) - collect `(,(assoc-default 'name src) . - ,src)) - :allow-nest t - :exec-when-only-one t)) - ;; No completion on sources when only helm-core package is - ;; used. - (car helm-sources)))) - (save-selected-window - (helm-help-internal - helm-help-buffer-name - (lambda () - (helm-aif (assoc-default 'help-message source) - (insert (substitute-command-keys - (helm-interpret-value it))) - (insert "* No specific help for this source available.")) - (insert "\n\n" - (substitute-command-keys - (helm-interpret-value helm-help-message))))))))) -(put 'helm-help 'helm-only t) - -(defun helm-toggle-truncate-line () - "Toggle `truncate-lines' value in `helm-buffer'" - (interactive) - (with-helm-alive-p - (with-helm-buffer - (setq truncate-lines (not truncate-lines)) - (when (helm-get-previous-header-pos) - (helm-update (regexp-quote (helm-get-selection nil t)))) - (message "%sisplaying continuation lines" - (if truncate-lines "Not D" "D"))))) -(put 'helm-toggle-truncate-line 'helm-only t) - -;;;###autoload -(defun helm-other-buffer (sources buffer) - "Simplified Helm interface with other `helm-buffer'. -Call `helm' only with SOURCES and BUFFER as args." - (helm :sources sources :buffer buffer)) -(make-obsolete 'helm-other-buffer 'helm "4.0.1") - -(provide 'helm-core) -;;; helm-core.el ends here diff --git a/elpa/helm-core-20251211.709/helm-lib.el b/elpa/helm-core-20251211.709/helm-lib.el deleted file mode 100644 index b89372b9..00000000 --- a/elpa/helm-core-20251211.709/helm-lib.el +++ /dev/null @@ -1,2365 +0,0 @@ -;;; helm-lib.el --- Helm routines. -*- lexical-binding: t -*- - -;; Copyright (C) 2015 ~ 2025 Thierry Volpiatto - -;; Author: Thierry Volpiatto -;; URL: http://github.com/emacs-helm/helm - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Commentary: -;; All helm functions that don't require specific helm code should go here. - -;;; Code: - -(require 'cl-lib) - -(declare-function ansi-color--find-face "ansi-color.el") -(declare-function ansi-color-apply-sequence "ansi-color.el") -(declare-function dired-current-directory "dired.el") -(declare-function ffap-file-remote-p "ffap.el") -(declare-function ffap-url-p "ffap.el") -(declare-function helm-get-attr "helm-core.el") -(declare-function helm-set-attr "helm-core.el") -(declare-function helm-follow-mode-p "helm-core.el") -(declare-function helm-get-current-source "helm-core.el") -(declare-function helm-get-selection "helm-core.el") -(declare-function helm-get-sources "helm-core.el") -(declare-function helm-interpret-value "helm-core.el") -(declare-function helm-log-run-hook "helm-core.el") -(declare-function helm-next-line "helm-core.el") -(declare-function helm-get-next-header-pos "helm-core.el") -(declare-function helm-mark-current-line "helm-core.el") -(declare-function helm-marked-candidates "helm-core.el") -(declare-function helm-set-case-fold-search "helm-core.el") -(declare-function helm-get-previous-header-pos "helm-core.el") -(declare-function helm-source--cl--print-table "helm-source.el") -(declare-function helm-update "helm-core.el") -(declare-function org-content "org.el") -(declare-function org-mark-ring-goto "org.el") -(declare-function org-mark-ring-push "org.el") -(declare-function org-table-p "org-compat.el") -(declare-function org-table-align "org-table.el") -(declare-function org-table-end "org-table.el") -(declare-function org-open-at-point "org.el") -(declare-function helm-read-file-name "helm-mode.el") -(declare-function find-function-library "find-func.el") -(declare-function find-library-name "find-func.el") -(declare-function cl--describe-class-slots "cl-extra.el") -(declare-function cl--find-class "cl-macs.el") - -(defvar helm-sources) -(defvar helm-initial-frame) -(defvar helm-current-position) -(defvar helm-persistent-action-display-window) -(defvar helm--buffer-in-new-frame-p) -(defvar helm-completion-style) -(defvar helm-completion-styles-alist) -(defvar helm-persistent-action-window-buffer) -(defvar helm-help-buffer-name) -(defvar completion-flex-nospace) -(defvar find-function-source-path) -(defvar ffap-machine-p-unknown) -(defvar ffap-machine-p-local) -(defvar ffap-machine-p-known) -(defvar helm-debug-output-buffer) - -;;; User vars. -;; -(defcustom helm-file-globstar t - "Same as globstar bash shopt option. -When non-nil a pattern beginning with two stars will expand -recursively. -Directories expansion is not supported yet." - :group 'helm - :type 'boolean) - -(defcustom helm-yank-text-at-point-function nil - "The function used to forward point with `helm-yank-text-at-point'. -With a nil value, fallback to default `forward-word'. -The function should take one arg, an integer like `forward-word'. -NOTE: Using `forward-symbol' here is not very useful as it is -already provided by \\\\[next-history-element]." - :type 'function - :group 'helm) - -(defcustom helm-scroll-amount nil - "Scroll amount when scrolling helm window or other window in a helm session. -It is used by `helm-scroll-other-window', `helm-scroll-up', `helm-scroll-down' -and `helm-scroll-other-window-down'. - -If you prefer scrolling line by line, set this value to 1." - :group 'helm - :type 'integer) - -(defcustom helm-help-full-frame t - "Display help window in full frame when non nil. - -Even when nil probably the same result (full frame) can be -reached by tweaking `display-buffer-alist', but it is much more -convenient to use a simple boolean value here." - :type 'boolean - :group 'helm-help) - -(defvar helm-ff--boring-regexp nil) -(defun helm-ff--setup-boring-regex (var val) - (set var val) - (setq helm-ff--boring-regexp - (cl-loop for r on val - if (cdr r) - concat (concat (car r) "\\|") - else concat (car r)))) - -(defcustom helm-boring-file-regexp-list - (mapcar (lambda (f) - (let ((rgx (regexp-quote f))) - (if (string-match-p "[^/]$" f) - ;; files: e.g .o => \\.o$ - (concat rgx "$") - ;; To not ignore files with same prefix as directory names - ;; (bug#2009) use e.g. .git/ => \.git\?$. - ;; See also PR in bug#2012. - (concat rgx "?$")))) - completion-ignored-extensions) - "A list of regexps matching boring files. - -This list is build by default on `completion-ignored-extensions'. -The directory names should end with \"/?$\" e.g. \"\\.git/?$\" and -the file names should end with \"$\" e.g. \"\\.o$\". - -These regexps may be used to match the entire path, not just the -file name, so for example to ignore files with a prefix -\".bak.\", use \"\\.bak\\..*$\" as the regexp. - -NOTE: When modifying this, be sure to use customize interface or -the customize functions e.g. `customize-set-variable' and NOT -`setq'." - :group 'helm-files - :type '(repeat (choice regexp)) - :set 'helm-ff--setup-boring-regex) - -(defcustom helm-describe-function-function 'describe-function - "Function used to describe functions in Helm." - :group 'helm-elisp - :type 'function) - -(defcustom helm-describe-variable-function 'describe-variable - "Function used to describe variables in Helm." - :group 'helm-elisp - :type 'function) - -(defcustom helm-current-directory-alist - '((dired-mode . dired-current-directory) - (mu4e-main-mode . mu4e-root-maildir) - (gnus-group-mode . gnus-directory) - (gnus-summary-mode . gnus-directory) - (gnus-article-mode . gnus-directory)) - "Tell `helm-current-directory' what to use according to `major-mode'. -Each element of alist is (MAJOR-MODE . SYMBOL) where SYMBOL is either a variable -or a function." - :type '(alist :key-type symbol :value-type sexp) - :group 'helm-files) - -;;; Internal vars -;; -(defvar helm-yank-point nil) -(defvar helm-pattern "" - "The input pattern used to update the helm buffer.") -(defvar helm-buffer "*helm*" - "Buffer showing completions.") -(defvar helm-current-buffer nil - "Current buffer when `helm' is invoked.") -(defvar helm-suspend-update-flag nil) -(defvar helm-action-buffer "*helm action*" - "Buffer showing actions.") -(defvar helm-current-prefix-arg nil - "Record `current-prefix-arg' when exiting minibuffer.") -(defvar helm-current-error nil - "Same as `compilation-current-error' but for helm-occur and helm-grep.") - -;;; Compatibility -;; -(defun helm-add-face-text-properties (beg end face &optional append object) - "Add the face property to the text from START to END. -It is a compatibility function which behaves exactly like -`add-face-text-property' if available, otherwise like -`add-text-properties'. When only `add-text-properties' is -available APPEND is ignored." - (if (fboundp 'add-face-text-property) - (add-face-text-property beg end face append object) - (add-text-properties beg end `(face ,face) object))) - -;;; Override `push-mark' -;; -;; Fix duplicates in `mark-ring' and `global-mark-ring' and update -;; buffers in `global-mark-ring' to recentest mark. -(defun helm--advice-push-mark (&optional location nomsg activate) - (unless (null (mark t)) - (let ((marker (copy-marker (mark-marker)))) - (setq mark-ring (cons marker (delete marker mark-ring)))) - (when (> (length mark-ring) mark-ring-max) - ;; Move marker to nowhere. - (set-marker (car (nthcdr mark-ring-max mark-ring)) nil) - (setcdr (nthcdr (1- mark-ring-max) mark-ring) nil))) - (set-marker (mark-marker) (or location (point)) (current-buffer)) - ;; Now push the mark on the global mark ring. - (setq global-mark-ring (cons (copy-marker (mark-marker)) - ;; Avoid having multiple entries - ;; for same buffer in `global-mark-ring'. - (cl-loop with mb = (current-buffer) - for m in global-mark-ring - for nmb = (marker-buffer m) - unless (eq mb nmb) - collect m))) - (when (> (length global-mark-ring) global-mark-ring-max) - (set-marker (car (nthcdr global-mark-ring-max global-mark-ring)) nil) - (setcdr (nthcdr (1- global-mark-ring-max) global-mark-ring) nil)) - (or nomsg executing-kbd-macro (> (minibuffer-depth) 0) - (message "Mark set")) - (when (or activate (not transient-mark-mode)) - (set-mark (mark t))) - nil) - -(defcustom helm-advice-push-mark t - "Override `push-mark' with a version avoiding duplicates when non-nil." - :group 'helm - :type 'boolean - :set (lambda (var val) - (set var val) - (if val - (advice-add 'push-mark :override #'helm--advice-push-mark '((depth . 100))) - (advice-remove 'push-mark #'helm--advice-push-mark)))) - -;; This the version of Emacs-27 written by Stefan -(defun helm-advice--ffap-read-file-or-url (prompt guess) - (or guess (setq guess default-directory)) - (if (ffap-url-p guess) - (read-string prompt guess nil nil t) - (unless (ffap-file-remote-p guess) - (setq guess (abbreviate-file-name (expand-file-name guess)))) - (read-file-name prompt (file-name-directory guess) nil nil - (file-name-nondirectory guess)))) - -;; The native-comp branch of emacs "is a modified Emacs capable of compiling -;; and running Emacs Lisp as native code in form of re-loadable elf files." -;; (https://akrl.sdf.org/gccemacs.html). The function subr-native-elisp-p is a -;; native function available only in this branch and evaluates to true if the -;; argument supplied is a natively compiled lisp function. Use this function -;; if it's available, otherwise return nil. Helm needs to distinguish compiled -;; functions from other symbols in a various places. -(defun helm-subr-native-elisp-p (object) - (when (fboundp 'subr-native-elisp-p) - (subr-native-elisp-p object))) - -;; Available only in Emacs-28+ -(unless (fboundp 'file-modes-number-to-symbolic) - (defun file-modes-number-to-symbolic (mode &optional filetype) - "Return a string describing a file's MODE. -For instance, if MODE is #o700, then it produces `-rwx------'. -FILETYPE if provided should be a character denoting the type of file, -such as `?d' for a directory, or `?l' for a symbolic link and will override -the leading `-' char." - (string - (or filetype - (pcase (ash mode -12) - ;; POSIX specifies that the file type is included in st_mode - ;; and provides names for the file types but values only for - ;; the permissions (e.g., S_IWOTH=2). - - ;; (#o017 ??) ;; #define S_IFMT 00170000 - (#o014 ?s) ;; #define S_IFSOCK 0140000 - (#o012 ?l) ;; #define S_IFLNK 0120000 - ;; (8 ??) ;; #define S_IFREG 0100000 - (#o006 ?b) ;; #define S_IFBLK 0060000 - (#o004 ?d) ;; #define S_IFDIR 0040000 - (#o002 ?c) ;; #define S_IFCHR 0020000 - (#o001 ?p) ;; #define S_IFIFO 0010000 - (_ ?-))) - (if (zerop (logand 256 mode)) ?- ?r) - (if (zerop (logand 128 mode)) ?- ?w) - (if (zerop (logand 64 mode)) - (if (zerop (logand 2048 mode)) ?- ?S) - (if (zerop (logand 2048 mode)) ?x ?s)) - (if (zerop (logand 32 mode)) ?- ?r) - (if (zerop (logand 16 mode)) ?- ?w) - (if (zerop (logand 8 mode)) - (if (zerop (logand 1024 mode)) ?- ?S) - (if (zerop (logand 1024 mode)) ?x ?s)) - (if (zerop (logand 4 mode)) ?- ?r) - (if (zerop (logand 2 mode)) ?- ?w) - (if (zerop (logand 512 mode)) - (if (zerop (logand 1 mode)) ?- ?x) - (if (zerop (logand 1 mode)) ?T ?t))))) - -(unless (and (fboundp 'pos-bol) (fboundp 'pos-eol)) - (defalias 'pos-bol 'line-beginning-position) - (defalias 'pos-eol 'line-end-position)) - -;;; Compatibility with < Emacs-29 -;; Needed by helm-packages.el and affixations functions for helm-mode (27) -;; waiting package.el moves on Elpa. Slightly modified to fit with -;; Emacs-27/28. -(when (eval-when-compile (< emacs-major-version 29)) ; Avoid warnings. - (progn - (require 'package) - (eval-and-compile - (defun package--archives-initialize () - "Make sure the list of installed and remote packages are initialized." - (unless package--initialized - (package-initialize t)) - (unless package-archive-contents - (package-refresh-contents))) - - (defun package-get-descriptor (pkg-name) - "Return the `package-desc' of PKG-NAME." - (unless package--initialized (package-initialize 'no-activate)) - (or (cadr (assq pkg-name package-alist)) - (cadr (assq pkg-name package-archive-contents)))) - - (defun package-upgrade (name) - "Upgrade package NAME if a newer version exists." - (let* ((package (if (symbolp name) - name - (intern name))) - (pkg-desc (cadr (assq package package-alist)))) - ;; `pkg-desc' will be nil when the package is an "active built-in". - (when pkg-desc - (package-delete pkg-desc 'force 'dont-unselect)) - (package-install package - ;; An active built-in has never been "selected" - ;; before. Mark it as installed explicitly. - (and pkg-desc 'dont-select)))) - - (defun package-recompile (pkg) - "Byte-compile package PKG again. -PKG should be either a symbol, the package name, or a `package-desc' -object." - (let ((pkg-desc (if (package-desc-p pkg) - pkg - (cadr (assq pkg package-alist))))) - ;; Delete the old .elc files to ensure that we don't inadvertently - ;; load them (in case they contain byte code/macros that are now - ;; invalid). - (dolist (elc (directory-files-recursively - (package-desc-dir pkg-desc) "\\.elc\\'")) - (delete-file elc)) - (package--compile pkg-desc)))))) - -;;; Provide `help--symbol-class' not available in emacs-27 -;; -(unless (fboundp 'help--symbol-class) - (defun help--symbol-class (s) - "Return symbol class characters for symbol S." - (when (stringp s) - (setq s (intern-soft s))) - (concat - (when (fboundp s) - (concat - (cond - ((commandp s) "c") - ((eq (car-safe (symbol-function s)) 'macro) "m") - (t "f")) - (and (let ((flist (indirect-function s))) - (advice--p (if (eq 'macro (car-safe flist)) (cdr flist) flist))) - "!") - (and (get s 'byte-obsolete-info) "-"))) - (when (boundp s) - (concat - (if (custom-variable-p s) "u" "v") - (and (local-variable-if-set-p s) "'") - (and (ignore-errors (not (equal (symbol-value s) (default-value s)))) "*") - (and (get s 'byte-obsolete-variable) "-"))) - (and (facep s) "a") - (and (fboundp 'cl-find-class) (cl-find-class s) "t")))) - -;; Inline `kmacro--to-vector' from E29 to fix compatibility of -;; `helm-kbd-macro-concat-macros' with E29 and E28. -(unless (fboundp 'kmacro--to-vector) - (defun kmacro--to-vector (object) - "Normalize an old-style key sequence to the vector form." - (if (not (stringp object)) - object - (let ((vec (string-to-vector object))) - (unless (multibyte-string-p object) - (dotimes (i (length vec)) - (let ((k (aref vec i))) - (when (> k 127) - (setf (aref vec i) (+ k ?\M-\C-@ -128)))))) - vec)))) - -(defun helm-proper-list-p (obj) - "Compatibility function for `proper-list-p'." - (if (fboundp 'proper-list-p) - (proper-list-p obj) ; 27+ - (and (listp obj) (not (cdr (last obj)))))) - -;;; Macros helper. -;; -(defmacro helm-with-gensyms (symbols &rest body) - "Bind the SYMBOLS to fresh uninterned symbols and eval BODY." - (declare (indent 1)) - `(let ,(mapcar (lambda (s) - ;; Use cl-gensym here instead of make-symbol - ;; to ensure a symbol that have a live that go - ;; beyond the live of its macro have different name. - ;; i.e symbols created with `with-helm-temp-hook' - ;; should have random names. - `(,s (cl-gensym (symbol-name ',s)))) - symbols) - ,@body)) - -;;; Command loop helper -;; -(defconst helm-this-command-black-list - '(helm-maybe-exit-minibuffer - helm-confirm-and-exit-minibuffer - helm-exit-minibuffer - exit-minibuffer - helm-M-x)) - -(defconst helm-this-command-functions '(read-multiple-choice--long-answers) - "The functions that should be returned by `helm-this-command' when found.") - -(defun helm-this-command () - "Return the actual command in action. -Like `this-command' but return the real command, and not -`exit-minibuffer' or other unwanted functions." - (cl-loop for count from 1 to 50 - for btf = (backtrace-frame count) - for fn = (cl-second btf) - ;; Some commands like `kill-buffer' may call another function - ;; involving a completing-read, in this case we want to stop at this - ;; function and not go up to the initial interactive call (in this - ;; case kill-buffer) See Issue#2634. - if (or (memq fn helm-this-command-functions) - (and - ;; In some cases we may have in the way an - ;; advice compiled resulting in byte-code, - ;; ignore it (Bug#691). - (symbolp fn) - (commandp fn) - (not (memq fn helm-this-command-black-list)))) - return fn - else - if (and (eq fn 'call-interactively) - (> (length btf) 2)) - return (cadr (cdr btf)))) - - -;;; Iterators -;; -(defun helm-iter-list (seq &optional cycle) - "Return an iterator object from SEQ. -The iterator dies and returns nil when it reaches end of SEQ. -When CYCLE is specified the iterator never ends." - (let ((lis seq)) - (lambda () - (let ((elm (car lis))) - (setq lis (if cycle - (or (cdr lis) seq) - (cdr lis))) - elm)))) - -(defun helm-iter-circular (seq) - "Infinite iteration on SEQ." - (helm-iter-list seq 'cycle)) - -(cl-defun helm-iter-sub-next-circular (seq elm &key (test 'eq)) - "Infinite iteration of SEQ starting at ELM." - (let* ((pos (1+ (helm-position elm seq :test test))) - (sub (append (nthcdr pos seq) (helm-take seq pos))) - (iterator (helm-iter-circular sub))) - (lambda () - (helm-iter-next iterator)))) - -(defun helm-iter-next (iterator) - "Return next elm of ITERATOR." - (and iterator (funcall iterator))) - - -;;; Anaphoric macros. -;; -(defmacro helm-aif (test-form then-form &rest else-forms) - "Anaphoric version of `if'. -Like `if' but set the result of TEST-FORM in a temporary variable -called `it'. THEN-FORM and ELSE-FORMS are then executed just like -in `if'." - (declare (indent 2) (debug t)) - `(let ((it ,test-form)) - (if it ,then-form ,@else-forms))) - -(defmacro helm-awhile (sexp &rest body) - "Anaphoric version of `while'. -Same usage as `while' except that SEXP is bound to a temporary -variable called `it' at each turn. -An implicit nil block is bound to the loop so usage of -`cl-return' is possible to exit the loop." - (declare (indent 1) (debug t)) - (helm-with-gensyms (flag) - `(let ((,flag t)) - (cl-block nil - (while ,flag - (helm-aif ,sexp - (progn ,@body) - (setq ,flag nil))))))) - -(defmacro helm-acond (&rest clauses) - "Anaphoric version of `cond'. -In each clause of CLAUSES, the result of the car of clause is -stored in a temporary variable called `it' and usable in the cdr -of this same clause. Each `it' variable is independent of its -clause. The usage is the same as `cond'." - (declare (debug cond)) - (unless (null clauses) - (helm-with-gensyms (sym) - (let ((clause1 (car clauses))) - `(let ((,sym ,(car clause1))) - (helm-aif ,sym - (if (cdr ',clause1) - (progn ,@(cdr clause1)) - it) - (helm-acond ,@(cdr clauses)))))))) - -(defmacro helm-aand (&rest conditions) - "Anaphoric version of `and'. -Each condition is bound to a temporary variable called `it' which -is usable in next condition." - (declare (debug (&rest form))) - (cond ((null conditions) t) - ((null (cdr conditions)) (car conditions)) - (t `(helm-aif ,(car conditions) - (helm-aand ,@(cdr conditions)))))) - -(defmacro helm-acase (expr &rest clauses) - "Check if EXPR match KEYLIST and then execute BODY. - -`helm-acase' is a small macro mixing the features of `cl-case' -and `cond'. - -KEYLIST can be any object that will be compared with `equal' or -an expression starting with special symbol `guard*' which is then -evaluated. Once evaluated the symbol `guard' is bound to the -returned value that can be used in the cdr of clause. When -KEYLIST match EXPR or `guard*' sexp evaluation is non-nil, BODY -is executed and `helm-acase' exits with its value. -Note: -`guard*' sexp should not be a single symbol to eval, e.g. (guard* foo) -in such cases you should use (guard* (progn foo)). - -KEYLIST can also be a list starting with special symbol `dst*' -followed by an expression suitable for `cl-destructuring-bind'. -In this case all elements of `it' are bound to the elements of -this expression e.g. - - (helm-acase \\='(1 2 3 4 5) - ((dst* (l &rest args)) args)) - => (2 3 4 5) - -If KEYLIST is a list, it is compared with EXPR, also each -elements of the list are checked with `member' to see if one -matches EXPR, ensure to not use special symbols `guard*' and -`dst*' at start of such KEYLIST to avoid confusing helm-acase -even if this is partially supported. - -The last clause can use `t' or \\='otherwise as KEYLIST to specify a -fallback clause when previous clauses didn't match, if such a clause -starting with `t' or \\='otherwise is specified before last clause it -will override all next clauses, if you want to match an EXPR value equal -to `t' in any clauses quote it, i.e. `'t' or use an explicit -\(guard* (eq it t)). - -EXPR is bound to a temporary variable called `it' which is -usable in all clauses to refer to EXPR. - -\(fn EXPR (KEYLIST BODY...)...)" - (declare (indent 1) (debug (form &rest ([&or (symbolp form) sexp] body)))) - (unless (null clauses) - (let* ((clause1 (car clauses)) - (key (car clause1)) - (sexp (car-safe (cdr-safe key))) - (sp-sym (car-safe key)) - ;; Ensure dst* and guard* are not treated as special symbols when - ;; they are not followed by one sexp and nothing else, however if the - ;; following sexp is not meant to be evaluated but just compared we - ;; fail miserably, is it worth fixing it? - (issexp (and (consp sexp) (= (length key) 2))) - (isguard (and (eq 'guard* sp-sym) issexp)) - (isdst (and (eq 'dst* sp-sym) issexp)) - (special (or isguard isdst)) - (guard-sexp (and isguard sexp)) - (dst-sexp (and isdst sexp))) - `(let* ((it ,expr) - (guard ,guard-sexp) - (dst (and (consp it) ',dst-sexp))) - (cond ((or guard - (and ,(not special) - (or (equal it ',key) - (and (listp ',key) (member it ',key)))) - (and (symbolp ',key) - (or (eq ',key t) (eq ',key 'otherwise)))) - ;; When this branch is expanded the compiler complains about not - ;; referenced variables (the ones in `dst' that will be used in - ;; next branch) so prevent warnings instead of using a progn - ;; Merci Stefan! - (with-no-warnings ,@(cdr clause1))) - ((and dst - (condition-case nil - (cl-destructuring-bind ,dst-sexp it - ,@(cdr clause1)) - (wrong-number-of-arguments nil)))) - (t - (helm-acase it ,@(cdr clauses)))))))) - -;;; Fuzzy matching routines -;; -(defsubst helm--mapconcat-pattern (pattern) - "Transform string PATTERN in regexp for further fuzzy matching. -E.g.: helm.el$ - => \"[^h]*h[^e]*e[^l]*l[^m]*m[^.]*\\\\.[^e]*e[^l]*l$\" - ^helm.el$ - => \"helm\\\\.el$\"." - (let ((ls (split-string-and-unquote pattern ""))) - (if (string= "^" (car ls)) - ;; Exact match. - (mapconcat (lambda (c) - (if (and (string= c "$") - (string-match "$\\'" pattern)) - c (regexp-quote c))) - (cdr ls) "") - ;; Fuzzy match. - (mapconcat (lambda (c) - (if (and (string= c "$") - (string-match "$\\'" pattern)) - c (format "[^%s]*%s" c (regexp-quote c)))) - ls "")))) - -(defsubst helm--collect-pairs-in-string (string) - ;; We want to collect e.g. - ;; in "abcd" -> (("a" "b") ("b" "c") ("c" "d")) - ;; and not (("a" "b") ("c" "d")) so we use by #'cdr which is the default. - ;; If the last pair have no cdr i.e. (s1 nil) ignore it. - (cl-loop for (s1 s2) on (split-string string "" t) - when s2 collect (list s1 s2))) - -;;; Help routines. -;; -(defvar helm-help--iter-org-state nil) - -(defvar helm-help-mode-before-hook nil - "A hook that runs before helm-help starts.") - -(defvar helm-help-mode-after-hook nil - "A hook that runs when helm-help exits.") - -(defcustom helm-help-default-prompt - "[SPC,C-v,next:ScrollUp b,M-v,prior:ScrollDown TAB:Cycle M-TAB:All C-s/r:Isearch q:Quit]" - "The prompt used in `helm-help'." - :type 'string - :group 'helm) - -(defcustom helm-help-hkmap - '(("C-v" . helm-help-scroll-up) - ("SPC" . helm-help-scroll-up) - ("" . helm-help-scroll-up) - ("M-v" . helm-help-scroll-down) - ("b" . helm-help-scroll-down) - ("" . helm-help-scroll-down) - ("C-s" . isearch-forward) - ("C-r" . isearch-backward) - ("C-a" . move-beginning-of-line) - ("C-e" . move-end-of-line) - ("C-f" . forward-char) - ("" . forward-char) - ("C-b" . backward-char) - ("" . backward-char) - ("C-n" . helm-help-next-line) - ("C-p" . helm-help-previous-line) - ("" . helm-help-next-line) - ("" . helm-help-previous-line) - ("M-a" . backward-sentence) - ("M-e" . forward-sentence) - ("M-f" . forward-word) - ("M-b" . backward-word) - ("M->" . end-of-buffer) - ("C-M-f" . forward-sexp) - ("C-M-b" . backward-sexp) - ("M-<" . beginning-of-buffer) - ("C-SPC" . helm-help-toggle-mark) - ("C-M-SPC" . mark-sexp) - ("TAB" . org-cycle) - ("C-m" . helm-help-org-open-at-point) - ("C-&" . helm-help-org-mark-ring-goto) - ("C-%" . org-mark-ring-push) - ("M-TAB" . helm-help-org-cycle) - ("M-w" . helm-help-copy-region-as-kill) - ("q" . helm-help-quit)) - "Alist of (KEY . FUNCTION) for `helm-help'. - -This is not a standard keymap, just an alist where it is possible to -define a simple KEY (a string with no spaces) associated with a -FUNCTION. More complex key like \"C-x C-x\" are not supported. -Interactive functions will be called interactively whereas other -functions will be called with funcall except commands that are in -`helm-help-not-interactive-command'. -For convenience you can add bindings here with `helm-help-define-key'." - :type '(alist :key-type string :key-value symbol) - :group 'helm) - -(defvar helm-help-not-interactive-command '(isearch-forward isearch-backward) - "Commands that we don't want to call interactively in `helm-help'.") - -(defun helm-help-internal (bufname insert-content-fn) - "Show long message during Helm session in BUFNAME. -INSERT-CONTENT-FN is the function that inserts text to be -displayed in BUFNAME." - (let ((winconf (current-frame-configuration)) - (hframe (selected-frame))) - (helm-log-run-hook "helm-help-internal" 'helm-help-mode-before-hook) - (with-selected-frame helm-initial-frame - (select-frame-set-input-focus helm-initial-frame) - (unwind-protect - (progn - (setq helm-suspend-update-flag t) - (set-buffer (get-buffer-create bufname)) - (switch-to-buffer bufname) - (when helm-help-full-frame (delete-other-windows)) - (delete-region (point-min) (point-max)) - (org-mode) - (save-excursion - (funcall insert-content-fn) - (goto-char (point-min)) - (while (re-search-forward "^[|]" nil t) - (when (org-table-p t) - (org-table-align) - (goto-char (org-table-end))))) - (org-mark-ring-push) ; Put mark at bob - (buffer-disable-undo) - (helm-help-event-loop)) - (raise-frame hframe) - (helm-log-run-hook "helm-help-internal" 'helm-help-mode-after-hook) - (setq helm-suspend-update-flag nil) - (set-frame-configuration winconf))))) - -(cl-defun helm-help-scroll-up (&optional (amount helm-scroll-amount)) - "Scroll up in `helm-help'." - (condition-case _err - (scroll-up-command amount) - (beginning-of-buffer nil) - (end-of-buffer nil))) - -(cl-defun helm-help-scroll-down (&optional (amount helm-scroll-amount)) - "Scroll down in `helm-help'." - (condition-case _err - (scroll-down-command amount) - (beginning-of-buffer nil) - (end-of-buffer nil))) - -(defun helm-help-next-line () - "Next line function for `helm-help'." - (condition-case _err - (call-interactively #'next-line) - (beginning-of-buffer nil) - (end-of-buffer nil))) - -(defun helm-help-previous-line () - "Previous line function for `helm-help'." - (condition-case _err - (call-interactively #'previous-line) - (beginning-of-buffer nil) - (end-of-buffer nil))) - -(defun helm-help-toggle-mark () - "Toggle mark in `helm-help'." - (if (region-active-p) - (deactivate-mark) - (push-mark nil nil t))) - -(defun helm-help-org-cycle () - "Runs `org-cycle' in `helm-help'." - (helm-acase (helm-iter-next helm-help--iter-org-state) - ((guard* (numberp it)) (org-content)) - ;; See `helm--help-org-prefargs' about `org-cycle' ARG. - (t (org-cycle it)))) - -(defun helm-help-copy-region-as-kill () - "Copy region function for `helm-help'" - (copy-region-as-kill - (region-beginning) (region-end)) - (deactivate-mark)) - -(defun helm-help-quit () - "Quit `helm-help'." - (if (or (get-buffer-window helm-help-buffer-name 'visible) - (get-buffer-window helm-debug-output-buffer 'visible)) - (throw 'helm-help-quit nil) - (quit-window))) - -(defun helm-help-org-open-at-point () - "Calls `org-open-at-point' ignoring errors." - (ignore-errors - (org-open-at-point))) - -(defun helm-help-org-mark-ring-goto () - "Calls `org-mark-ring-goto' ignoring errors." - (ignore-errors - (org-mark-ring-goto))) - -(defvar helm--help-org-prefargs - (if (> emacs-major-version 28) - '(1 (4) (16)) '(1 (16) (64))) - "`org-cycle' ARG have not the same meaning across Emacs versions.") - -(defun helm-help-event-loop () - "The loop in charge of scanning keybindings in `helm-help'." - (let ((prompt (propertize - helm-help-default-prompt - 'face 'helm-helper)) - scroll-error-top-bottom - (helm-help--iter-org-state (helm-iter-circular helm--help-org-prefargs))) - (catch 'helm-help-quit - (helm-awhile (read-key prompt) - (let ((fun (cl-loop for (k . v) in helm-help-hkmap - when (eql (aref (kbd k) 0) it) - return v))) - (when fun - (if (and (commandp fun) - (not (memq fun helm-help-not-interactive-command))) - ;; For movement of cursor in help buffer we need to - ;; call interactively commands for impaired people - ;; using a synthetizer (Bug#1347). - (call-interactively fun) - (funcall fun)))))))) - -(defun helm-help-define-key (key function &optional override) - "Add KEY bound to fUNCTION in `helm-help-hkmap'. - -If OVERRIDE is non nil, all bindings associated with FUNCTION are -removed and only (KEY . FUNCTION) is kept. -If FUNCTION is nil (KEY . FUNCTION) is not added and removed from -alist if already present. -See `helm-help-hkmap' for supported keys and functions." - (cl-assert (not (cdr (split-string key))) nil - (format "Error: Unsuported key `%s'" key)) - (when override - (helm-awhile (rassoc function helm-help-hkmap) - (setq helm-help-hkmap (delete it helm-help-hkmap)))) - (helm-aif (and (null function) (assoc key helm-help-hkmap)) - (setq helm-help-hkmap (delete it helm-help-hkmap)) - (and function (add-to-list 'helm-help-hkmap `(,key . ,function))))) - -;;; Multiline transformer -;; -(defun helm-multiline-transformer (candidates _source) - (cl-loop with offset = (helm-interpret-value - (assoc-default 'multiline (helm-get-current-source))) - for cand in candidates - for disp = (or (car-safe cand) cand) - for real = (or (cdr-safe cand) cand) - if (numberp offset) - collect (cons (helm--multiline-get-truncated-candidate disp offset) - real) - else collect (cons disp real))) - -(defun helm--multiline-get-truncated-candidate (candidate offset) - "Truncate CANDIDATE when its length is > than OFFSET." - (with-temp-buffer - (insert candidate) - (goto-char (point-min)) - (if (and offset - (> (buffer-size) offset)) - (let ((end-str "[...]")) - (concat - (buffer-substring - (point) - (save-excursion - (forward-char offset) - (setq end-str (if (looking-at "\n") - end-str (concat "\n" end-str))) - (point))) - end-str)) - (buffer-string)))) - -;;; List processing -;; -(defun helm-flatten-list (seq) - "Return a list of all single elements of sublists in SEQ. - - Example: - (helm-flatten-list \\='(1 (2 . 3) nil (4 5 (6) 7) 8 (9 . 10))) - => (1 2 3 4 5 6 7 8 9 10)" - (let (result) - (cl-labels ((flatten - (seq) - (cl-loop for elm in seq - if (consp elm) - do (flatten - (if (atom (cdr elm)) - (list (car elm) (cdr elm)) - elm)) - else do (and elm (push elm result))))) - (flatten seq)) - (nreverse result))) - -(defun helm-mklist (obj) - "Return OBJ as a proper list. -Otherwise make a proper list with one element OBJ. -Anonymous functions (lambdas) are treated as single elements." - (if (and (helm-proper-list-p obj) (not (functionp obj))) - obj - (list obj))) - -(cl-defun helm-fast-remove-dups (seq &key (test 'eq)) - "Remove duplicates elements in list SEQ. - -This is same as `remove-duplicates' but with memoisation. -It is much faster, especially in large lists. -A test function can be provided with TEST argument key. -Default is `eq'. -NOTE: Comparison of special Elisp objects (e.g., markers etc.) -fails because their printed representations which are stored in -hash-table can't be compared with with the real object in SEQ. -This is a bug in `puthash' which store the printable -representation of object instead of storing the object itself, -this to provide at the end a printable representation of -hashtable itself." - (let ((table (make-hash-table :test test))) - (mapcan (lambda (x) - (unless (gethash x table) - (list (puthash x x table)))) - seq))) - -(defsubst helm--string-join (strings &optional separator) - "Join all STRINGS using SEPARATOR." - (mapconcat 'identity strings separator)) - -(defun helm--concat-regexps (regexp-list) - "Return a regexp which matches any of the regexps in REGEXP-LIST." - (if regexp-list - (concat "\\(?:" (helm--string-join regexp-list "\\)\\|\\(?:") "\\)") - "\\`\\'")) ; Match nothing - -(defun helm-skip-entries (seq black-regexp-list &optional white-regexp-list) - "Remove entries which match one of REGEXP-LIST from SEQ." - (let ((black-regexp (helm--concat-regexps black-regexp-list)) - (white-regexp (helm--concat-regexps white-regexp-list))) - (cl-loop for i in seq - unless (and (stringp i) - (string-match-p black-regexp i) - (null - (string-match-p white-regexp i))) - collect i))) - -(defun helm-boring-directory-p (directory black-list) - "Check if one regexp in BLACK-LIST matches DIRECTORY." - (helm-awhile (helm-basedir (directory-file-name - (expand-file-name directory))) - ;; Break at root to avoid infloop, root is / or on Windows - ;; C:/ i.e. :/ (Bug#2308). - (when (string-match-p "\\`[A-Za-z]?:?/\\'" it) - (cl-return nil)) - (when (cl-loop for r in black-list - thereis (string-match-p - r (directory-file-name directory))) - (cl-return t)) - (setq directory it))) - -(defun helm-shadow-entries (seq regexp-list) - "Put shadow property on entries in SEQ matching a regexp in REGEXP-LIST." - (let ((face 'italic)) - (cl-loop for i in seq - if (cl-loop for regexp in regexp-list - thereis (and (stringp i) - (string-match regexp i))) - collect (propertize i 'face face) - else collect i))) - -(defun helm-remove-if-not-match (regexp seq) - "Remove all elements of SEQ that don't match REGEXP." - (cl-loop for s in seq - for str = (cond ((symbolp s) - (symbol-name s)) - ((consp s) - (car s)) - (t s)) - when (string-match-p regexp str) - collect s)) - -(defun helm-remove-if-match (regexp seq) - "Remove all elements of SEQ that match REGEXP." - (cl-loop for s in seq - for str = (cond ((symbolp s) - (symbol-name s)) - ((consp s) - (car s)) - (t s)) - unless (string-match-p regexp str) - collect s)) - -(defun helm-transform-mapcar (fn seq) - "Apply function FN on all elements of list SEQ. -When SEQ is a list of cons cells apply FN on the cdr of each element, -keeping their car unmodified. - -Examples: - - (helm-transform-mapcar \\='upcase \\='(\"foo\" \"bar\")) - => (\"FOO\" \"BAR\") - (helm-transform-mapcar \\='upcase \\='((\"1st\" . \"foo\") (\"2nd\" . \"bar\"))) - => ((\"1st\" . \"FOO\") (\"2nd\" . \"BAR\")) -" - (cl-loop for elm in seq - if (consp elm) - collect (cons (car elm) (funcall fn (cdr elm))) - else - collect (funcall fn elm))) - -(defun helm-append-at-nth (seq elm index) - "Append ELM at INDEX in SEQ. -When INDEX is > to the SEQ length ELM is added at end of SEQ. -When INDEX is 0 or negative, ELM is added at beginning of SEQ. - -Examples: - - (helm-append-at-nth \\='(a b c d) \\='(z) 2) - =>(a b z c d) - - (helm-append-at-nth \\='(a b c d) \\='((x . 1) (y . 2)) 2) - =>(a b (x . 1) (y . 2) c d) - - (helm-append-at-nth \\='((a . 1) (b . 2) (c . 3)) \\='(x . 1) 1) - =>((a . 1) (x . 1) (b . 2) (c . 3)) -" - (setq index (min (max index 0) (length seq)) - elm (helm-mklist elm)) - (if (zerop index) - (append elm seq) - (let* ((end-part (nthcdr index seq)) - (len (length end-part)) - (beg-part (butlast seq len))) - (append beg-part elm end-part)))) - -;;;###autoload -(defun helm-add-to-list (var elm index &optional replace) - "Add or move ELM to the value of VAR at INDEX unless already here. - -If ELM is member of var value and at index INDEX, return var value -unchanged, if INDEX value is different move ELM at this `nth' INDEX value. -If ELM is not present in list add it at `nth' INDEX. - -If REPLACE is non nil replace element at INDEX by ELM. - -Do not use this function in helm code, use `helm-append-at-nth' -instead. It is meant to be used in config files only." - (cl-assert (boundp var) nil "Unbound variable `%s'" var) - (let ((val (symbol-value var)) - flag) - (cond ((and (member elm val) (equal elm (nth index val)))) - ((member elm val) - (setq val (delete elm val) flag t)) - ((and replace (not (< index 0)) (not (> index (length val)))) - (setq val (delete (nth index val) val) flag t)) - (t (setq flag t))) - (if flag - (set var (helm-append-at-nth val elm index)) - val))) - -(cl-defgeneric helm-take (seq n) - "Return the first N elements of SEQ if SEQ is longer than N. -It is used for narrowing list of candidates to the -`helm-candidate-number-limit'." - (if (> (length seq) n) (cl-subseq seq 0 n) seq)) - -(cl-defmethod helm-take ((seq list) n) - "`helm-take' optimized for lists." - (let ((store '())) - (if (> n (length seq)) - seq - (while (> (1+ (cl-decf n)) 0) - (push (pop seq) store)) - (nreverse store)))) - -(defalias 'helm-take-first-elements 'helm-take) -(make-obsolete 'helm-take-first-elements 'helm-take "3.9.1") - -(defun helm-source-by-name (name &optional sources) - "Get a Helm source in SOURCES by NAME. - -Optional argument SOURCES is a list of Helm sources which default -to `helm-sources'." - (cl-loop with src-list = (if sources - (cl-loop for src in sources - collect (if (listp src) - src - (symbol-value src))) - helm-sources) - for source in src-list - thereis (and (string= name (assoc-default 'name source)) source))) - -(defun helm-make-actions (&rest args) - "Build an alist with (NAME . ACTION) elements with each pairs in ARGS. -Where NAME is a string or a function returning a string or nil -and ACTION a function. -If NAME returns nil the pair is skipped. - -\(fn NAME ACTION ...)" - (cl-loop for (name fn) on args by #'cddr - when (functionp name) - do (setq name (funcall name)) - when name - collect (cons name fn))) - -(defun helm-closest-number-in-list (num list) - "Return closest number to NUM found in LIST. -LIST is a list of numbers and NUM a number." - (cl-loop for i in list - for diff = (if (> num i) (- num i) (- i num)) - collect (cons diff i) into res - minimize diff into min - finally return (cdr (assq min res)))) - -(defun helm-group-candidates-by (candidates function &optional selection separate) - "Group similar items in CANDIDATES according to FUNCTION. -Items not matching FUNCTION are grouped as well in a separate group. - -Example: - - (setq B \\='(1 2 3 4 5 6 7 8 9)) - - (helm-group-candidates-by B #\\='cl-oddp 2 \\='separate) - => ((2 4 6 8) (1 3 5 7 9)) - -SELECTION specify where to start in CANDIDATES. -Similar candidates to SELECTION will be listed on top. - -If SEPARATE is non-nil returns a list of groups i.e. a list of lists, -otherwise a plain list is returned." - (cl-loop with sel = (or selection (helm-get-selection) "") - with lst = (copy-sequence candidates) - while lst - for group = (cl-loop for c in lst - when (equal (funcall function c) - (funcall function sel)) - collect c into grp - and do (setq lst (delete c lst)) - finally return (prog1 grp - (setq sel (car lst)))) - if separate collect group - else append group)) - -(defun helm-reorganize-sequence-from-elm (sequence elm &optional reverse) - "Reorganize SEQUENCE from ELM. - -Examples: - - (helm-reorganize-sequence-from-elm \\='(a b c d e f g h i j k l) \\='e) - => (f g h i j k l a b c d e) - (helm-reorganize-sequence-from-elm \\='(a b c d e f g h i j k l) \\='e t) - => (d c b a l k j i h g f e) -" - (let* ((new-seq (if reverse - (reverse sequence) - sequence)) - (pos (1+ (helm-position elm new-seq :test 'equal)))) - (append (nthcdr pos new-seq) (helm-take new-seq pos)))) - -(cl-defun helm-position (elm seq &key (test 'eq) from-end) - "Return position of ELM in SEQ. -Comparison is tested with keyword TEST which default to `eq'. -If keyword FROM-END is non nil search from end." - (let ((count (if from-end (1- (length seq)) 0))) - (while (if from-end - (not (zerop count)) - (<= count (1- (length seq)))) - (when (funcall test (if (listp seq) - (car (nthcdr count seq)) - (aref seq count)) - elm) - (cl-return-from helm-position count)) - (setq count (funcall (if from-end #'1- #'1+) count))))) - -(defsubst helm-copy-sequence (seq) - "Return a copy of SEQ. -When the elements of SEQ are strings, they are -copied; they are not shared with the original. -Otherwise returns SEQ unchanged, the elements are not copied." - (cl-loop for elm in seq collect - (if (stringp elm) - (copy-sequence elm) - elm))) - -;;; Strings processing. -;; -(defun helm-stringify (elm) - "Return the representation of ELM as a string. -ELM can be a string, a number or a symbol." - (helm-acase elm - ((guard* (stringp it)) it) - ((guard* (numberp it)) (number-to-string it)) - ((guard* (symbolp it)) (symbol-name it)))) - -(defun helm-substring (str width) - "Return the substring of string STR from 0 to WIDTH. -Handle multibyte characters by moving by columns." - (with-temp-buffer - (save-excursion - (insert str)) - (move-to-column width) - (buffer-substring (pos-bol) (point)))) - -(defun helm-substring-by-width (str width &optional endstr) - "Truncate string STR to end at column WIDTH. -Similar to `truncate-string-to-width'. -Add ENDSTR at end of truncated STR. -Add spaces at end if needed to reach WIDTH when STR is shorter -than WIDTH." - (cl-loop for ini-str = str - then (substring ini-str 0 (1- (length ini-str))) - for sw = (string-width ini-str) - when (<= sw width) return - (concat ini-str endstr (make-string (- width sw) ? )))) - -(defun helm-string-multibyte-p (str) - "Check if string STR contains multibyte characters." - (cl-loop for c across str - thereis (> (char-width c) 1))) - -(defun helm-get-pid-from-process-name (process-name) - "Get pid from running process PROCESS-NAME." - ;; Protect system processes calls (Issue #2497) - ;; Ensure `list-system-processes' and `process-attributes' don't run - ;; on remote (only Emacs-28/29+). - (cl-loop with default-directory = temporary-file-directory - with process-list = (list-system-processes) - for pid in process-list - for process = (assoc-default 'comm (process-attributes pid)) - when (and process (string-match process-name process)) - return pid)) - -(defun helm-ff-find-printers () - "Return a list of available printers on Unix systems." - (when (executable-find "lpstat") - (let ((printer-list (with-temp-buffer - (call-process "lpstat" nil t nil "-a") - (split-string (buffer-string) "\n")))) - (cl-loop for p in printer-list - for printer = (car (split-string p)) - when printer - collect printer)))) - -(defun helm-region-active-p () - (and transient-mark-mode mark-active (/= (mark) (point)))) - -(defun helm-quote-whitespace (candidate) - "Quote whitespace, if some, in string CANDIDATE." - (replace-regexp-in-string " " "\\\\ " candidate)) - -(defun helm-current-line-contents () - "Current line string without properties." - (buffer-substring-no-properties (pos-bol) (pos-eol))) - -(defun helm--replace-regexp-in-buffer-string (regexp rep str &optional fixedcase literal subexp start) - "Replace REGEXP by REP in string STR. - -Same as `replace-regexp-in-string' but handle properly REP as -function with SUBEXP specified. - -E.g.: - - (helm--replace-regexp-in-buffer-string - \"e\\\\(m\\\\)acs\" \\='upcase \"emacs\" t nil 1) - => \"eMacs\" - - (replace-regexp-in-string - \"e\\\\(m\\\\)acs\" \\='upcase \"emacs\" t nil 1) - => \"eEMACSacs\" - -Also START argument behaves as expected unlike -`replace-regexp-in-string'. - -E.g.: - - (helm--replace-regexp-in-buffer-string \"f\" \"r\" \"foofoo\" t nil nil 3) - => \"fooroo\" - - (replace-regexp-in-string \"f\" \"r\" \"foofoo\" t nil nil 3) - => \"roo\" - -Unlike `replace-regexp-in-string' this function is buffer-based -implemented i.e. replacement is computed inside a temp buffer, so -REGEXP should be used differently than with -`replace-regexp-in-string'. - -NOTE: This function is used internally for -`helm-ff-query-replace-on-filenames' and builded for this. -You should use `replace-regexp-in-string' instead unless the -behaviour of this function is really needed." - (with-temp-buffer - (insert str) - (goto-char (or start (point-min))) - (while (re-search-forward regexp nil t) - (replace-match (cond ((and (functionp rep) subexp) - (funcall rep (match-string subexp))) - ((functionp rep) - (funcall rep str)) - (t rep)) - fixedcase literal nil subexp)) - (buffer-string))) - -(defun helm-url-unhex-string (str) - "Same as `url-unhex-string' but ensure STR is completely decoded." - (setq str (or str "")) - (with-temp-buffer - (save-excursion (insert str)) - (while (re-search-forward "%[A-Za-z0-9]\\{2\\}" nil t) - (replace-match (byte-to-string (string-to-number - (substring (match-string 0) 1) - 16)) - t t) - ;; Restart from beginning until string is completely decoded. - (goto-char (point-min))) - (decode-coding-string (buffer-string) 'utf-8))) - -(cl-defun helm-read-answer (prompt answer-list - &optional (help 'helm-read-answer-default-help-fn)) - "Prompt user for an answer. -Arg PROMPT is the prompt to present user the different possible -answers, ANSWER-LIST is a list of strings. -If user enters an answer which is one of ANSWER-LIST return this -answer, otherwise keep prompting for a valid answer. -Note that answer should be a single char, only short answer are -accepted. -When HELP is provided, it is a string or a function that returns a string -which will be displayed in a buffer when \"h\" -is pressed (don't forget to add \"h\" in prompt). - -Example: - - (helm-acase (helm-read-answer - \"answer [y,n,!,q,h]: \" - \\='(\"y\" \"n\" \"!\" \"q\")) - (\"y\" \"yes\") - (\"n\" \"no\") - (\"!\" \"all\") - (\"q\" \"quit\")) - -" - (unwind-protect - (helm-awhile (read-key (propertize - prompt 'face 'minibuffer-prompt)) - (let ((str (and (characterp it) (string it))) - (choices (remove "h" answer-list))) - (cond ((and str (member str choices)) - (cl-return str)) - ((and help (string= str "h")) - (helm-aif (get-buffer-window "*choices help*" 'visible) - (quit-window t it) - (with-current-buffer-window "*choices help*" - '(display-buffer-at-bottom - (window-height . fit-window-to-buffer) - (preserve-size . (nil . t))) - nil (progn - (insert (if (functionp help) - (funcall help) help)) - (setq-local cursor-type nil))))) - (t (message "Please answer by %s" - (mapconcat 'identity choices ", ")) - (sit-for 1))))) - (helm-aand help (get-buffer-window "*choices help*") (quit-window t it)))) - -(defun helm-read-answer-default-help-fn () - "Return a string suitable for `helm-read-answer' help." - (with-temp-buffer - (save-excursion - (insert "y: yes\n" - "n: no\n" - "!: yes for all\n" - "q: quit\n" - "h: toggle this help")) - (while (re-search-forward "^\\(.\\):" nil t) - (helm-add-face-text-properties (match-beginning 1) (match-end 1) - 'font-lock-variable-name-face)) - (buffer-string))) - -(defun helm-read-answer-dolist-with-action (prompt list action - &optional - prompt-formater - help-function) - "Read answer with PROMPT and execute ACTION on each element of LIST. - -Argument PROMPT is a format spec string e.g. \"Do this on %s?\" -which take each elements of LIST as argument, no need to provide -the help part i.e. [y,n,!,q] it will be already added. - -While looping through LIST, ACTION is executed on each elements -differently depending of answer: - -- y Execute ACTION on element. -- n Skip element. -- ! Don't ask anymore and execute ACTION on remaining elements. -- q Skip all remaining elements. - -PROMPT-FORMATER may be a function or a list containing strings and -functions. Functions either in list or alone are called on each element -in LIST to be displayed in PROMPT." - (let (dont-ask) - (catch 'break - (dolist (elm list) - (if dont-ask - (funcall action elm) - (helm-acase (helm-read-answer - (apply #'format - (concat prompt "[y,n,!,q,h]") - (helm-acase prompt-formater - ((guard* (consp it)) - (mapcar (lambda (x) - (if (functionp x) - (funcall x elm) - x)) - it)) - ((guard* (functionp it)) - (list (funcall it elm))) - (t (list elm)))) - '("y" "n" "!" "q") - (or help-function #'helm-read-answer-default-help-fn)) - ("y" (funcall action elm)) - ("n" (ignore)) - ("!" (prog1 - (funcall action elm) - (setq dont-ask t))) - ("q" (throw 'break nil)))))))) - -(defsubst helm-string-numberp (str) - "Return non nil if string STR represent a number." - (cl-assert (stringp str) t) - (cl-loop with chars = '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9) - for c across str always (memql c chars))) - -(defsubst helm-re-search-forward (regexp &optional bound noerror count) - "Same as `re-search-forward' but return nil when point doesn't move. -This avoid possible infloop when a wrong regexp is entered in minibuffer." - ;; See Issue#2652 and Issue#2653. - (let ((pos (point))) - (helm-acase (re-search-forward regexp bound noerror count) - ((guard* (eql it pos)) nil) - (t it)))) - -;;; Symbols routines -;; -(defun helm-symbolify (str-or-sym) - "Get symbol of STR-OR-SYM." - (helm-acase str-or-sym - ((guard* (symbolp it)) it) - ("" nil) - (t (intern it)))) - -(defun helm-symbol-name (obj) - "Return name of OBJ. -If object is a lambda, return \"Anonymous\"." - ;; lambdas are no more represented as list in - ;; Emacs-29+ Bug#2666. - (if (or (and (not (symbolp obj)) (functionp obj)) - (byte-code-function-p obj) - (helm-subr-native-elisp-p obj)) - "Anonymous" - (symbol-name obj))) - -(defun helm-describe-class (class) - "Display documentation of Eieio CLASS, a symbol or a string." - (cl-letf (((symbol-function 'cl--print-table) - #'helm-source--cl--print-table)) - (if (fboundp 'cl-describe-type) - (cl-describe-type (helm-symbolify class)) - (let ((helm-describe-function-function 'describe-function)) - (helm-describe-function (helm-symbolify class)))))) - -(defun helm-elisp-collect-slots-in-class (class) - (with-temp-buffer - (cl-letf (((symbol-function 'cl--print-table) - #'helm-source--cl--print-table)) - (cl--describe-class-slots (cl--find-class class)) - (goto-char (point-min)) - (cl-loop while (re-search-forward "^\\* \\(.*\\)" nil t) - for name = (match-string 1) - for doc = (save-excursion - (forward-line 1) - (let ((beg (point)) - (end (when (re-search-forward "^\\*" nil t) - (1- (match-beginning 0))))) - (when (and beg end) - (buffer-substring beg end)))) - collect (cons name (concat "* " name "\n" doc)))))) - -(defun helm-describe-function (func) - "Display documentation of FUNC, a symbol or string." - (cl-letf (((symbol-function 'message) #'ignore)) - (funcall helm-describe-function-function (helm-symbolify func)))) - -(defun helm-describe-variable (var) - "Display documentation of VAR, a symbol or a string." - (cl-letf (((symbol-function 'message) #'ignore)) - (funcall helm-describe-variable-function (helm-symbolify var)))) - -(defun helm-describe-symbol (sym) - "Display documentation of SYM, a symbol or a string." - (cl-letf (((symbol-function 'message) #'ignore)) - (let ((helm-describe-function-function 'describe-symbol)) - (funcall helm-describe-function-function (helm-symbolify sym))))) - -(defun helm-describe-face (face) - "Display documentation of FACE, a symbol or a string." - (let ((faces (helm-marked-candidates))) - (cl-letf (((symbol-function 'message) #'ignore)) - (describe-face (if (cdr faces) - (mapcar 'helm-symbolify faces) - (helm-symbolify face)))))) - -(defun helm-describe-re-char-classes-1 (exp) - (helm-acase exp - (":xdigit:" - (format "%s -This matches the hexadecimal digits. -‘0’ through ‘9’, ‘a’ through ‘f’ and ‘A’ through ‘F’." it)) - (":word:" - (format "%s -This matches any character that has word syntax. -Note that the syntax of a character, and thus which characters are considered -“word-constituent”, depends on the major mode." it)) - (":upper:" - (format "%s -This matches any upper-case letter. -It is determined by the current case table. -If ‘case-fold-search’ is non-‘nil’, this -also matches any lower-case letter. Note that a buffer can have -its own local case table different from the default one." it)) - (":unibyte:" - (format "%s -This matches any unibyte character." it)) - (":space:" - (format "%s -This matches any character that has whitespace syntax. -Note that the syntax of a character, and thus -which characters are considered “whitespace”, depends on the major mode." it)) - (":punct:" - (format "%s -This matches any punctuation character. -At present, for multibyte characters, it matches anything that has non-word syntax, -and thus its exact definition can vary from one major mode to another, since -the syntax of a character depends on the major mode.)" it)) - (":print:" - (format "%s -This matches any printing character. -Either spaces or graphic characters matched by ‘[:graph:]’." it)) - (":nonascii:" - (format "%s -This matches any non-ASCII character." it)) - (":multibyte:" - (format "%s -This matches any multibyte character." it)) - (":lower:" - (format "%s -This matches any lower-case letter. -It is determined by the current case table. -If ‘case-fold-search’ is non-‘nil’, this also matches -any upper-case letter. Note that a buffer can have its own local -case table different from the default one." it)) - (":graph:" - (format "%s -This matches graphic characters. -Everything except spaces, ASCII and -non-ASCII control characters, surrogates, and codepoints unassigned -by Unicode, as indicated by the Unicode ‘general-category’ property." it)) - (":digit:" - (format "%s -This matches ‘0’ through ‘9’. -Thus, ‘[-+[:digit:]]’ matches any digit,as well as ‘+’ and ‘-’." it)) - (":cntrl:" - (format "%s -This matches any cntrl character. -That is any character whose code is in the range 0–31." it)) - (":blank:" - (format "%s -This matches horizontal whitespace. -It is defined by Annex C of the Unicode Technical Standard #18. -In particular, it matches spaces,tabs, -and other characters whose Unicode ‘general-category’ -property indicates they are spacing separators." it)) - (":alpha:" - (format "%s -This matches any letter. -For multibyte characters, it matches characters -whose Unicode ‘general-category’ property indicates -they are alphabetic characters." it)) - (":alnum:" - (format "%s -This matches any letter or digit. -For multibyte characters, it matches characters -whose Unicode ‘general-category’ property -indicates they are alphabetic or decimal number characters." it)) - (":ascii:" - (format "%s -This matches any ASCII character (codes 0–127)." it)))) - -(defun helm-describe-re-char-classes (exp) - "Describe Char Classes for regexps." - (with-output-to-temp-buffer "*help*" - (princ (helm-describe-re-char-classes-1 exp)))) - -(defun helm-elisp--persistent-help (candidate fun &optional name) - "Used to build persistent actions describing CANDIDATE with FUN. -Argument NAME is used internally to know which command to use -when symbol CANDIDATE refers at the same time to a variable and a -function. -See `helm-elisp-show-help'." - (let ((hbuf (get-buffer (help-buffer)))) - (cond ((helm-follow-mode-p) - (if name - (funcall fun candidate name) - (funcall fun candidate))) - ((or (and (helm-get-attr 'help-running-p) - (string= candidate (helm-get-attr 'help-current-symbol)))) - (progn - ;; When started from a help buffer, - ;; Don't kill this buffer as it is helm-current-buffer. - (unless (equal hbuf helm-current-buffer) - (kill-buffer hbuf) - (set-window-buffer (get-buffer-window hbuf) - ;; It is generally - ;; helm-current-buffer but it may - ;; be another buffer when helm have - ;; been started from a dedicated window. - (if helm--buffer-in-new-frame-p - helm-current-buffer - helm-persistent-action-window-buffer))) - (helm-set-attr 'help-running-p nil)) - ;; Force running update hook to may be delete - ;; helm-persistent-action-display-window, this is done in - ;; helm-persistent-action-display-window (the function). - (unless helm--buffer-in-new-frame-p - (helm-update (regexp-quote (helm-get-selection))))) - (t - (if name - (funcall fun candidate name) - (funcall fun candidate)) - (helm-set-attr 'help-running-p t))) - (helm-set-attr 'help-current-symbol candidate))) - -(defcustom helm-find-function-default-project nil - "Default directories to search symbols definitions from `helm-apropos'. -A list of directories or a single directory name. -Helm will allow you selecting one of those directories with `M-n' when -using a prefix arg with the `find-function' action in `helm-apropos'. -This is a good idea to add the directory names of the projects you are -working on to quickly jump to the definitions in the project source -files instead of jumping to the loaded files located in `load-path'." - :type '(choice (repeat string) - string) - :group 'helm-elisp) - -(defun helm-find-function-noselect (func &optional root-dir type) - "Find FUNC definition without selecting buffer. -FUNC can be a symbol or a string. -Instead of looking in LOAD-PATH to find library, this function -search in all subdirs of ROOT-DIR, if ROOT-DIR is unspecified ask for -it with completion. -TYPE when nil specify function, for other values see -`find-function-regexp-alist'." - (require 'find-func) - (let* ((sym (helm-symbolify func)) - (dir (or root-dir (helm-read-file-name - "Project directory: " - :test 'file-directory-p - :default (helm-mklist helm-find-function-default-project) - :must-match t))) - (find-function-source-path - (cons dir (helm-walk-directory dir - :directories 'only - :path 'full))) - (symbol-lib (helm-acase type - ((defvar defface) - (or (symbol-file sym it) - (help-C-file-name sym 'var))) - ;; Sometimes e.g. with prefix key symbols - ;; `find-function-library' returns a list of only one - ;; element, the symbol itself i.e. no library. - (t (cdr (find-function-library sym))))) - (library (and symbol-lib - (find-library-name - (helm-basename symbol-lib t))))) - (if library - (find-function-search-for-symbol sym type library) - (error "Don't know where `%s' is defined" sym)))) - -(defun helm-find-function (func) - "Try to jump to FUNC definition. -With a prefix arg ask for the project directory to search in instead of -using LOAD-PATH." - (if (not helm-current-prefix-arg) - (find-function (helm-symbolify func)) - (let ((place (helm-find-function-noselect func))) - (if (cdr place) - (progn - (switch-to-buffer (car place)) (goto-char (cdr place))) - (helm-aif (car place) - (message "Couldn't find Function `%s' in `%s'" - func (buffer-name it)) - (message "Couldn't find Function `%s'" func)))))) - -(defun helm-find-variable (var) - "Try to jump to VAR definition. -With a prefix arg ask for the project directory to search in instead of -using LOAD-PATH." - (if (not helm-current-prefix-arg) - (find-variable (helm-symbolify var)) - (let ((place (helm-find-function-noselect var nil 'defvar))) - (when place - (switch-to-buffer (car place)) (goto-char (cdr place)))))) - -(defun helm-find-face-definition (face) - "Try to jump to FACE definition. -With a prefix arg ask for the project directory to search in instead of -using LOAD-PATH." - (if (not helm-current-prefix-arg) - (find-face-definition (helm-symbolify face)) - (let ((place (helm-find-function-noselect face nil 'defface))) - (when place - (switch-to-buffer (car place)) (goto-char (cdr place)))))) - -(defun helm-kill-new (candidate &optional replace) - "CANDIDATE is symbol or string. -See `kill-new' for argument REPLACE." - (kill-new (helm-stringify candidate) replace)) - -(defun helm-group-p (symbol) - "Return non nil when SYMBOL is a group." - (or (and (get symbol 'custom-loads) - (not (get symbol 'custom-autoload))) - (get symbol 'custom-group))) - - -;;; Modes -;; -(defun helm-same-major-mode-p (start-buffer alist) - "Decide if current-buffer is related to START-BUFFER. -Argument ALIST is an alist of associated major modes." - ;; START-BUFFER is the current-buffer where we start searching. - ;; Determine the major-mode of START-BUFFER as `cur-maj-mode'. - ;; Each time the loop go in another buffer we try from this buffer - ;; to determine if its `major-mode' is: - ;; - same as the `cur-maj-mode' - ;; - derived from `cur-maj-mode' and from - ;; START-BUFFER if its mode is derived from the one in START-BUFFER. - ;; - have an assoc entry (major-mode . cur-maj-mode) - ;; - have an rassoc entry (cur-maj-mode . major-mode) - ;; - check if one of these entries inherit from another one in - ;; `alist'. - (let* ((cur-maj-mode (with-current-buffer start-buffer major-mode)) - (maj-mode major-mode) - (c-assoc-mode (assq cur-maj-mode alist)) - (c-rassoc-mode (rassq cur-maj-mode alist)) - (o-assoc-mode (assq major-mode alist)) - (o-rassoc-mode (rassq major-mode alist)) - (cdr-c-assoc-mode (cdr c-assoc-mode)) - (cdr-o-assoc-mode (cdr o-assoc-mode))) - (or (eq major-mode cur-maj-mode) - (derived-mode-p cur-maj-mode) - (with-current-buffer start-buffer - (derived-mode-p maj-mode)) - (or (eq cdr-c-assoc-mode major-mode) - (eq (car c-rassoc-mode) major-mode) - (eq (cdr (assq cdr-c-assoc-mode alist)) - major-mode) - (eq (car (rassq cdr-c-assoc-mode alist)) - major-mode)) - (or (eq cdr-o-assoc-mode cur-maj-mode) - (eq (car o-rassoc-mode) cur-maj-mode) - (eq (cdr (assq cdr-o-assoc-mode alist)) - cur-maj-mode) - (eq (car (rassq cdr-o-assoc-mode alist)) - cur-maj-mode))))) - -;;; Source processing -;; -(defun helm-map-candidates-in-source (src fn pred) - "Map over all candidates in SRC and execute FN if PRED returns non nil. -Arg FN and PRED are functions called with current display part of -candidate as arg." - (declare (indent 1)) - (save-excursion - (goto-char (helm-get-previous-header-pos)) - (helm-next-line) - (let* ((next-head (helm-get-next-header-pos)) - (end (and next-head - (save-excursion - (goto-char next-head) - (forward-line -1) - (point)))) - (maxpoint (or end (point-max)))) - (while (< (point) maxpoint) - (helm-mark-current-line) - (let ((cand (helm-get-selection nil 'withprop src))) - (when (funcall pred cand) - (funcall fn cand))) - (forward-line 1) (end-of-line))))) - -;;; Files routines -;; -(defun helm-file-name-sans-extension (filename) - "Same as `file-name-sans-extension' but remove all extensions." - (helm-aif (file-name-sans-extension filename) - ;; Start searching at index 1 for files beginning with a dot - ;; (bug#1335). - (if (string-match "\\." (helm-basename it) 1) - (helm-file-name-sans-extension it) - it))) - -(defsubst helm-file-name-extension (file) - "Returns FILE extension if it is not a number." - (helm-aif (file-name-extension file) - (and (not (helm-string-numberp it)) it))) - -(defun helm-basename (fname &optional ext) - "Print FNAME with any leading directory components removed. -If specified, also remove filename extension EXT. -If FNAME is a directory EXT arg is ignored. - -Arg EXT can be specified as a string, a number or `t' . -When specified as a string, this string is stripped from end of FNAME. -e.g. (helm-basename \"tutorial.el.gz\" \".el.gz\") => tutorial. -When `t' no checking of `file-name-extension' is done and the first -extension is removed unconditionally with `file-name-sans-extension'. -e.g. (helm-basename \"tutorial.el.gz\" t) => tutorial.el. -When a number, remove that many times extensions from FNAME until FNAME ends -with its real extension which is by default \".el\". -e.g. (helm-basename \"tutorial.el.gz\" 2) => tutorial -To specify the extension where to stop use a cons cell where the cdr is a regexp -matching extension e.g. (2 . \\\\.py$). -e.g. (helm-basename \"~/ucs-utils-6.0-delta.py.gz\" \\='(2 . \"\\\\.py\\\\\\='\")) -=>ucs-utils-6.0-delta." - (let ((non-essential t) - (ext-regexp (cond ((consp ext) (cdr ext)) - ((numberp ext) "\\.el\\'") - (t ext))) - result) - (cond ((or (null ext) (file-directory-p fname)) - (file-name-nondirectory (directory-file-name fname))) - ((or (numberp ext) (consp ext)) - (cl-dotimes (_ (if (consp ext) (car ext) ext)) - (let ((bn (file-name-nondirectory (or result fname)))) - (helm-aif (file-name-sans-extension bn) - (if (string-match-p ext-regexp bn) - (cl-return (setq result (file-name-sans-extension bn))) - (setq result (file-name-sans-extension bn)))))) - result) - ((eq t ext) - (file-name-sans-extension (file-name-nondirectory fname))) - ((stringp ext) - (replace-regexp-in-string (concat (regexp-quote ext) "\\'") "" - (file-name-nondirectory fname)))))) - -(defun helm-basedir (fname &optional parent) - "Return the base directory of FNAME ending by a slash. -If PARENT is non nil and FNAME is a directory return the parent -directory of FNAME, if PARENT is a number return the parent directory up to -PARENT level. -If PARENT is not specified but FNAME doesn't end by a slash, the returned value -is same as with PARENT." - (helm-aif (and fname - (or (and (string= fname "~") "~") - (file-name-directory - (helm-acase parent - ((guard* (numberp it)) - (cl-loop repeat it - for bd = (helm-basedir (or bd fname) t) - finally return bd)) - ((guard* (eq it t)) - (directory-file-name fname)) - (t fname))))) - (file-name-as-directory it))) - -(defun helm-current-directory () - "Return current-directory name at point. -It is done according to `helm-current-directory-alist'." - (expand-file-name - (helm-acase major-mode - ((guard* (assoc-default it helm-current-directory-alist)) - (helm-interpret-value guard)) - (t default-directory)))) - -(defun helm-shadow-boring-files (files) - "Files matching `helm-boring-file-regexp' will be -displayed with the `file-name-shadow' face if available." - (helm-shadow-entries files helm-boring-file-regexp-list)) - -(defun helm-skip-boring-files (files) - "Files matching `helm-boring-file-regexp' will be skipped." - (helm-skip-entries files helm-boring-file-regexp-list)) - -(defun helm-skip-current-file (files) - "Current file will be skipped." - (remove (buffer-file-name helm-current-buffer) files)) - -(defun helm-w32-pathname-transformer (args) - "Change undesirable features of windows pathnames to ones more acceptable to -other candidate transformers." - (if (eq system-type 'windows-nt) - (helm-transform-mapcar - (lambda (x) - (replace-regexp-in-string - "/cygdrive/\\(.\\)" "\\1:" - (replace-regexp-in-string "\\\\" "/" x))) - args) - args)) - -(defun helm-w32-prepare-filename (file) - "Convert filename FILE to something usable by external w32 executables." - (replace-regexp-in-string ; For UNC paths - "/" "\\" - (replace-regexp-in-string ; Strip cygdrive paths - "/cygdrive/\\(.\\)" "\\1:" - file nil nil) nil t)) - -(defun helm-w32-shell-execute-open-file (file) - (with-no-warnings - (w32-shell-execute "open" (helm-w32-prepare-filename file)))) - -;; Same as `vc-directory-exclusion-list'. -(defvar helm-walk-ignore-directories - '("SCCS/" "RCS/" "CVS/" "MCVS/" ".svn/" ".git/" ".hg/" ".bzr/" - "_MTN/" "_darcs/" "{arch}/" ".gvfs/")) - -(defsubst helm--dir-file-name (file dir) - (expand-file-name - (substring file 0 (1- (length file))) dir)) - -(defsubst helm--dir-name-p (str) - (char-equal (aref str (1- (length str))) ?/)) - -(cl-defun helm-walk-directory (directory &key (path 'basename) - directories - match skip-subdirs - noerror) - "Walk through DIRECTORY tree. - -Argument PATH can be one of basename, relative, full, or a -function called on file name, default to basename. - -Argument DIRECTORIES when t return also directories names, -otherwise skip directories names, with a value of `only' returns -only subdirectories, i.e. files are skipped. - -Argument MATCH is a regexp matching files or directories. - -Argument SKIP-SUBDIRS when t will skip -`helm-walk-ignore-directories', otherwise if it is given as a -list of directories, this list will be used instead of -`helm-walk-ignore-directories'. - -Argument NOERROR when t will skip directories which are not -accessible." - (let ((fn (cl-case path - (basename 'file-name-nondirectory) - (relative 'file-relative-name) - (full 'identity) - (t path)))) ; A function. - (setq skip-subdirs (if (listp skip-subdirs) - skip-subdirs - helm-walk-ignore-directories)) - (cl-labels ((ls-rec (dir) - (unless (file-symlink-p dir) - (cl-loop for f in (sort (file-name-all-completions "" dir) - 'string-lessp) - unless (member f '("./" "../")) - ;; A directory. - ;; Use `helm--dir-file-name' to remove the final slash. - ;; Needed to avoid infloop on directory symlinks. - if (and (helm--dir-name-p f) - (helm--dir-file-name f dir)) - nconc - (unless (or (member f skip-subdirs) - (and noerror - (not (file-accessible-directory-p it)))) - (if (and directories - (or (null match) - (string-match match f))) - (nconc (list (concat (funcall fn it) "/")) - (ls-rec it)) - (ls-rec it))) - ;; A regular file. - else nconc - (when (and (null (eq directories 'only)) - (or (null match) (string-match match f))) - (list (funcall fn (expand-file-name f dir)))))))) - (ls-rec directory)))) - -(defun helm-file-expand-wildcards (pattern &optional full) - "Same as `file-expand-wildcards' but allow recursion. -Recursion happens when PATTERN starts with two stars. -Directories expansion is not supported." - (let ((bn (helm-basename pattern)) - (case-fold-search nil)) - (if (and helm-file-globstar - (string-match "\\`\\*\\{2\\}\\(.*\\)" bn)) - (helm-walk-directory (helm-basedir pattern) - :path (cl-case full - (full 'full) - (relative 'relative) - ((basename nil) 'basename) - (t 'full)) - :directories nil - :match (or (helm-wildcard-to-regexp bn) - (wildcard-to-regexp bn)) - :skip-subdirs t) - (helm-aif (helm-wildcard-to-regexp bn) - (directory-files (helm-basedir pattern) full it) - ;; `file-expand-wildcards' fails to expand weird directories - ;; like "[ foo.zz ] bar.*.avi", fallback to `directory-files' - ;; in such cases. - (or (file-expand-wildcards pattern full) - (directory-files (helm-basedir pattern) - full (wildcard-to-regexp bn))))))) - -(defun helm-wildcard-to-regexp (wc) - "Transform wilcard WC like \"**.{jpg,jpeg}\" in REGEXP." - (when (string-match ".*\\(\\*\\{1,2\\}\\)\\.[{]\\(.*\\)[}]\\'" wc) - (format ".*\\.\\(%s\\)$" - (replace-regexp-in-string - "," "\\\\|" (match-string 2 wc))))) - -(defun helm-locate-lib-get-summary (file) - "Extract library description from FILE." - (with-temp-buffer - (let (desc) - (cl-letf (((symbol-function 'message) #'ignore)) - (insert-file-contents file nil 0 128)) - (goto-char (point-min)) - (when (re-search-forward "^;;;?\\(.*\\) ---? \\(.*\\)" (pos-eol) t) - (setq desc (match-string-no-properties 2))) - (if (or (null desc) (string= "" desc) - ;; Fix issue#2716 with an header line like - ;; ";; foo --- -*-[...]" i.e. desc is not provided. - (string-match "\\`-\\*-" desc)) - "Not documented" - (car (split-string desc "-\\*-" nil "[ \t\n\r-]+")))))) - -(defun helm-local-directory-files (directory &rest args) - "Run `directory-files' without tramp file name handlers. -Take same args as `directory-files'." - (require 'tramp) - (let ((file-name-handler-alist - (cl-loop for (re . sym) in file-name-handler-alist - unless (and (symbolp sym) - (string-prefix-p "tramp-" (symbol-name sym))) - collect `(,re . ,sym))) - tramp-mode) - ;; Avoid error with 5nth arg COUNT which is not available in previous Emacs, - ;; at least 27.1, see bug#2662. - (apply #'directory-files directory args))) - -(defun helm-common-str-1 (files &optional dirp) - "Find the common string or directory in FILES. -When DIRP is non nil return the common part which is a directory." - (if (cdr files) - (cl-loop with base = (car files) - with others = nil - for file in files - for cpart = (if dirp - (helm-acase (fill-common-string-prefix base file) - ((guard* (and it (file-directory-p it))) it) - (t (and it (file-name-directory it)))) - (fill-common-string-prefix base file)) - if cpart - do (setq base cpart) - else do (push file others) - finally return (if (and others base) - (nconc (list (directory-file-name base)) - (helm-common-str-1 others)) - (list (and base (directory-file-name base))))) - (and files (list (directory-file-name - (file-name-directory (car files))))))) - -(defun helm-common-dir (files) - "Return the longest common directory path of FILES list. -If FILES are not all common to the same drive (Windows) a list of -common directory is returned." - (let ((result (helm-common-str-1 files t))) - (if (cdr result) result (car result)))) - -;; Tests: -;; (helm-common-dir '("c:/foo" "c:/foo/bar/baz" -;; "f:/foo" "e:/foo" "f:/foo/bar" -;; "d:/foo" "d:/foo/bar/baz" -;; "e:/foo/bar/baz")) -;; ("c:/foo" "e:/foo" "f:/foo" "d:/foo") - - -;; (helm-common-dir '("/home/you/download/foo/" -;; "/home/you/download/foo/bar/baz" -;; "/home/you/tmp/foo")) -;; "/home/you" - - -;;; helm internals -;; -(defun helm-set-pattern (pattern &optional noupdate) - "Set minibuffer contents to PATTERN. -If optional NOUPDATE is non-nil, the Helm buffer is not changed." - (with-selected-window (or (active-minibuffer-window) (minibuffer-window)) - ;; Minibuffer may have a read-only string when using completion-in-region, - ;; which prevent inserting in minibuffer. see - ;; `helm-mode--completion-in-region-initial-input'. - (let ((inhibit-read-only t)) - (delete-minibuffer-contents) - (insert pattern))) - (when noupdate - (setq helm-pattern pattern))) - -(defun helm-minibuffer-completion-contents () - "Return the user input in a minibuffer before point as a string. -That is what completion commands operate on." - (buffer-substring (field-beginning) (point))) - -(defmacro with-helm-buffer (&rest body) - "Eval BODY inside `helm-buffer'." - (declare (indent 0) (debug t)) - `(with-current-buffer (helm-buffer-get) - ,@body)) - -(defmacro with-helm-current-buffer (&rest body) - "Eval BODY inside `helm-current-buffer'." - (declare (indent 0) (debug t)) - `(with-current-buffer (or (and (buffer-live-p helm-current-buffer) - helm-current-buffer) - (setq helm-current-buffer - (current-buffer))) - ,@body)) - -(defun helm-buffer-get () - "Return `helm-action-buffer' if shown otherwise `helm-buffer'." - (if (helm-action-window) - helm-action-buffer - helm-buffer)) - -(defun helm-window () - "Window of `helm-buffer'." - (get-buffer-window (helm-buffer-get) 0)) - -(defun helm-action-window () - "Window of `helm-action-buffer'." - (get-buffer-window helm-action-buffer 'visible)) - -(defmacro with-helm-window (&rest body) - "Be sure BODY is excuted in the helm window." - (declare (indent 0) (debug t)) - `(with-selected-window (helm-window) - ,@body)) - -(defmacro helm-without-follow (&rest body) - "Ensure BODY runs without following. -I.e. when using `helm-next-line' and friends in BODY." - (declare (indent 0) (debug t)) - `(cl-letf (((symbol-function 'helm-follow-mode-p) - (lambda (&optional _) nil))) - (let (helm-follow-mode-persistent) - (progn ,@body)))) - -(defun helm-candidate-prefixed-p (candidate) - "Return non nil when CANDIDATE is prefixed. - -Candidates files are prefixed with [+] or a specific icon when candidate is a -non existing file, in other places candidates may be prefixed with an unknown -symbol [?], these candidate have the text property or -property." - (or (get-text-property 0 'helm-new-file candidate) - (get-text-property 0 'unknown candidate))) - -;; 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-flex 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))) - -(defvar helm-blacklist-completion-styles '(emacs21 emacs22)) -(defun helm--prepare-completion-styles (&optional com-or-mode styles) - "Return a suitable list of styles for `completion-styles'. - -When `helm-completion-style' is not `emacs' the Emacs vanilla -default `completion-styles' is used except for -`helm-dynamic-completion' which uses inconditionally `emacs' as -value for `helm-completion-style'. - -If styles are specified in `helm-completion-styles-alist' for a -particular mode, use these styles for the corresponding mode. -If COM-OR-MODE (a mode or a command) is specified it is used to find the -corresponding styles in `helm-completion-styles-alist'. - -If STYLES is specified as a list of styles suitable for -`completion-styles' these styles are used in the given order. -Otherwise helm style is added to `completion-styles' always after -flex or helm-flex completion style if present." - ;; For `helm-completion-style' and `helm-completion-styles-alist'. - (require 'helm-mode) - (let ((from (if com-or-mode com-or-mode major-mode))) - (if (memq helm-completion-style '(helm helm-fuzzy)) - ;; Keep default settings, but probably nil is fine as well. - '(basic partial-completion emacs22) - (or - styles - (helm-acase (cdr (assq from helm-completion-styles-alist)) - ((dst* (_l &rest args)) args)) - ;; 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 (and (memq wflex completion-styles) - (list wflex)) - (cl-loop for s in completion-styles - unless (or (memq s helm-blacklist-completion-styles) - (memq wflex completion-styles)) - collect s)))) - (helm-append-at-nth - styles '(helm) - (if (memq wflex completion-styles) - 1 0))))))) - -(defun helm-guess-filename-at-point () - (with-helm-current-buffer - ;; Ensure to disable the evil `ffap-machine-at-point' which may run here as - ;; `file-name-at-point-functions' contains by default - ;; `ffap-guess-file-name-at-point' See bug#2574. - ;; Use same value as in Emacs-29 for next 3 vars to ensure `ffap-machine-p' - ;; never ping. - (let ((ffap-machine-p-known 'accept) - (ffap-machine-p-local 'reject) - (ffap-machine-p-unknown 'reject)) - (run-hook-with-args-until-success 'file-name-at-point-functions)))) - -;; Yank text at point. -;; -;; -(defun helm-yank-text-at-point (arg) - "Yank text at point in `helm-current-buffer' into minibuffer." - (interactive "p") - (with-helm-current-buffer - (let ((fwd-fn (or helm-yank-text-at-point-function #'forward-word)) - diff) - ;; Start to initial point if C-w have never been hit. - (unless helm-yank-point - (setq helm-yank-point (car helm-current-position))) - (save-excursion - (goto-char helm-yank-point) - (helm-set-pattern - (if (< arg 0) - (with-temp-buffer - (insert helm-pattern) - (let ((end (point-max))) - (goto-char end) - (funcall fwd-fn -1) - (setq diff (- end (point))) - (delete-region (point) end) - (buffer-string))) - (funcall fwd-fn arg) - (concat - ;; Allow yankink beyond eol allow inserting e.g long - ;; urls in mail buffers. - helm-pattern (replace-regexp-in-string - "\\`\n" "" - (buffer-substring-no-properties - helm-yank-point (point)))))) - (setq helm-yank-point (if diff (- (point) diff) (point))))))) -(put 'helm-yank-text-at-point 'helm-only t) - -(defun helm-undo-yank-text-at-point () - "Undo last entry added by `helm-yank-text-at-point'." - (interactive) - (helm-yank-text-at-point -1)) -(put 'helm-undo-yank-text-at-point 'helm-only t) - -(defun helm-reset-yank-point () - (setq helm-yank-point nil)) - -(add-hook 'helm-cleanup-hook 'helm-reset-yank-point) -(add-hook 'helm-after-initialize-hook 'helm-reset-yank-point) - - -;;; Ansi -;; -;; -(defvar helm--ansi-color-regexp - "\033\\[\\(K\\|[0-9;]*m\\)") -(defvar helm--ansi-color-drop-regexp - "\033\\[\\([ABCDsuK]\\|[12][JK]\\|=[0-9]+[hI]\\|[0-9;]*[Hf]\\)") -(with-suppressed-warnings ((obsolete ansi-color-apply-sequence)) - (defun helm--ansi-color-apply (string) - "A version of `ansi-color-apply' immune to upstream changes. - -Similar to the emacs-24.5 version without support to -`ansi-color-context' which is buggy in Emacs. - -Modify also `ansi-color-regexp' by using own variable -`helm--ansi-color-regexp' that matches whole STRING. - -This is needed to provide compatibility for both emacs-25 and -emacs-24.5 as emacs-25 version of `ansi-color-apply' is partially -broken." - (require 'ansi-color) - (let ((start 0) - codes end escape-sequence - result colorized-substring) - ;; Find the next escape sequence. - (while (setq end (string-match helm--ansi-color-regexp string start)) - (setq escape-sequence (match-string 1 string)) - ;; Colorize the old block from start to end using old face. - (when codes - (put-text-property - start end 'font-lock-face (ansi-color--find-face codes) string)) - (setq colorized-substring (substring string start end) - start (match-end 0)) - ;; Eliminate unrecognized ANSI sequences. - (while (string-match helm--ansi-color-drop-regexp colorized-substring) - (setq colorized-substring - (replace-match "" nil nil colorized-substring))) - (push colorized-substring result) - ;; Create new face, by applying escape sequence parameters. - (setq codes (ansi-color-apply-sequence escape-sequence codes))) - ;; If the rest of the string should have a face, put it there. - (when codes - (put-text-property - start (length string) - 'font-lock-face (ansi-color--find-face codes) string)) - ;; Save the remainder of the string to the result. - (if (string-match "\033" string start) - (push (substring string start (match-beginning 0)) result) - (push (substring string start) result)) - (apply 'concat (nreverse result))))) - -(when (< emacs-major-version 26) - (advice-add 'ansi-color-apply :override #'helm--ansi-color-apply)) - - -(provide 'helm-lib) - -;;; helm-lib.el ends here diff --git a/elpa/helm-core-20251211.709/helm-multi-match.el b/elpa/helm-core-20251211.709/helm-multi-match.el deleted file mode 100644 index 1a1a1d7f..00000000 --- a/elpa/helm-core-20251211.709/helm-multi-match.el +++ /dev/null @@ -1,439 +0,0 @@ -;;; helm-multi-match.el --- Multiple regexp matching methods for helm -*- lexical-binding: t -*- - -;; Original Author: rubikitch - -;; Copyright (C) 2008 ~ 2011 rubikitch -;; Copyright (C) 2011 ~ 2025 Thierry Volpiatto - -;; Author: Thierry Volpiatto -;; URL: http://github.com/emacs-helm/helm - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Code: - -(require 'cl-lib) -(require 'helm-lib) - - -(defgroup helm-multi-match nil - "Helm multi match." - :group 'helm) - -(defvar helm-mm-matching-method 'multi3 - "Matching method for helm match plugin. -You can set here different methods to match candidates in helm. -Here are the possible value of this symbol and their meaning: -- multi1: Respect order, prefix of pattern must match. -- multi2: Same but with partial match. -- multi3: The best, multiple regexp match, allow negation. -- multi3f: Same as multi3 but for files only (HFF and friends). -- multi3p: Same but prefix must match. - -Default is multi3, you should keep this for a better experience. - -The multi3f method is meant to be used within `helm-find-files' or at -least when matching on a list of files or strings with a leading common -part like the basedir of an absolute filename from the same directory -but never globally.") - - -;; Internal -(defvar helm-mm-default-match-functions - '(helm-mm-exact-match helm-mm-match)) -(defvar helm-mm-default-search-functions - '(helm-mm-exact-search helm-mm-search)) - - -;;; Build regexps -;; -;; -(defconst helm-mm-space-regexp "\\s\\\\s-" - "Regexp to represent space itself in multiple regexp match.") - -(defun helm-mm-split-pattern (pattern &optional grep-space) - "Split PATTERN if it contains spaces and return resulting list. -If spaces in PATTERN are escaped, don't split at this place. -i.e \"foo bar baz\"=> (\"foo\" \"bar\" \"baz\") -but \"foo\\ bar baz\"=> (\"foo\\s-bar\" \"baz\"). -If GREP-SPACE is used translate escaped space to \"\\s\" instead of \"\\s-\"." - (split-string - ;; Match spaces litteraly because candidate buffer syntax-table - ;; doesn't understand "\s-" properly. - (replace-regexp-in-string - helm-mm-space-regexp - (if grep-space "\\s" "\\s-") pattern nil t))) - -(defun helm-mm-1-make-regexp (pattern) - "Replace spaces in PATTERN with \".*\"." - (mapconcat 'identity (helm-mm-split-pattern pattern) ".*")) - - -;;; Exact match. -;; -;; -;; Internal. -(defvar helm-mm--exact-pattern-str nil) -(defvar helm-mm--exact-pattern-real nil) - -(defun helm-mm-exact-get-pattern (pattern) - (unless (equal pattern helm-mm--exact-pattern-str) - (setq helm-mm--exact-pattern-str pattern - helm-mm--exact-pattern-real (concat "^" (regexp-quote pattern) "$"))) - helm-mm--exact-pattern-real) - - -(defun helm-mm-exact-match (candidate &optional pattern) - (unless pattern (setq pattern helm-pattern)) - (if case-fold-search - (string= (downcase candidate) (downcase pattern)) - (string= candidate pattern))) - -(defun helm-mm-exact-search (pattern &rest _ignore) - (helm-re-search-forward (helm-mm-exact-get-pattern pattern) nil t)) - - -;;; Multiple regexp patterns 1 (order is preserved / prefix). -;; -;; Same as "^foo.*bar.*baz" -;; Internal -(defvar helm-mm--1-pattern-str nil) -(defvar helm-mm--1-pattern-real nil) - -(defun helm-mm-1-get-pattern (pattern) - (unless (equal pattern helm-mm--1-pattern-str) - (setq helm-mm--1-pattern-str pattern - helm-mm--1-pattern-real - (concat "^" (helm-mm-1-make-regexp pattern)))) - helm-mm--1-pattern-real) - -(defun helm-mm-1-match (candidate &optional pattern) - (unless pattern (setq 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)) - - -;;; Multiple regexp patterns 2 (order is preserved / partial). -;; -;; Same as "^.*foo.*bar.*baz" -;; Internal -(defvar helm-mm--2-pattern-str nil) -(defvar helm-mm--2-pattern-real nil) - -(defun helm-mm-2-get-pattern (pattern) - (unless (equal pattern helm-mm--2-pattern-str) - (setq helm-mm--2-pattern-str pattern - helm-mm--2-pattern-real - (concat "^.*" (helm-mm-1-make-regexp pattern)))) - helm-mm--2-pattern-real) - -(defun helm-mm-2-match (candidate &optional pattern) - (unless pattern (setq 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)) - - -;;; Multiple regexp patterns 3 (permutation). -;; -;; -;; Internal -(defvar helm-mm--3-pattern-str nil) -(defvar helm-mm--3-pattern-list nil) - -(defun helm-mm-3-get-patterns (pattern) - "Return a list of predicate/regexp cons cells. -E.g., ((identity . \"foo\") (not . \"bar\")). -If PATTERN is unchanged, 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) - -(defun helm-mm-3-get-patterns-internal (pattern) - "Return a list of predicate/regexp cons cells. -E.g., ((identity . \"foo\") (not . \"bar\"))." - (unless (string= pattern "") - (cl-loop for pat in (helm-mm-split-pattern pattern) - collect (if (char-equal ?! (aref pat 0)) - (cons 'not (substring pat 1)) - (cons 'identity pat))))) - -(defun helm-mm-regexp-p (string) - (string-match-p "[][*+^$.?]" string)) - -(defvar helm-mm--match-on-diacritics nil) - -(defun helm-mm-3-match (candidate &optional pattern) - "Check if PATTERN match CANDIDATE. -When PATTERN contains a space, it is splitted and matching is -done 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 contains a space. -E.g., \"foo bar\"=>((identity . \"foo\") (identity . \"bar\")). -Then each predicate of cons cell(s) is called with the regexp of -the same cons cell against CANDIDATE. -I.e. (identity (string-match \"foo\" \"foo bar\")) => t." - (let ((pat (helm-mm-3-get-patterns (or pattern helm-pattern)))) - (cl-loop for (predicate . regexp) in pat - for re = (if (and helm-mm--match-on-diacritics - (not (helm-mm-regexp-p regexp))) - (char-fold-to-regexp regexp) - regexp) - always (funcall predicate - (condition-case _err - ;; FIXME: Probably do nothing when - ;; using fuzzy leaving the job - ;; to the fuzzy fn. - (string-match re candidate) - (invalid-regexp nil)))))) - -(defun helm-mm-3-search-base (pattern searchfn1 searchfn2) - "Try to find PATTERN in `helm-buffer' with SEARCHFN1 and SEARCHFN2. -This is the search function for `candidates-in-buffer' enabled sources. -Use the same method as `helm-mm-3-match' except it search in buffer -instead of matching on a string. -i.e (identity (re-search-forward \"foo\" (pos-eol) t)) => t." - (cl-loop with pat = (if (stringp pattern) - (helm-mm-3-get-patterns pattern) - pattern) - with regex = (cdar pat) - with regex1 = (if (and regex - helm-mm--match-on-diacritics - (not (helm-mm-regexp-p regex))) - (char-fold-to-regexp regex) - regex) - with prefix-search = (eq searchfn1 'helm-mm-prefix-search) - ;; First pattern is a negation. - when (eq (caar pat) 'not) return - ;; Pass the job to `helm-search-match-part'. - ;; We now forward-line from `helm-search-from-candidate-buffer', see - ;; comments about bug#2650 there. - (list (pos-bol) (pos-eol)) - ;; Start searching the first pattern [1]. - while (condition-case _err - (funcall searchfn1 (or regex1 "") nil t) - (invalid-regexp nil)) - for bol = (pos-bol) - for eol = (pos-eol) - for end = (and prefix-search (+ bol (match-end 0))) ; End of prefix. - ;; Now search subsequent patterns on this line. - if (cl-loop for (pred . str) in (cdr pat) - for regexp = (if (and helm-mm--match-on-diacritics - (not (helm-mm-regexp-p str))) - (char-fold-to-regexp str) - str) - always - ;; Search from end of initial match (prefix) or from bol. - (progn (goto-char (or end bol)) - (funcall pred (condition-case _err - (funcall searchfn2 regexp eol t) - (invalid-regexp nil))))) - ;; When all patterns match on line move at eol or next line and exit - ;; with t. - do (helm-mm-3--search-move-forward bol eol) and return t - ;; if no matches continue [1] until the next matching line and so on. - else do (helm-mm-3--search-move-forward bol eol) - finally return nil)) - -(defun helm-mm-3--search-move-forward (bol eol) - "Move point forward for next search. -Forward line on empty lines, otherwise goto eol." - (if (eql bol eol) (forward-line 1) (goto-char eol))) - -(defun helm-mm-3-search (pattern &rest _ignore) - (helm-mm-3-search-base - pattern #'helm-re-search-forward #'helm-re-search-forward)) - -(defun helm-mm-3-search-on-diacritics (pattern &rest _ignore) - (let ((helm-mm--match-on-diacritics t)) - (helm-mm-3-search pattern))) - - -;;; mm-3f (match on filenames) -;; -;; -;; When this is called by HFF, the pattern is transformed like this: -;; "/home/you/foo/foo bar" => "/home/you/foo/ foo bar" so the prefix is always -;; the basedir. -(defun helm-mm-3f-match (candidate &optional pattern) - "Same as `helm-mm-3-match' but for files or prefix matching. -Once the first pattern is matched, the subsequent patterns match on the part of -CANDIDATE starting at end of first match. -Diacritics regexp is never used on the first pattern, the basedir." - ;; When matching a filename like "/home/you/github/foo-bar.txt" there is no - ;; problems with `helm-mm-3-match' as long as one of the patterns doesn't - ;; match the basedir of filename but as soon as you try to match a file with a - ;; name matching basedir we would match all the file of directory instead of - ;; just the files we want e.g. with a pattern like "/home/you/github/ foo git" - ;; you would match all files of directory instead of matching only - ;; "/home/you/github/foo-git.el" because "git" will always match "github". - (let ((pat (helm-mm-3-get-patterns (or pattern helm-pattern)))) - (cl-loop with end = nil - for (predicate . regexp) in pat - for re = (if (and helm-mm--match-on-diacritics - (not (helm-mm-regexp-p regexp))) - (char-fold-to-regexp regexp) - regexp) - ;; Use `char-fold-to-regexp' on subsequent patterns only. - for pref-re = (if end re (concat "\\`" regexp)) - always (funcall predicate - (prog1 (condition-case _err - (string-match pref-re candidate end) - (invalid-regexp nil)) - (unless end - (setq end (match-end 0)))))))) - -(defun helm-mm-3f-match-on-diacritics (candidate &optional pattern) - "Ignore diacritics in basename of files. -This happens as soon as you enter multi matching i.e. you add space(s) after -basedir." - (let ((helm-mm--match-on-diacritics t)) - (helm-mm-3f-match candidate (or pattern helm-pattern)))) - -;;; multiple regexp pattern 3 with prefix search -;; -;; -(defalias 'helm-mm-3p-match #'helm-mm-3f-match - "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.") - -;; This is just a wrapper around helm-re-search-forward but we need it in -;; helm-mm-3-search-base to decide if we use prefix search or not by comparing -;; symbols. -(defun helm-mm-prefix-search (pattern &rest _ignore) - (helm-re-search-forward pattern nil t)) - -(defun helm-mm-3p-search (pattern &rest _ignore) - (helm-mm-3-search-base - pattern 'helm-mm-prefix-search 'helm-re-search-forward)) - -;;; mm-3 with migemo -;; Needs https://github.com/emacs-jp/migemo -;; -(defvar helm-mm--previous-migemo-info nil - "[Internal] Cache previous migemo query.") -(make-local-variable 'helm-mm--previous-migemo-info) - -(declare-function migemo-get-pattern "ext:migemo.el") -(declare-function migemo-search-pattern-get "ext:migemo.el") - -(define-minor-mode helm-migemo-mode - "Enable migemo in helm. -It will be available in the sources handling it, -i.e. the sources which have the slot :migemo with non--nil value." - :lighter " Hmio" - :group 'helm - :global t - (cl-assert (featurep 'migemo) - nil "No feature called migemo found, install migemo.el.")) - -(defun helm-mm-migemo-get-pattern (pattern) - (let ((regex (migemo-get-pattern pattern))) - (if (ignore-errors (string-match regex "") t) - (concat regex "\\|" pattern) pattern))) - -(defun helm-mm-migemo-search-pattern-get (pattern) - (let ((regex (migemo-search-pattern-get pattern))) - (if (ignore-errors (string-match regex "") t) - (concat regex "\\|" pattern) pattern))) - -(defun helm-mm-migemo-string-match (pattern str) - "Migemo version of `string-match'." - (unless (assoc pattern helm-mm--previous-migemo-info) - (with-helm-buffer - (setq helm-mm--previous-migemo-info - (push (cons pattern (helm-mm-migemo-get-pattern pattern)) - helm-mm--previous-migemo-info)))) - (string-match (assoc-default pattern helm-mm--previous-migemo-info) str)) - -(defun helm-mm-diacritics-string-match (pattern str) - "Check if PATTERN match STR ignoring diacritics. - -If PATTERN is a regexp (i.e. `helm-mm-regexp-p') use PATTERN -unmodified, otherwise transform PATTERN with `char-fold-to-regexp'. - -This function is used to search match-part of candidate in in-buffer -sources." - (string-match (if (helm-mm-regexp-p pattern) - pattern - (char-fold-to-regexp pattern)) - str)) - -(defun helm-mm-3-migemo-match (candidate &optional pattern) - (unless pattern (setq 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 candidate))))) - -(defun helm-mm-migemo-forward (word &optional bound noerror count) - (with-helm-buffer - (unless (assoc word helm-mm--previous-migemo-info) - (setq helm-mm--previous-migemo-info - (push (cons word (if (delq 'ascii (find-charset-string word)) - word - (helm-mm-migemo-search-pattern-get word))) - helm-mm--previous-migemo-info)))) - (re-search-forward - (assoc-default word helm-mm--previous-migemo-info) bound noerror count)) - -(defun helm-mm-3-migemo-search (pattern &rest _ignore) - (and helm-migemo-mode - (helm-mm-3-search-base - pattern 'helm-mm-migemo-forward 'helm-mm-migemo-forward))) - - -;;; Generic multi-match/search functions -;; -;; -(defun helm-mm-match (candidate &optional pattern) - "Call `helm-mm-matching-method' function against CANDIDATE." - (unless pattern (setq pattern helm-pattern)) - (let ((fun (cl-ecase helm-mm-matching-method - (multi1 #'helm-mm-1-match) - (multi2 #'helm-mm-2-match) - (multi3 #'helm-mm-3-match) - (multi3f #'helm-mm-3f-match) - (multi3p #'helm-mm-3p-match)))) - (funcall fun candidate pattern))) - -(defun helm-mm-3-match-on-diacritics (candidate &optional pattern) - "Same as `helm-mm-3-match' but match on diacritics if possible." - (unless pattern (setq pattern helm-pattern)) - (let ((helm-mm--match-on-diacritics t)) - (helm-mm-match 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) - (multi3 #'helm-mm-3-search) - ((multi3p multi3f) #'helm-mm-3p-search)))) - (funcall fun pattern))) - - -(provide 'helm-multi-match) - - -;;; helm-multi-match.el ends here diff --git a/elpa/helm-core-20251211.709/helm-source.el b/elpa/helm-core-20251211.709/helm-source.el deleted file mode 100644 index 392eb8d2..00000000 --- a/elpa/helm-core-20251211.709/helm-source.el +++ /dev/null @@ -1,1356 +0,0 @@ -;;; helm-source.el --- Helm source creation. -*- lexical-binding: t -*- - -;; Copyright (C) 2015 ~ 2025 Thierry Volpiatto - -;; Author: Thierry Volpiatto -;; URL: http://github.com/emacs-helm/helm - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Commentary: - -;; Interface to create helm sources easily. -;; Currently the eieo objects are transformed in alist for compatibility. -;; In the future this package should allow creating source as eieo objects -;; without conversion to alist, teaching helm to read such a structure. -;; The compatibility with alists would be kept. - -;;; Code: - -(require 'cl-lib) -(require 'eieio) -(require 'helm-lib) - -(defvar helm-fuzzy-sort-fn) -(defvar helm-fuzzy-match-fn) -(defvar helm-fuzzy-search-fn) - -(declare-function helm-init-candidates-in-buffer "helm-core.el") -(declare-function helm-interpret-value "helm-core.el") -(declare-function helm-fuzzy-highlight-matches "helm-core.el") -(declare-function helm-marked-candidates "helm-core.el") - -;;; Advice Emacs fn -;; Make Classes's docstrings more readable by removing the attempts to align -;; unuseful stuff and add newline for separating slot documentation, as well -;; slots are in bold characters. - -(defun helm-source--cl--print-table (&rest args) - "Advice for `cl--print-table' to make readable class slots docstrings." - (let ((format "%s\n\n Initform=%s\n\n%s")) - (dolist (row (cadr args)) - (setcar row (propertize (car row) 'face 'bold)) - (setcdr row (nthcdr 1 (cdr row))) - (insert "\n* " (apply #'format format row) "\n")))) - -(cl-defgeneric helm--setup-source (source) - "Prepare slots and handle slot errors before creating a helm source.") - -(cl-defgeneric helm-setup-user-source (source) - "Allow users modifying slots in SOURCE just before creation.") - - -;;; Classes for sources -;; -;; -(defclass helm-source () - ((name - :initarg :name - :initform nil - :custom string - :documentation - " The name of the source. - A string which is also the heading which appears - above the list of matches from the source. Must be unique.") - - (header-name - :initarg :header-name - :initform nil - :custom function - :documentation - " A function returning the display string of the header. - Its argument is the name of the source. This attribute is useful to - add an additional information with the source name. - It doesn't modify the name of the source.") - - (init - :initarg :init - :initform nil - :custom function - :documentation - " Function called with no parameters when helm is started. - It is useful for collecting current state information which can be - used to create the list of candidates later. - Initialization of `candidates-in-buffer' is done here - with `helm-init-candidates-in-buffer'.") - - (candidates - :initarg :candidates - :initform nil - :custom (choice function list) - :documentation - " Specifies how to retrieve candidates from the source. - 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. - - In case of (DISPLAY . REAL) pairs, the DISPLAY string is shown - in the Helm buffer, but the REAL one is used as action - argument when the candidate is selected. This allows a more - readable presentation for candidates which would otherwise be, - for example, too long or have a common part shared with other - candidates which can be safely replaced with an abbreviated - string for display purposes. - - Note that if the (DISPLAY . REAL) form is used then pattern - matching is done on the displayed string, not on the real - value. - - This function, generally should not compute candidates according to - `helm-pattern' which defeat all the Helm's matching mechanism - i.e. multiple pattern matching and/or fuzzy matching. - If you want to do so, use :match-dynamic slot to be sure matching - occur only in :candidates function and there is no conflict with - other match functions.") - - (update - :initarg :update - :initform nil - :custom function - :documentation - " Function called with no parameters before :init function - when `helm-force-update' is called.") - - (cleanup - :initarg :cleanup - :initform nil - :custom function - :documentation - " Function called with no parameters when *helm* buffer is - closed. It is useful for killing unneeded candidates buffer. - - Note that the function is executed BEFORE performing action.") - - (keymap - :initarg :keymap - :initform 'helm-map - :custom sexp - :documentation - " Specific keymap for this source. - default value is `helm-map'.") - - (action - :initarg :action - :initform 'identity - :custom (alist :key-type string - :value-type function) - :documentation - " An alist of (DISPLAY . FUNCTION) pairs, a variable name or a function. - FUNCTION is called with one parameter: the selected candidate. - - An action other than the default can be chosen from this list - of actions for the currently selected candidate (by default - with TAB). The DISPLAY string is shown in the completions - buffer and the FUNCTION is invoked when an action is - selected. The first action of the list is the default. - - You should use `helm-make-actions' to build this alist easily.") - - (persistent-action - :initarg :persistent-action - :initform nil - :custom function - :documentation - " Can be a either a Function called with one parameter (the - selected candidate) or a cons cell where first element is this - same function and second element a symbol (e.g never-split) - that inform `helm-execute-persistent-action' to not split his - window to execute this persistent action. - Example: - - (defun foo-persistent-action (candidate) - (do-something candidate)) - - :persistent-action \\='(foo-persistent-action . never-split) ; Don't split - or - :persistent-action \\='foo-persistent-action ; Split - - When specifying :persistent-action by slot directly, foo-persistent-action - will be executed without quitting helm when hitting `C-j'. - - Note that other persistent actions can be defined using other - bindings than `C-j' by simply defining an interactive function bound - to a key in the keymap source. - The function should create a new attribute in source before calling - `helm-execute-persistent-action' on this attribute. - Example: - - (defun helm-ff-persistent-delete () - \"Delete current candidate without quitting.\" - (interactive) - (with-helm-alive-p - (helm-set-attr \\='quick-delete \\='(helm-ff-quick-delete . never-split)) - (helm-execute-persistent-action \\='quick-delete))) - - This function is then bound in `helm-find-files-map'.") - - (persistent-action-if - :initarg :persistent-action-if - :initform nil - :custom function - :documentation - " Similar from persistent action but it is a function that should - return an object suitable for persistent action when called , i.e. a - function or a cons cell. - Example: - - (defun foo-persistent-action (candidate) - (cond (something - ;; Don't split helm-window. - (cons (lambda (_ignore) - (do-something candidate)) - \\='no-split)) - ;; Split helm-window. - (something-else - (lambda (_ignore) - (do-something-else candidate))))) - - :persistent-action-if \\='foo-persistent-action - - Here when hitting `C-j' one of the lambda's will be executed - depending on something or something-else condition, splitting or not - splitting as needed. - See `helm-find-files-persistent-action-if' definition as another example.") - - (persistent-help - :initarg :persistent-help - :initform nil - :custom string - :documentation - " A string to explain persistent-action of this source. - It is a facility to display what persistent action does in - header-line, once your source is loaded don't use it directly, it will - have no effect, use instead `header-line' attribute. - It also accepts a function or a variable name. - It will be displayed in `header-line' or in `minibuffer' depending - of value of `helm-echo-input-in-header-line' and `helm-display-header-line'.") - - (help-message - :initarg :help-message - :initform nil - :custom (choice string function) - :documentation - " Help message for this source. - If not present, `helm-help-message' value will be used.") - - (multiline - :initarg :multiline - :initform nil - :custom (choice boolean integer) - :documentation - " Allow multiline candidates. - When non-nil candidates will be separated by `helm-candidate-separator'. - You can customize the color of this separator with `helm-separator' face. - Value of multiline can be an integer which specify the maximum size of the - multiline string to display, if multiline string is longer than this value - it will be truncated.") - - (requires-pattern - :initarg :requires-pattern - :initform 0 - :custom integer - :documentation - " If present matches from the source are shown only if the - pattern is not empty. Optionally, it can have an integer - parameter specifying the required length of input which is - useful in case of sources with lots of candidates.") - - (candidate-transformer - :initarg :candidate-transformer - :initform nil - :custom (choice function list) - :documentation - " It's a function or a list of functions called with one argument - when the completion list from the source is built. The argument - is the list of candidates retrieved from the source. The - function should return a transformed list of candidates which - will be used for the current completion. If it is a list of - functions, it calls each function sequentially. - - This can be used to transform or remove items from the list of - candidates. - - Note that `candidates' is run already, so the given transformer - function should also be able to handle candidates with (DISPLAY - . REAL) format.") - - (filtered-candidate-transformer - :initarg :filtered-candidate-transformer - :initform nil - :custom (choice function list) - :documentation - " It has the same format as `candidate-transformer', except the - function is called with two parameters: the candidate list and - the source. - - This transformer is run on the candidate list which is already - filtered by the current pattern. While `candidate-transformer' - is run only once, it is run every time the input pattern is - changed. - - It can be used to transform the candidate list dynamically, for - example, based on the current pattern. - - In some cases it may also be more efficent to perform candidate - transformation here, instead of with `candidate-transformer' - even if this transformation is done every time the pattern is - changed. For example, if a candidate set is very large then - `candidate-transformer' transforms every candidate while only - some of them will currently be displayed due to the limit - imposed by `helm-candidate-number-limit'. - - Note that `candidates' and `candidate-transformer' is run - already, so the given transformer function should also be able - to handle candidates with (DISPLAY . REAL) format.") - - (filter-one-by-one - :initarg :filter-one-by-one - :initform nil - :custom (choice function list) - :documentation - " A transformer function that treat candidates one by one. - It is called with one arg the candidate. - It is faster than `filtered-candidate-transformer' or - `candidate-transformer', but should be used only in sources - that recompute constantly their candidates, e.g `helm-source-find-files'. - Filtering happen early and candidates are treated - one by one instead of re-looping on the whole list. - If used with `filtered-candidate-transformer' or `candidate-transformer' - these functions should treat the candidates transformed by the - `filter-one-by-one' function in consequence.") - - (display-to-real - :initarg :display-to-real - :initform nil - :custom function - :documentation - " Transform the selected candidate when passing it to action. - - Function called with one parameter, the selected candidate. - - Avoid recomputing all candidates with candidate-transformer - or filtered-candidate-transformer to give a new value to REAL, - instead the selected candidate is transformed only when passing it - to action. This works (and make sense) only with plain string - candidates, it will NOT work when candidate is a cons cell, in this - case the real value of candidate will be used. - Example: - - (helm :sources (helm-build-sync-source \"test\" - :candidates \\='(a b c d e) - :display-to-real (lambda (c) (concat c \":modified by d-t-r\"))) - :buffer \"*helm test*\") - - Note that this is NOT a transformer, - so the display will not be modified by this function.") - - (real-to-display - :initarg :real-to-display - :initform nil - :custom function - :documentation - " Recompute all candidates computed previously with other transformers. - - Function called with one parameter, the selected candidate. - - The real value of candidates will be shown in display and of course - be used by action. - Example: - - (helm :sources (helm-build-sync-source \"test\" - :candidates \\='((\"foo\" . 1) (\"bar\" . 2) (\"baz\". 3)) - :real-to-display (lambda (c) (format \"%s\" (1+ c)))) - :buffer \"*helm test*\") - - Mostly deprecated, kept only for backward compatibility.") - - (marked-with-props - :initarg :marked-with-props - :initform nil - :custom (choice boolean symbol) - :documentation - " Get candidates with their properties in `helm-marked-candidates'. - Allow using the FORCE-DISPLAY-PART of `helm-get-selection' in marked - candidates, use t or \\='withprop to pass it to `helm-get-selection'.") - - (action-transformer - :initarg :action-transformer - :initform nil - :custom (choice function list) - :documentation - " It's a function or a list of functions called with two - arguments when the action list from the source is - assembled. The first argument is the list of actions, the - second is the current selection. If it is a list of functions, - it calls each function sequentially. - - The function should return a transformed action list. - - This can be used to customize the list of actions based on the - currently selected candidate.") - - (pattern-transformer - :initarg :pattern-transformer - :initform nil - :custom (choice function list) - :documentation - " It's a function or a list of functions called with one argument - before computing matches. Its argument is `helm-pattern'. - Functions should return transformed `helm-pattern'. - - It is useful to change interpretation of `helm-pattern'.") - - (candidate-number-limit - :initarg :candidate-number-limit - :initform nil - :custom integer - :documentation - " Override `helm-candidate-number-limit' only for this source.") - - (volatile - :initarg :volatile - :initform nil - :custom boolean - :documentation - " Indicates the source assembles the candidate list dynamically, - so it shouldn't be cached within a single Helm - invocation. It is only applicable to synchronous sources, - because asynchronous sources are not cached.") - - (match - :initarg :match - :initform nil - :custom (choice function list) - :documentation - " List of functions called with one parameter: a candidate. The - function should return non-nil if the candidate matches the - current pattern (see variable `helm-pattern'). - - When using `candidates-in-buffer' its default value is `identity' and - don't have to be changed, use the `search' slot instead. - - This attribute allows the source to override the default - pattern matching based on `string-match'. It can be used, for - example, to implement a source for file names and do the - pattern matching on the basename of files, since it's more - likely one is typing part of the basename when searching for a - file, instead of some string anywhere else in its path. - - If the list contains more than one function then the list of - matching candidates from the source is constructed by appending - the results after invoking the first function on all the - potential candidates, then the next function, and so on. The - matching candidates supplied by the first function appear first - in the list of results and then results from the other - functions, respectively. - - This attribute has no effect for asynchronous sources (see - attribute `candidates'), and sources using `match-dynamic' - since they perform pattern matching themselves. - - Note that FUZZY-MATCH slot will overhide value of this slot.") - - (diacritics - :initarg :diacritics - :initform nil - :custom boolean - :documentation - " Ignore diacritics when searching or matching. - - If it is a function, use that function that takes CANDIDATE as single - argument, otherwise, if non-nil use one of the default functions - depending of the method in use, either searching or matching.") - - (match-on-real - :initarg :match-on-real - :initform nil - :custom boolean - :documentation - "Match the real value of candidates when non nil. -Note that this assume you are using (DISPLAY . REAL) candidates and -these candidates are computed as cons cell _before_ -`helm-match-from-candidates' run. This mean you have to compute your -candidates as cons cell either in the :candidates or :init function or -in a :candidate-transformer. Expect an error if you compute your -candidates as cons cell in a :filtered-candidate-transformer.") - - (fuzzy-match - :initarg :fuzzy-match - :initform nil - :custom boolean - :documentation - " Enable fuzzy matching in this source. - This will overwrite settings in MATCH slot, and for - sources built with child class `helm-source-in-buffer' the SEARCH slot. - This also add a `filtered-candidate-transformer' function to sort candidates - (see `helm-fuzzy-sort-fn') according to the score of each candidate which is - computed with `helm-fuzzy-default-score-fn'. - This is an easy way of enabling fuzzy matching, but you can use the MATCH - or SEARCH slots yourself if you want something more elaborated, mixing - different type of match (See `helm-source-buffers' class for example), you - will have in this case to provide as well a sort fn - in `filtered-candidate-transformer' yourself. - - This attribute is not supported for asynchronous sources - since they perform pattern matching themselves.") - - (redisplay - :initarg :redisplay - :initform 'identity - :custom (choice list function) - :documentation - " A function or a list of functions to apply to current list - of candidates when redisplaying buffer with `helm-redisplay-buffer'. - This is only interesting for modifying and redisplaying the whole list - of candidates in async sources. - It uses `identity' by default for when async sources are mixed with - normal sources, in this case these normal sources are not modified and - redisplayed as they are.") - - (nomark - :initarg :nomark - :initform nil - :custom boolean - :documentation - " Don't allow marking candidates when this attribute is present.") - - (nohighlight - :initarg :nohighlight - :initform nil - :custom boolean - :documentation - " Disable highlighting matches in this source. - This will disable generic highlighting of matches, - but some specialized highlighting can be done from elsewhere, - i.e from `filtered-candidate-transformer' or `filter-one-by-one' slots. - So use this to either disable completely highlighting in your source, - or to disable highlighting and use a specialized highlighting matches - function for this source. - Remember that this function should run AFTER all filter functions if those - filter functions are modifying face properties, though it is possible to - avoid this by using new `add-face-text-property' in your filter functions.") - - (allow-dups - :initarg :allow-dups - :initform nil - :custom boolean - :documentation - " Allow helm collecting duplicates candidates.") - - (history - :initarg :history - :initform nil - :custom symbol - :documentation - " Allow passing history variable to helm from source. - It should be a quoted symbol. - Passing the history variable here have no effect - so add it also in the `helm' call with the :history keyword. - The main point of adding the variable here - is to make it available when resuming.") - - (coerce - :initarg :coerce - :initform nil - :custom function - :documentation - " It's a function called with one argument: the selected candidate. - This function is intended for type convertion. In normal case, - the selected candidate (string) is passed to action - function. If coerce function is specified, it is called just - before action function. - - Example: converting string to symbol - (coerce . intern)") - - (mode-line - :initarg :mode-line - :initform nil - :custom (choice string sexp) - :documentation - " Source local `helm-mode-line-string' (included in - `mode-line-format'). It accepts also variable/function name.") - - (header-line - :initarg :header-line - :initform nil - :custom (choice string function) - :documentation - " Source local `header-line-format'. - It will be displayed in `header-line' or in `minibuffer' depending - of value of `helm-echo-input-in-header-line' and `helm-display-header-line'. - It accepts also variable/function name.") - - (resume - :initarg :resume - :initform nil - :custom function - :documentation - " Function called with no parameters at end of initialization - when `helm-resume' is started. - If this function try to do something against `helm-buffer', (e.g updating, - searching etc...) probably you should run it in a timer to ensure - `helm-buffer' is ready.") - - (follow - :initarg :follow - :initform nil - :custom integer - :documentation - " Enable `helm-follow-mode' for this source only. - With a value of 1 enable, a value of -1 or nil disable the mode, value set to - \\='never prevent using `helm-follow-mode' in this source. - See `helm-follow-mode' for more infos.") - - (follow-delay - :initarg :follow-delay - :initform nil - :custom integer - :documentation - " `helm-follow-mode' will execute persistent-action after this delay. - Otherwise value of `helm-follow-input-idle-delay' is used if non--nil, - Fall back to 0.5 when none of these are found.") - - (multimatch - :initarg :multimatch - :initform t - :custom boolean - :documentation - " Use the multi-match algorithm when non-nil. - I.e Allow specifying multiple patterns separated by spaces. - When a pattern is prefixed by \"!\" the negation of this pattern is used, - i.e match anything but this pattern. - It is the standard way of matching in helm and is enabled by default. - It can be used with fuzzy-matching enabled, but as soon helm detect a space, - each pattern will match by regexp and will not be fuzzy.") - - (match-part - :initarg :match-part - :initform nil - :custom function - :documentation - " Allow matching only one part of candidate. - If source contain match-part attribute, match is computed only - on part of candidate returned by the call of function provided - by this attribute. The function should have one arg, candidate, - and return only a specific part of candidate. - On async sources, as matching is done by the backend, this have - no effect apart for highlighting matches.") - - (before-init-hook - :initarg :before-init-hook - :initform nil - :custom symbol - :documentation - " A local hook that run at beginning of initilization of this source. - i.e Before the creation of `helm-buffer'. - - Should be a variable (a symbol) bound to a list of - functions or a single function (see `run-hooks' documentation). - Even better is to use `add-hook' to feed this variable. - Usage of an anonymous function, or a list of functions is still - supported but not recommended.") - - (after-init-hook - :initarg :after-init-hook - :initform nil - :custom symbol - :documentation - " A local hook that run at end of initilization of this source. - i.e After the creation of `helm-buffer'. - - Should be a variable (a symbol) bound to a list of - functions or a single function (see `run-hooks' documentation). - Even better is to use `add-hook' to feed this variable. - Usage of an anonymous function, or a list of functions is still - supported but not recommended.") - - (delayed - :initarg :delayed - :initform nil - :custom (choice null integer) - :documentation - " 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 - " Same as `completing-read' require-match arg. - Possible values are: - - `t' which prevent exiting with an empty helm-buffer i.e. no matches. - - `confirm' which ask for confirmation i.e. need to press a second - time RET. - - `nil' is the default and is doing nothing i.e. returns nil when - pressing RET with an empty helm-buffer. - - Any other non nil values e.g. `ignore' allow exiting with - minibuffer contents as candidate value (in this case helm-buffer - is empty).") - - (find-file-target - :initarg :find-file-target - :initform nil - :custom function - :documentation - " Determine the target file when running `helm-quit-and-find-file'. - It is a function called with one arg SOURCE.") - - (group - :initarg :group - :initform 'helm - :custom symbol - :documentation - " The current source group, default to `helm' when not specified.") - (popup-info - :initarg :popup-info - :initform nil - :custom function - :documentation - " A function that show infos in a popup on the selected candidate. - This happen when `helm-popup-tip-mode' is enabled. - The function is called on candidate.") - (all-marked - :initarg :all-marked - :initform nil - :custom boolean - :documentation - " When non nil display marked candidates from all sources in mode-line.")) - - "Main interface to define helm sources." - :abstract t) - -(defclass helm-source-sync (helm-source) - ((candidates - :initform '("ERROR: You must specify the `candidates' slot, either with a list or a function")) - - (migemo - :initarg :migemo - :initform nil - :custom boolean - :documentation - " Enable migemo. - When multimatch is disabled, you can give the symbol \\='nomultimatch as value - to force not using generic migemo matching function. - In this case you have to provide your own migemo matching funtion - that kick in when `helm-migemo-mode' is enabled. - Otherwise it will be available for this source once `helm-migemo-mode' - is enabled when non-nil.") - - (match-strict - :initarg :match-strict - :initform nil - :custom function - :documentation - " When specifying a match function within a source and - helm-multi-match is enabled, the result of all matching - functions will be concatened, which in some cases is not what - is wanted. When using `match-strict' only this or these - functions will be used. You can specify those functions as a - list of functions or a single symbol function. - - NOTE: This have the same effect as using :MULTIMATCH nil.") - - (match-dynamic - :initarg :match-dynamic - :initform nil - :custom boolean - :documentation - " Disable all helm matching functions when non nil. - The :candidates function in this case is in charge of fetching - candidates dynamically according to `helm-pattern'. - If you want to make your :candidates function working with `completion-styles' - use the function `helm-dynamic-completion'. - Note that :volatile is automatically enabled when using this, so no - need to specify it.")) - - "Use this class to make helm sources using a list of candidates. -This list should be given as a normal list, a variable handling a list -or a function returning a list. -Matching is done basically with `string-match' against each candidate.") - -(defclass helm-source-async (helm-source) - ((candidates-process - :initarg :candidates-process - :initform nil - :custom function - :documentation - " This attribute is used to define a process as candidate. - 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 - as value, otherwise wrap the process call into a function. - The process buffer should be nil, otherwise, if you use - `helm-buffer' give to the process a sentinel.") - - (multimatch :initform nil)) - - "Use this class to define a helm source calling an external process. -The external process is called typically in a `start-process' call to be -asynchronous. - -Note that using multiples asynchronous sources is not fully working, -expect weird behavior if you try this. - -The :candidates slot is not allowed even if described because this class -inherit from `helm-source'.") - -(defclass helm-source-in-buffer (helm-source) - ((init - :initform 'helm-default-init-source-in-buffer-function) - - (data - :initarg :data - :initform nil - :custom (choice list string) - :documentation - " A string, a list or a buffer that will be used to feed the `helm-candidates-buffer'. - This data will be passed in a function added to the init slot and - the buffer will be build with `helm-init-candidates-in-buffer' or directly - with `helm-candidates-buffer' if data is a buffer. - This is an easy and fast method to build a `candidates-in-buffer' source.") - - (migemo - :initarg :migemo - :initform nil - :custom boolean - :documentation - " Enable migemo. - When multimatch is disabled, you can give the symbol \\='nomultimatch as value - to force not using generic migemo matching function. - In this case you have to provide your own migemo matching funtion - that kick in when `helm-migemo-mode' is enabled. - Otherwise it will be available for this source once `helm-migemo-mode' - is enabled when non-nil.") - - (candidates - :initform 'helm-candidates-in-buffer) - - (volatile - :initform t) - - (match - :initform '(identity)) - - (get-line - :initarg :get-line - :initform 'buffer-substring-no-properties - :custom function - :documentation - " A function like `buffer-substring-no-properties' or `buffer-substring'. - This function converts region from point at line-beginning and point - at line-end in the `helm-candidate-buffer' to a string which will be displayed - in the `helm-buffer', it takes two args BEG and END. - By default, `helm-candidates-in-buffer' uses - `buffer-substring-no-properties' which does no conversion and doesn't carry - text properties.") - - (search - :initarg :search - :initform '(helm-candidates-in-buffer-search-default-fn) - :custom (choice function list) - :documentation - " List of functions like `re-search-forward' or `search-forward'. - Buffer search function used by `helm-candidates-in-buffer'. - By default, `helm-candidates-in-buffer' uses `re-search-forward'. - The function should take one arg PATTERN. - If your search function needs to handle negation like multimatch, - this function should returns in such case a cons cell of two integers defining - the beg and end positions to match in the line previously matched by - `re-search-forward' or similar, and move point to next line - (See how the `helm-mm-3-search-base' and `helm-fuzzy-search' functions are working). - - NOTE: FUZZY-MATCH slot will overhide value of this slot.") - - (search-strict - :initarg :search-strict - :initform nil - :custom function - :documentation - " When specifying a search function within a source and - helm-multi-match is enabled, the result of all searching - functions will be concatened, which in some cases is not what - is wanted. When using `search-strict' only this or these - functions will be used. You can specify those functions as a - list of functions or a single symbol function. - - NOTE: This have the same effect as using a nil value for - :MULTIMATCH slot.")) - - "Use this source to make helm sources storing candidates inside a buffer. - -The buffer storing candidates is generated by `helm-candidate-buffer' function -and all search are done in this buffer, results are transfered to the `helm-buffer' -when done. -Contrarily to `helm-source-sync' candidates are matched using a function -like `re-search-forward' (see below documentation of `:search' slot) which makes -the search much faster than matching candidates one by one. -If you want to add search functions to your sources, don't use `:match' which -will raise an error, but `:search'. -See `helm-candidates-in-buffer' for more infos.") - -(defclass helm-source-dummy (helm-source) - ((candidates - :initform '("dummy")) - - (filtered-candidate-transformer - :initform (lambda (_candidates _source) (list helm-pattern))) - - (multimatch - :initform nil) - - (accept-empty - :initarg :accept-empty - :initform t - :custom boolean - :documentation - " Allow exiting with an empty string. - You should keep the default value.") - - (match - :initform 'identity) - - (volatile - :initform t))) - -(defclass helm-source-in-file (helm-source-in-buffer) - ((init :initform (lambda () - (let ((file (helm-get-attr 'candidates-file)) - (count 1)) - (with-current-buffer (helm-candidate-buffer 'global) - (insert-file-contents file) - (goto-char (point-min)) - (when (helm-get-attr 'linum) - (while (not (eobp)) - (add-text-properties - (pos-bol) (pos-eol) - `(helm-linum ,count)) - (cl-incf count) - (forward-line 1))))))) - (get-line :initform #'buffer-substring) - (candidates-file - :initarg :candidates-file - :initform nil - :custom string - :documentation - " The file used to fetch candidates.") - (linum - :initarg :linum - :initform nil - :documentation - " Store line number in each candidate when non nil. - Line number is stored in `helm-linum' text property.")) - - "The contents of the FILE will be used as candidates in buffer.") - - -;;; Error functions -;; -;; -(defun helm-default-init-source-in-buffer-function () - (helm-init-candidates-in-buffer 'global - '("ERROR: No buffer handling your data, use either the `init' slot or the `data' slot."))) - - -;;; Internal Builder functions. -;; -;; -(defun helm--create-source (object) - "[INTERNAL] Build a helm source from OBJECT. -Where OBJECT is an instance of an eieio class." - (cl-loop for sd in (eieio-class-slots (eieio-object-class object)) - for s = (eieio-slot-descriptor-name sd) - for slot-val = (slot-value object s) - when slot-val - collect (cons s slot-val))) - -(defun helm-make-source (name class &rest args) - "Build a `helm' source named NAME with ARGS for CLASS. -Argument NAME is a string which define the source name, so no need to use -the keyword :name in your source, NAME will be used instead. -Argument CLASS is a symbol defining an eieio class object. -Arguments ARGS are keyword value pairs as defined in CLASS." - (declare (indent 2)) - (let ((source (apply #'make-instance class :name name args))) - (helm--setup-source source) - (helm-setup-user-source source) - (helm--create-source source))) - -(defun helm-make-type (class &rest args) - (let ((source (apply #'make-instance class args))) - (setf (slot-value source 'name) nil) - (helm--setup-source source) - (helm--create-source source))) -(make-obsolete 'helm-make-type 'helm-make-source "4.0.3") - -(defvar helm-mm-default-search-functions) -(defvar helm-mm-default-match-functions) - -(defun helm-source-mm-get-search-or-match-fns (source method) - "Prepare match or search functions for class SOURCE. -Argument METHOD is the matching method used by SOURCE either `match' -or `search'." - (let* ((diacritics (slot-value source 'diacritics)) - (diacritics-fn (if (functionp diacritics) - diacritics - (helm-acase method - (match #'helm-mm-3-match-on-diacritics) - (search #'helm-mm-3-search-on-diacritics)))) - (defmatch (helm-aif (slot-value source 'match) - (helm-mklist it))) - (defmatch-strict (helm-aif (and (eq method 'match) - (slot-value source 'match-strict)) - (helm-mklist it))) - (defsearch (helm-aif (and (eq method 'search) - (slot-value source 'search)) - (helm-mklist it))) - (defsearch-strict (helm-aif (and (eq method 'search-strict) - (slot-value source 'search-strict)) - (helm-mklist it))) - (migemo (slot-value source 'migemo)) - ;; Ensure helm-mm-match/search is not used when one of the helm-mm-* - ;; fns is specified directly in source. - (helm-mm-default-match-functions - (if (cl-loop for fn in defmatch - thereis (memq fn '(helm-mm-3f-match - helm-mm-3p-match - helm-mm-3-match - helm-mm-2-match - helm-mm-1-match))) - (remove 'helm-mm-match helm-mm-default-match-functions) - helm-mm-default-match-functions)) - (helm-mm-default-search-functions - (if (cl-loop for fn in defsearch - thereis (memq fn '(helm-mm-3p-search - helm-mm-3-search - helm-mm-2-search - helm-mm-1-search))) - (remove 'helm-mm-search helm-mm-default-search-functions) - helm-mm-default-search-functions))) - (cl-case method - (match (cond (defmatch-strict) - ((and migemo diacritics) - (append (list 'helm-mm-exact-match diacritics-fn) - defmatch '(helm-mm-3-migemo-match))) - (migemo - (append helm-mm-default-match-functions - defmatch '(helm-mm-3-migemo-match))) - (diacritics - (delq nil `(helm-mm-exact-match ,@defmatch ,diacritics-fn))) - (defmatch - (append helm-mm-default-match-functions defmatch)) - (t helm-mm-default-match-functions))) - (search (cond (defsearch-strict) - ((and migemo diacritics) - (append '(helm-mm-exact-search) - defsearch - `(helm-mm-3-migemo-search ,diacritics-fn))) - (migemo - (append helm-mm-default-search-functions - defsearch '(helm-mm-3-migemo-search))) - (diacritics - (delq nil - `(helm-mm-exact-search ,@defsearch ,diacritics-fn))) - (defsearch - (append helm-mm-default-search-functions defsearch)) - (t helm-mm-default-search-functions)))))) - - -;;; Modifiers -;; -(cl-defun helm-source-add-action-to-source-if (name fn source predicate - &optional (index 4)) - "Same as `helm-add-action-to-source-if' but for SOURCE defined as eieio object. -You can use this inside a `helm--setup-source' method for a SOURCE defined as -an eieio class." - (let* ((actions (slot-value source 'action)) - (action-transformers (slot-value source 'action-transformer)) - (new-action (list (cons name fn))) - (transformer (lambda (actions _candidate) - (let ((candidate (car (helm-marked-candidates)))) - (cond ((funcall predicate candidate) - (helm-append-at-nth - actions new-action index)) - (t actions)))))) - (cond ((functionp actions) - (setf (slot-value source 'action) (list (cons "Default action" actions)))) - ((listp actions) - (setf (slot-value source 'action) (helm-interpret-value actions source)))) - (when (or (symbolp action-transformers) (functionp action-transformers)) - (setq action-transformers (list action-transformers))) - (setf (slot-value source 'action-transformer) - (delq nil (append (list transformer) action-transformers))))) - - -;;; Methods to build sources. -;; -;; -(defun helm-source--persistent-help-string (value source) - "Format `persistent-help' VALUE in SOURCE. -Argument VALUE can be a string, a variable or a function." - (substitute-command-keys - (format "\\\\[helm-execute-persistent-action]: %s (keeping session)" - (helm-aif value - (helm-interpret-value value source) - (slot-value source 'header-line))))) - -(defun helm-source--header-line (source) - "Compute a default header line for SOURCE. - -The header line is based on one of `persistent-action-if', -`persistent-action', or `action' (in this order of precedence)." - (substitute-command-keys - (concat "\\\\[helm-execute-persistent-action]: " - (helm-acond - ((slot-value source 'persistent-action-if) - (helm-symbol-name it)) - ((or (slot-value source 'persistent-action) - (slot-value source 'action)) - (cond ((and (symbolp it) - (functionp it) - (eq it 'identity)) - "Do Nothing") - ((and (symbolp it) - (boundp it) - (listp (symbol-value it)) - (stringp (caar (symbol-value it)))) - (caar (symbol-value it))) - ((or (symbolp it) (functionp it)) - (helm-symbol-name it)) - ((listp it) - (let ((action (car it))) - ;; It comes from :action ("foo" . function). - (if (stringp (car action)) - (car action) - ;; It comes from :persistent-action - ;; (function . 'nosplit) Fix Bug#788. - (if (or (symbolp action) - (functionp action)) - (helm-symbol-name action))))) - (t ""))) - (t "")) - " (keeping session)"))) - -(cl-defmethod helm--setup-source ((_source helm-source))) - -(cl-defmethod helm--setup-source :before ((source helm-source)) - (unless (slot-value source 'group) - (setf (slot-value source 'group) 'helm)) - (when (slot-value source 'delayed) - (warn "Deprecated usage of helm `delayed' slot in `%s'" - (slot-value source 'name))) - (helm-aif (slot-value source 'keymap) - (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)) - (setf (slot-value source 'header-line) (helm-source--header-line source))) - (when (slot-value source 'fuzzy-match) - (cl-assert helm-fuzzy-sort-fn nil "Wrong type argument functionp: nil") - (setf (slot-value source 'filtered-candidate-transformer) - (helm-aif (slot-value source 'filtered-candidate-transformer) - (append (helm-mklist it) - (list helm-fuzzy-sort-fn)) - (list helm-fuzzy-sort-fn)))) - (unless (slot-value source 'nohighlight) - (setf (slot-value source 'filtered-candidate-transformer) - (helm-aif (slot-value source 'filtered-candidate-transformer) - (append (helm-mklist it) - (list #'helm-fuzzy-highlight-matches)) - (list #'helm-fuzzy-highlight-matches)))) - (when (numberp (helm-interpret-value (slot-value source 'multiline))) - (setf (slot-value source 'filtered-candidate-transformer) - (helm-aif (slot-value source 'filtered-candidate-transformer) - (append (helm-mklist it) - (list #'helm-multiline-transformer)) - (list #'helm-multiline-transformer)))) - (helm-aif (slot-value source 'requires-pattern) - (let ((val (if (symbolp it) - (symbol-value it) - it))) - (setf (slot-value source 'requires-pattern) val))) - ;; Warn when hooks are defined as something else as a symbol i.e. a lambda or - ;; a list, if a function an error will raise later anyway when this function - ;; is called with `run-hooks'. - (let ((sname (slot-value source 'name))) - (helm-aif (slot-value source 'before-init-hook) - (when (or (and (functionp it) (not (symbolp it))) - (consp it)) - (warn "Helm source `%s': before-init-hook Should be defined as a symbol" sname))) - (helm-aif (slot-value source 'after-init-hook) - (when (or (and (functionp it) (not (symbolp it))) - (consp it)) - (warn "Helm source `%s': after-init-hook Should be defined as a symbol" sname))))) - -(cl-defmethod helm-setup-user-source ((_source helm-source))) - -(cl-defmethod helm--setup-source ((source helm-source-sync)) - (when (slot-value source 'fuzzy-match) - (helm-aif (slot-value source 'match) - (setf (slot-value source 'match) - (append (helm-mklist it) - (list helm-fuzzy-match-fn))) - (setf (slot-value source 'match) helm-fuzzy-match-fn))) - (when (slot-value source 'multimatch) - (setf (slot-value source 'match) - (helm-source-mm-get-search-or-match-fns source 'match))) - (helm-aif (and (null (slot-value source 'multimatch)) - (slot-value source 'migemo)) - (unless (eq it 'nomultimatch) ; Use own migemo fn. - (setf (slot-value source 'match) - (append (helm-mklist (slot-value source 'match)) - '(helm-mm-3-migemo-match))))) - (when (slot-value source 'match-dynamic) - (setf (slot-value source 'match) 'identity) - (setf (slot-value source 'match-part) nil) - (setf (slot-value source 'multimatch) nil) - (setf (slot-value source 'fuzzy-match) nil) - (setf (slot-value source 'volatile) t))) - -(cl-defmethod helm--setup-source ((source helm-source-in-buffer)) - (cl-assert (eq (slot-value source 'candidates) 'helm-candidates-in-buffer) - nil - (format "Wrong usage of `candidates' attr in `%s' use `data' or `init' instead" - (slot-value source 'name))) - (let ((cur-init (slot-value source 'init))) - (helm-aif (slot-value source 'data) - (setf (slot-value source 'init) - (delq - nil - (list - (and (null (eq 'helm-default-init-source-in-buffer-function - cur-init)) - cur-init) - (lambda () - (helm-init-candidates-in-buffer - 'global - (cond ((functionp it) (funcall it)) - ((and (bufferp it) (buffer-live-p it)) - (with-current-buffer it (buffer-string))) - (t it))))))))) - (when (slot-value source 'fuzzy-match) - (helm-aif (slot-value source 'search) - (setf (slot-value source 'search) - (append (helm-mklist it) - (list helm-fuzzy-search-fn))) - (setf (slot-value source 'search) (list helm-fuzzy-search-fn)))) - (when (slot-value source 'multimatch) - (setf (slot-value source 'search) - (helm-source-mm-get-search-or-match-fns source 'search))) - (helm-aif (and (null (slot-value source 'multimatch)) - (slot-value source 'migemo)) - (unless (eq it 'nomultimatch) - (setf (slot-value source 'search) - (append (helm-mklist (slot-value source 'search)) - '(helm-mm-3-migemo-search))))) - (let ((mtc (slot-value source 'match))) - (cl-assert (or (equal '(identity) mtc) - (eq 'identity mtc)) - nil "Invalid slot value for `match'") - (cl-assert (eq (slot-value source 'volatile) t) - nil "Invalid slot value for `volatile'"))) - -(cl-defmethod helm--setup-source ((source helm-source-async)) - (cl-assert (null (slot-value source 'candidates)) - nil "Incorrect use of `candidates' use `candidates-process' instead") - (cl-assert (null (slot-value source 'multimatch)) - nil "`multimatch' not allowed in async sources.") - (cl-assert (null (slot-value source 'fuzzy-match)) - nil "`fuzzy-match' not supported in async sources.")) - -(cl-defmethod helm--setup-source ((source helm-source-dummy)) - (let ((mtc (slot-value source 'match))) - (cl-assert (or (equal '(identity) mtc) - (eq 'identity mtc)) - nil "Invalid slot value for `match'") - (cl-assert (eq (slot-value source 'volatile) t) - nil "Invalid slot value for `volatile'") - (cl-assert (equal (slot-value source 'candidates) '("dummy")) - nil "Invalid slot value for `candidates'") - (cl-assert (eq (slot-value source 'accept-empty) t) - nil "Invalid slot value for `accept-empty'"))) - - -;;; User functions -;; -;; Sources -(defmacro helm-build-sync-source (name &rest args) - "Build a synchronous helm source with name NAME. -Args ARGS are keywords provided by `helm-source-sync'." - (declare (indent 1)) - `(helm-make-source ,name 'helm-source-sync ,@args)) - -(defmacro helm-build-async-source (name &rest args) - "Build a asynchronous helm source with name NAME. -Args ARGS are keywords provided by `helm-source-async'." - (declare (indent 1)) - `(helm-make-source ,name 'helm-source-async ,@args)) - -(defmacro helm-build-in-buffer-source (name &rest args) - "Build a helm source with name NAME using `candidates-in-buffer' method. -Args ARGS are keywords provided by `helm-source-in-buffer'." - (declare (indent 1)) - `(helm-make-source ,name 'helm-source-in-buffer ,@args)) - -(defmacro helm-build-dummy-source (name &rest args) - "Build a helm source with name NAME using `dummy' method. -Args ARGS are keywords provided by `helm-source-dummy'." - (declare (indent 1)) - `(helm-make-source ,name 'helm-source-dummy ,@args)) - -(defmacro helm-build-in-file-source (name file &rest args) - "Build a helm source with NAME name using `candidates-in-files' method. -Arg FILE is a filename, the contents of this file will be -used as candidates in buffer. -Args ARGS are keywords provided by `helm-source-in-file'." - (declare (indent 2)) - `(helm-make-source ,name 'helm-source-in-file - :candidates-file ,file ,@args)) - - -(provide 'helm-source) - -;;; helm-source.el ends here diff --git a/elpa/helm-core-20260424.1357/README-elpa b/elpa/helm-core-20260424.1357/README-elpa new file mode 100644 index 00000000..afaa443c --- /dev/null +++ b/elpa/helm-core-20260424.1357/README-elpa @@ -0,0 +1,3 @@ +Contains the main code for Helm. +As a package helm-core provides the files helm-core.el, helm-lib.el, +helm-source.el and helm-multi-match.el. diff --git a/elpa/helm-core-20260424.1357/helm-core-autoloads.el b/elpa/helm-core-20260424.1357/helm-core-autoloads.el new file mode 100644 index 00000000..ab085bdb --- /dev/null +++ b/elpa/helm-core-20260424.1357/helm-core-autoloads.el @@ -0,0 +1,262 @@ +;;; helm-core-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*- +;; Generated by the `loaddefs-generate' function. + +;; This file is part of GNU Emacs. + +;;; Code: + +(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path))) + + + +;;; Generated autoloads from helm-core.el + +(autoload 'helm-define-multi-key "helm-core" +"In KEYMAP, define key sequence KEY for function list FUNCTIONS. +Each function runs sequentially for each KEY press. +If DELAY is specified, switch back to initial function of FUNCTIONS list +after DELAY seconds. +The functions in FUNCTIONS list take no args. +E.g. + (defun foo () + (interactive) + (message \"Run foo\")) + (defun bar () + (interactive) + (message \"Run bar\")) + (defun baz () + (interactive) + (message \"Run baz\")) + +(helm-define-multi-key global-map (kbd \" q\") \\='(foo bar baz) 2) + +Each time \" q\" is pressed, the next function is executed. +Waiting more than 2 seconds between key presses switches back to +executing the first function on the next hit. + +(fn KEYMAP KEY FUNCTIONS &optional DELAY)") +(autoload 'helm-multi-key-defun "helm-core" +"Define NAME as a multi-key command running FUNS. +After DELAY seconds, the FUNS list is reinitialized. +See `helm-define-multi-key'. + +(fn NAME DOCSTRING FUNS &optional DELAY)" nil t) +(function-put 'helm-multi-key-defun 'doc-string-elt 2) +(autoload 'helm-define-key-with-subkeys "helm-core" +"Define in MAP a KEY and SUBKEY to COMMAND. + +This allows typing KEY to call COMMAND the first time and +type only SUBKEY on subsequent calls. + +Arg MAP is the keymap to use, SUBKEY is the initial short +key binding to call COMMAND. + +Arg OTHER-SUBKEYS is an alist specifying other short key bindings +to use once started, e.g.: + + (helm-define-key-with-subkeys global-map + (kbd \"C-x v n\") ?n \\='git-gutter:next-hunk + \\='((?p . git-gutter:previous-hunk))) + +In this example, `C-x v n' will run `git-gutter:next-hunk' +subsequent \"n\" will run this command again and subsequent \"p\" +will run `git-gutter:previous-hunk'. + +If specified PROMPT can be displayed in minibuffer to describe +SUBKEY and OTHER-SUBKEYS. Arg EXIT-FN specifies a function to run +on exit. + +For any other key pressed, run their assigned command as defined +in MAP and then exit the loop running EXIT-FN, if specified. + +If DELAY is specified the command expires after DELAY seconds. + +NOTE: SUBKEY and OTHER-SUBKEYS bindings support only char syntax +and vectors, so don't use strings to define them. While defining +or executing a kbd macro no SUBKEY or OTHER-SUBKEYS are provided, +i.e. the loop is not entered after running COMMAND. + +(fn MAP KEY SUBKEY COMMAND &optional OTHER-SUBKEYS PROMPT EXIT-FN DELAY DOCSTRING)") +(function-put 'helm-define-key-with-subkeys 'lisp-indent-function 1) +(autoload 'helm-configuration "helm-core" +"Customize Helm." t) +(autoload 'helm-debug-open-last-log "helm-core" +"Open Helm log file or buffer of last Helm session." t) +(autoload 'helm "helm-core" +"Main function to execute helm sources. + +PLIST is a list like + +(:key1 val1 :key2 val2 ...) + + or + +(&optional sources input prompt resume preselect + buffer keymap default history allow-nest). + +** Keywords + +Keywords supported: + +- :sources +- :input +- :prompt +- :resume +- :preselect +- :buffer +- :keymap +- :default +- :history +- :allow-nest + +Extra LOCAL-VARS keywords are supported, see the \"** Other +keywords\" section below. + +Basic keywords are the following: + +*** :sources + +One of the following: + +- List of sources +- Symbol whose value is a list of sources +- Alist representing a Helm source. + - In this case the source has no name and is referenced in + `helm-sources' as a whole alist. + +*** :input + +Initial input of minibuffer (temporary value of `helm-pattern') + +*** :prompt + +Minibuffer prompt. Default value is `helm--prompt'. + +*** :resume + +If t, allow resumption of the previous session of this Helm +command, skipping initialization. + +If \\='noresume, this instance of `helm' cannot be resumed. + +*** :preselect + +Initially selected candidate (string or regexp). + +*** :buffer + +Buffer name for this Helm session. `helm-buffer' will take this value. + +*** :keymap + +[Obsolete] + +Keymap used at the start of this Helm session. + +It is overridden by keymaps specified in sources, and is kept +only for backward compatibility. + +Keymaps should be specified in sources using the :keymap slot +instead. See `helm-source'. + +This keymap is not restored by `helm-resume'. + +*** :default + +Default value inserted into the minibuffer with +\\\\[next-history-element]. + +It can be a string or a list of strings, in this case +\\\\[next-history-element] cycles through +the list items, starting with the first. + +If nil, `thing-at-point' is used. + +If `helm-maybe-use-default-as-input' is non-nil, display is +updated using this value if this value matches, otherwise it is +ignored. If :input is specified, it takes precedence on :default. + +*** :history + +Minibuffer input, by default, is pushed to `minibuffer-history'. + +When an argument HISTORY is provided, input is pushed to +HISTORY. HISTORY should be a valid symbol. + +*** :allow-nest + +Allow running this Helm command in a running Helm session. + +** Other keywords + +Other keywords are interpreted as local variables of this Helm +session. The `helm-' prefix can be omitted. For example, + +(helm :sources \\='helm-source-buffers-list + :buffer \"*helm buffers*\" + :candidate-number-limit 10) + +Starts a Helm session with the variable +`helm-candidate-number-limit' set to 10. + +** Backward compatibility + +For backward compatibility, positional parameters are +supported: + +(helm sources input prompt resume preselect + buffer keymap default history allow-nest) + +However, the use of non-keyword args is deprecated. + +(fn &key SOURCES INPUT PROMPT RESUME PRESELECT BUFFER KEYMAP DEFAULT HISTORY ALLOW-NEST OTHER-LOCAL-VARS)") +(autoload 'helm-cycle-resume "helm-core" +"Cycle in `helm-buffers' list and resume when waiting more than 1.2s." t) +(autoload 'helm-other-buffer "helm-core" +"Simplified Helm interface with other `helm-buffer'. +Call `helm' only with SOURCES and BUFFER as args. + +(fn SOURCES BUFFER)") +(register-definition-prefixes "helm-core" '("helm-" "with-helm-")) + + +;;; Generated autoloads from helm-lib.el + +(autoload 'helm-add-to-list "helm-lib" +"Add or move ELM to the value of VAR at INDEX unless already here. + +If ELM is member of var value and at index INDEX, return var value +unchanged, if INDEX value is different move ELM at this `nth' INDEX value. +If ELM is not present in list add it at `nth' INDEX. + +If REPLACE is non nil replace element at INDEX by ELM. + +Do not use this function in helm code, use `helm-append-at-nth' +instead. It is meant to be used in config files only. + +(fn VAR ELM INDEX &optional REPLACE)") +(register-definition-prefixes "helm-lib" '("helm-" "with-helm-")) + + +;;; Generated autoloads from helm-multi-match.el + +(register-definition-prefixes "helm-multi-match" '("helm-m")) + + +;;; Generated autoloads from helm-source.el + +(register-definition-prefixes "helm-source" '("helm-")) + +;;; End of scraped data + +(provide 'helm-core-autoloads) + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; no-native-compile: t +;; coding: utf-8-emacs-unix +;; End: + +;;; helm-core-autoloads.el ends here diff --git a/elpa/helm-core-20260424.1357/helm-core-pkg.el b/elpa/helm-core-20260424.1357/helm-core-pkg.el new file mode 100644 index 00000000..8343da3b --- /dev/null +++ b/elpa/helm-core-20260424.1357/helm-core-pkg.el @@ -0,0 +1,10 @@ +;; -*- no-byte-compile: t; lexical-binding: nil -*- +(define-package "helm-core" "20260424.1357" + "Development files for Helm." + '((emacs "25.1") + (async "1.9.9")) + :url "https://emacs-helm.github.io/helm/" + :commit "3cd5097285dc10ac0898cf6f30c9699c3399e421" + :revdesc "3cd5097285dc" + :authors '(("Thierry Volpiatto" . "thievol@posteo.net")) + :maintainers '(("Thierry Volpiatto" . "thievol@posteo.net"))) diff --git a/elpa/helm-core-20260424.1357/helm-core.el b/elpa/helm-core-20260424.1357/helm-core.el new file mode 100644 index 00000000..0deb4ab9 --- /dev/null +++ b/elpa/helm-core-20260424.1357/helm-core.el @@ -0,0 +1,8397 @@ +;;; helm-core.el --- Development files for Helm -*- lexical-binding: t -*- + +;; Copyright (C) 2022 ~ 2026 Thierry Volpiatto + +;; Author: Thierry Volpiatto +;; URL: https://emacs-helm.github.io/helm/ +;; Package-Version: 20260424.1357 +;; Package-Revision: 3cd5097285dc +;; Package-Requires: ((emacs "25.1") (async "1.9.9")) + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; Contains the main code for Helm. +;; As a package helm-core provides the files helm-core.el, helm-lib.el, +;; helm-source.el and helm-multi-match.el. + +;;; Code: + +(require 'cl-lib) +(require 'async) +(require 'helm-lib) +(require 'helm-multi-match) +(require 'helm-source) + +(defun helm-acase-extra-fontifications () + (font-lock-add-keywords nil '(("\\<\\(guard\\|dst\\)\\>\\*" . font-lock-type-face)))) +(add-hook 'emacs-lisp-mode-hook #'helm-acase-extra-fontifications) + +;; 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") +(declare-function helm-quit-and-find-file-1 "helm-utils.el") +(declare-function linum-mode "linum.el") +(declare-function minibuffer-depth-setup "mb-depth.el") +(declare-function transient--delete-window "ext:transient" ()) +(declare-function transient--preserve-window-p "ext:transient" + (&optional nohide)) +(declare-function helm-maybe-show-popup-tip-info "helm-utils") + +(defvar helm-marked-buffer-name) +(defvar display-buffer-function) +(defvar minibuffer-follows-selected-frame) +(defvar minibuffer-depth-indicate-mode) + + +;;; Internal Variables +;; +;; +(defvar helm-source-filter nil + "A list of source names to be displayed. +Other sources won't appear in the search results. +If nil, no filtering is done. +Don't set this directly, use `helm-set-source-filter' during a +Helm session to modify it.") +(defvar helm-saved-action nil + "Saved value of the currently selected action by key.") +(defvar helm-saved-current-source nil + "Value of the current source when the action list is shown.") +(defvar helm-in-persistent-action nil + "Flag whether in persistent-action or not.") +(defvar helm-last-buffer nil + "`helm-buffer' of a previous Helm session.") +(defvar helm-saved-selection nil + "Value of the currently selected object when the action list is shown.") +(defvar helm-sources nil + "[INTERNAL] Value of current sources in use, a list of alists. +The list of sources (symbols or alists) is normalized to alists +in `helm-initialize'.") +(defvar helm-buffer-file-name nil + "Variable `buffer-file-name' when Helm is invoked.") +(defvar helm-candidate-cache (make-hash-table :test 'equal) + "Holds the available candidate within a single Helm invocation.") +(defvar helm--candidate-buffer-alist nil) +(defvar helm-input "" + "The input typed in the candidates panel.") +(defvar helm-input-local nil + "Internal, store locally `helm-pattern' value for later use in `helm-resume'.") +(defvar helm--source-name nil) +(defvar helm-current-source nil) +(defvar helm-issued-errors nil) +(defvar helm--last-log-file nil + "The name of the log file of the last Helm session.") +(defvar helm--local-variables nil) +(defvar helm-split-window-state nil) +(defvar helm--window-side-state nil) +(defvar helm-selection-point nil + "The value of point at selection.") +(defvar helm-alive-p nil) +(defvar helm-visible-mark-overlays nil) +(defvar helm--force-updating-p nil + "[INTERNAL] Don't use this in your programs.") +(defvar helm-exit-status 0 + "Flag to inform if Helm did exit or quit. +0 means Helm did exit when executing an action. +1 means Helm did quit with \\[keyboard-quit] +Knowing this exit-status could help restore a window config when +Helm aborts in some special circumstances. See +`helm-exit-minibuffer' and `helm-keyboard-quit'.") +(defvar helm-minibuffer-confirm-state nil) +(defvar helm--quit nil) +(defvar helm-buffers nil + "Helm buffers listed in order of most recently used.") +(defvar helm-current-position nil + "Cons of (point . window-start) when Helm is invoked. +`helm-current-buffer' uses this to restore position after +`helm-keyboard-quit'") +(defvar helm-last-frame-or-window-configuration nil + "Used to store window or frame configuration at Helm start.") +(defvar helm-onewindow-p nil) +(defvar helm-types nil) +(defvar helm--mode-line-string-real nil) ; The string to display in mode-line. +(defvar helm-persistent-action-display-window nil) +(defvar helm-marked-candidates nil + "Marked candidates. List of (source . real) pair.") +(defvar helm--mode-line-display-prefarg nil) +(defvar helm--temp-follow-flag nil + "[INTERNAL] A simple flag to notify persistent action we are following.") +(defvar helm--reading-passwd-or-string nil) +(defvar helm--in-update nil) +(defvar helm--in-fuzzy nil) +(defvar helm-maybe-use-default-as-input nil + "Flag to notify the use of use-default-as-input. +Use only in let-bindings. +Use :default arg of `helm' as input to update display. +Note that if also :input is specified as `helm' arg, it will take +precedence on :default.") +(defvar helm--temp-hooks nil + "Store temporary hooks added by `with-helm-temp-hook'.") +(defvar helm--prompt nil) +(defvar helm--file-completion-sources + '("Find Files" "Read File Name" "New file or directory") + "Sources that use the *find-files mechanism can be added here. +Sources generated by `helm-mode' don't need to be added here +because they are automatically added. + +You should not modify this yourself unless you know what you are +doing.") +(defvar helm--completing-file-name nil + "Non nil when `helm-read-file-name' is running. +Used for `helm-file-completion-source-p'.") +;; Same as `ffap-url-regexp' but keep it here to ensure `ffap-url-regexp' is not nil. +(defvar helm--url-regexp "\\`\\(news\\(post\\)?:\\|mailto:\\|file:\\|\\(ftp\\|https?\\|telnet\\|gopher\\|www\\|wais\\)://\\)") +(defvar helm--ignore-errors nil + "Flag to prevent Helm popping up errors in candidates functions. +Should be set in candidates functions if needed, and will be +restored at end of session.") +(defvar helm--action-prompt "Select action: ") +(defvar helm--cycle-resume-iterator nil) +(defvar helm--buffer-in-new-frame-p nil) +(defvar helm-initial-frame nil + "[INTERNAL] The selected frame before starting Helm. +Helm use this internally to know in which frame it started, don't +modify this yourself.") +(defvar helm-popup-frame nil + "The frame where Helm is displayed. + +This is only used when Helm is using +`helm-display-buffer-in-own-frame' as `helm-display-function' and +`helm-display-buffer-reuse-frame' is non nil.") +(defvar helm--nested nil) +(defconst helm--frame-default-attributes + '(width height tool-bar-lines left top + title undecorated vertical-scroll-bars + visibility fullscreen menu-bar-lines undecorated + alpha foreground-color background-color) + "Frame parameters to save in `helm--last-frame-parameters'.") +(defvar helm--last-frame-parameters nil + "Frame parameters to save for later resuming. +Local to `helm-buffer'.") +(defvar helm--executing-helm-action nil + "Non nil when action is triggering a new helm-session. +This may be let bounded in other places to notify the display +function to reuse the same frame parameters as the previous Helm +session just like resume would do.") +(defvar helm--current-buffer-narrowed nil) +(defvar helm--suspend-update-interactive-flag nil) +(defvar helm-persistent-action-window-buffer nil + "[INTERNAL] Store the buffer where helm is started. +It is generally `helm-current-buffer', but when this one is displayed +in a dedicated buffer, helm can't start in this window and use another +window handling a buffer, it is this one we store.") +(defvar helm--tramp-archive-maybe-loaded nil) +(defvar helm--original-dedicated-windows-alist nil + "[INTERNAL] Store all dedicated windows with their dedicated state on startup") +(defvar helm--deleting-minibuffer-contents-from nil + "[INTERNAL] Recenter when deleting minibuffer-contents and preselecting. +This is a flag used internally.") +(defvar helm--minibuffer-completing-file-name nil + "[INTERNAL] A flag notifying Helm is in file completion. +It is let-bounded in `helm-read-file-name'. Same as +`minibuffer-completing-file-name' but doesn't affect `file-directory-p' when +called on remote files. +WARN: Use this only in `helm-read-file-name'.") +(defvar helm-initial-windows nil + "Store the `window-list' before starting helm.") + +;;; Multi keys +;; +;; +;;;###autoload +(defun helm-define-multi-key (keymap key functions &optional delay) + "In KEYMAP, define key sequence KEY for function list FUNCTIONS. +Each function runs sequentially for each KEY press. +If DELAY is specified, switch back to initial function of FUNCTIONS list +after DELAY seconds. +The functions in FUNCTIONS list take no args. +E.g. + (defun foo () + (interactive) + (message \"Run foo\")) + (defun bar () + (interactive) + (message \"Run bar\")) + (defun baz () + (interactive) + (message \"Run baz\")) + +\(helm-define-multi-key global-map (kbd \" q\") \\='(foo bar baz) 2) + +Each time \" q\" is pressed, the next function is executed. +Waiting more than 2 seconds between key presses switches back to +executing the first function on the next hit." + (define-key keymap key (helm-make-multi-command functions delay))) + +;;;###autoload +(defmacro helm-multi-key-defun (name docstring funs &optional delay) + "Define NAME as a multi-key command running FUNS. +After DELAY seconds, the FUNS list is reinitialized. +See `helm-define-multi-key'." + (declare (indent 2) (doc-string 2)) + (setq docstring (if docstring (concat docstring "\n\n") + "This is a helm-ish multi-key command.")) + `(defalias (quote ,name) (helm-make-multi-command ,funs ,delay) ,docstring)) + +(defun helm-make-multi-command (functions &optional delay) + "Return an anonymous multi-key command running FUNCTIONS. +Run each function in the FUNCTIONS list in turn when called within +DELAY seconds." + (declare (indent 1)) + (let ((funs functions) + (iter (list nil)) ; ref-cell[1]. + (timeout delay)) + (lambda () + (interactive) + (helm-run-multi-key-command funs iter timeout)))) + +(defun helm-run-multi-key-command (functions iterator delay) + (let ((fn (lambda () + (cl-loop for count from 1 to (length functions) + collect count))) + next) + ;; By passing a list containing a single 'nil' element [1] as ITERATOR we + ;; avoid using a global var. + (unless (and (car iterator) + ;; Reset iterator when another key is pressed. + (eq this-command real-last-command)) + (setcar iterator (helm-iter-circular (funcall fn)))) + (setq next (helm-iter-next (car iterator))) + (and next (car iterator) + (call-interactively (nth (1- next) functions))) + (when delay (run-with-idle-timer + delay nil (lambda () + (setcar iterator nil)))))) + +(defun helm-command-with-subkeys (map subkey command + &optional other-subkeys prompt exit-fn delay) + "Build a command that run COMMAND when SUBKEY is read. + +The command runs a loop reading keys and exit when user stops typing after DELAY +seconds. After this DELAY EXIT-FN run if specified. + +Arg OTHER-SUBKEYS should be an alist composed of (command . short-key) where +command is another command than COMMAND bound to short-key. + +A PROMPT can be used to describe bindings of COMMAND and OTHER-SUBKEYS. + +Return an anonymous interactive command to use with +`helm-define-key-with-subkeys'." + (lambda () + (interactive) + (let (timer) + (call-interactively command) + (unless (or defining-kbd-macro executing-kbd-macro) + (unwind-protect + (progn + (when delay + (setq timer (run-with-idle-timer + delay nil (lambda () (keyboard-quit))))) + (while (let ((input (read-key prompt)) other kb com) + (setq last-command-event input) + (cond + ((eq input subkey) + (call-interactively command) + (setq last-command command) + t) + ((setq other (assoc input other-subkeys)) + (call-interactively (cdr other)) + (setq last-command (cdr other)) + t) + (t + (setq kb (vector last-command-event)) + (setq com (lookup-key map kb)) + (if (commandp com) + (call-interactively com) + (setq unread-command-events + (nconc (mapcar #'identity kb) + unread-command-events))) + nil))))) + (when timer (cancel-timer timer)) + (and exit-fn (funcall exit-fn))))))) + +;;;###autoload +(defun helm-define-key-with-subkeys (map key subkey command + &optional other-subkeys + prompt exit-fn delay + docstring) + "Define in MAP a KEY and SUBKEY to COMMAND. + +This allows typing KEY to call COMMAND the first time and +type only SUBKEY on subsequent calls. + +Arg MAP is the keymap to use, SUBKEY is the initial short +key binding to call COMMAND. + +Arg OTHER-SUBKEYS is an alist specifying other short key bindings +to use once started, e.g.: + + (helm-define-key-with-subkeys global-map + (kbd \"C-x v n\") ?n \\='git-gutter:next-hunk + \\='((?p . git-gutter:previous-hunk))) + +In this example, `C-x v n' will run `git-gutter:next-hunk' +subsequent \"n\" will run this command again and subsequent \"p\" +will run `git-gutter:previous-hunk'. + +If specified PROMPT can be displayed in minibuffer to describe +SUBKEY and OTHER-SUBKEYS. Arg EXIT-FN specifies a function to run +on exit. + +For any other key pressed, run their assigned command as defined +in MAP and then exit the loop running EXIT-FN, if specified. + +If DELAY is specified the command expires after DELAY seconds. + +NOTE: SUBKEY and OTHER-SUBKEYS bindings support only char syntax +and vectors, so don't use strings to define them. While defining +or executing a kbd macro no SUBKEY or OTHER-SUBKEYS are provided, +i.e. the loop is not entered after running COMMAND." + (declare (indent 1)) + (let ((fn (helm-command-with-subkeys + map subkey command other-subkeys prompt exit-fn delay)) + (com (intern (format "helm-%s-with-subkeys" + (symbol-name command))))) + (defalias com fn + (or docstring + ;; When no DOCSTRING, generate a basic one specifying + ;; COMMAND, SUBKEY and OTHER-SUBKEYS. + (concat + (format "Run `%s' and bound it to `%s' for subsequent calls." + command (if (numberp subkey) (single-key-description subkey) subkey)) + (if other-subkeys + (helm-basic-docstring-from-alist other-subkeys) + "")))) + (define-key map key com))) + +(defun helm-basic-docstring-from-alist (alist) + (let* ((len (length alist)) + (osk (cl-loop for (k . v) in alist + for count from 1 + for sep = (cond ((and (= count len) (> len 1)) + " and ") + ((> count 1) ",") + (t "")) + for key = (if (numberp k) (single-key-description k) k) + concat (format "%s`%s'" sep key) into ks + concat (format "%s`%s'" sep v) into kv + finally return (list ks kv)))) + (format "\nBound as well %s to %s%s." + (car osk) (if (> len 1) "respectively " "") (cadr osk)))) + +;;; Keymap +;; +;; +(defvar helm-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map minibuffer-local-map) + (define-key map (kbd "") #'helm-next-line) + (define-key map (kbd "") #'helm-previous-line) + (define-key map (kbd "C-n") #'helm-next-line) + (define-key map (kbd "C-p") #'helm-previous-line) + (define-key map (kbd "") #'helm-follow-action-forward) + (define-key map (kbd "") #'helm-follow-action-backward) + (define-key map (kbd "") #'helm-previous-page) + (define-key map (kbd "") #'helm-next-page) + (define-key map (kbd "M-v") #'helm-scroll-up) + (define-key map (kbd "C-v") #'helm-scroll-down) + (define-key map (kbd "M-<") #'helm-beginning-of-buffer) + (define-key map (kbd "M->") #'helm-end-of-buffer) + (define-key map (kbd "C-g") #'helm-keyboard-quit) + (define-key map (kbd "") #'helm-maybe-exit-minibuffer) + (define-key map (kbd "C-i") #'helm-select-action) + (define-key map (kbd "C-j") #'helm-execute-persistent-action) + (define-key map (kbd "C-o") #'helm-next-source) + (define-key map (kbd "M-o") #'helm-previous-source) + (define-key map (kbd "") #'helm-next-source) + (define-key map (kbd "") #'helm-previous-source) + (define-key map (kbd "C-l") #'helm-recenter-top-bottom-other-window) + (define-key map (kbd "M-C-l") #'helm-reposition-window-other-window) + (define-key map (kbd "C-M-v") #'helm-scroll-other-window) + (define-key map (kbd "M-") #'helm-scroll-other-window) + (define-key map (kbd "C-M-y") #'helm-scroll-other-window-down) + (define-key map (kbd "C-M-S-v") #'helm-scroll-other-window-down) + (define-key map (kbd "M-") #'helm-scroll-other-window-down) + (define-key map (kbd "") #'helm-scroll-other-window) + (define-key map (kbd "") #'helm-scroll-other-window-down) + (define-key map (kbd "C-@") #'helm-toggle-visible-mark) + (define-key map (kbd "C-SPC") #'helm-toggle-visible-mark-forward) + (define-key map (kbd "M-SPC") #'helm-toggle-visible-mark-backward) + (define-key map (kbd "M-[") nil) + (define-key map (kbd "M-(") #'helm-prev-visible-mark) + (define-key map (kbd "M-)") #'helm-next-visible-mark) + (define-key map (kbd "C-k") #'helm-delete-minibuffer-contents) + (define-key map (kbd "DEL") #'helm-delete-char-backward) + (define-key map (kbd "C-x C-f") #'helm-quit-and-find-file) + (define-key map (kbd "M-m") #'helm-toggle-all-marks) + (define-key map (kbd "M-a") #'helm-mark-all) + (define-key map (kbd "M-U") #'helm-unmark-all) + (define-key map (kbd "C-M-a") #'helm-show-all-candidates-in-source) + (define-key map (kbd "C-M-f") #'helm-limit-to-sources) + (define-key map (kbd "C-M-e") #'helm-display-all-sources) + (define-key map (kbd "C-s") #'undefined) + (define-key map (kbd "M-s") #'undefined) + (define-key map (kbd "C-r") #'undefined) + (define-key map (kbd "C-M-r") #'undefined) + (define-key map (kbd "C-M-s") #'undefined) + (define-key map (kbd "C-M-i") #'undefined) + (define-key map (kbd "C-;") #'undefined) + (define-key map (kbd "C-}") #'helm-narrow-window) + (define-key map (kbd "C-{") #'helm-enlarge-window) + (define-key map (kbd "C-c -") #'helm-swap-windows) + (define-key map (kbd "C-c _") #'helm-toggle-full-frame) + (define-key map (kbd "C-z") #'helm-toggle-full-frame) + (define-key map (kbd "C-c %") #'helm-exchange-minibuffer-and-header-line) + (define-key map (kbd "C-c C-y") #'helm-yank-selection) + (define-key map (kbd "C-c C-k") #'helm-kill-selection-and-quit) + (define-key map (kbd "C-c C-i") #'helm-insert-or-copy) + (define-key map (kbd "C-c C-f") #'helm-follow-mode) + (define-key map (kbd "C-c C-u") #'helm-refresh) + (define-key map (kbd "C-c >") #'helm-toggle-truncate-line) + (define-key map (kbd "C-c l") #'helm-display-line-numbers-mode) + (define-key map (kbd "M-p") #'previous-history-element) + (define-key map (kbd "M-n") #'next-history-element) + ;; Unbind `previous-matching-history-element' which is non sense for helm. + (define-key map (kbd "M-r") #'undefined) + (define-key map (kbd "C-!") #'helm-toggle-suspend-update) + (define-key map (kbd "C-x b") #'helm-resume-previous-session-after-quit) + (define-key map (kbd "C-x C-b") #'helm-resume-list-buffers-after-quit) + (helm-define-key-with-subkeys map (kbd "C-c n") ?n #'helm-run-cycle-resume) + ;; Disable `file-cache-minibuffer-complete'. + (define-key map (kbd "") #'undefined) + (define-key map (kbd "C-t") #'helm-resplit-window-clockwise) + (define-key map (kbd "C-r") #'helm-resplit-window-counterclockwise) + ;; Debugging command + (define-key map (kbd "C-h C-d") #'helm-enable-or-switch-to-debug) + (define-key map (kbd "C-h c") #'helm-customize-group) + (define-key map (kbd "C-h d") #'helm-debug-output) + ;; Allow to eval keymap without errors. + (define-key map [f1] nil) + (define-key map (kbd "C-h C-h") #'undefined) + (define-key map (kbd "C-h h") #'undefined) + (helm-define-key-with-subkeys map + (kbd "C-w") ?\C-w #'helm-yank-text-at-point + '((?\C-_ . helm-undo-yank-text-at-point))) + ;; Use `describe-mode' key in `global-map'. + (dolist (k (where-is-internal #'describe-mode global-map)) + (define-key map k #'helm-help)) + ;; Bind all actions from f1 to f12, `helm-select-nth-action' + ;; counts from 0, i.e. (helm-select-nth-action 0) = action 1. + (dotimes (n 12) + (define-key map (kbd (format "" (1+ n))) + (lambda () + (interactive) + (helm-select-nth-action n)))) + map) + "Keymap for helm.") + +(defun helm-customize-group-1 (group) + (require 'cus-edit) + (let ((name (format "*Customize Group: %s*" + (custom-unlispify-tag-name group)))) + (if (buffer-live-p (get-buffer name)) + (switch-to-buffer name) + (custom-buffer-create + (list (list group 'custom-group)) + name + (concat " for group " + (custom-unlispify-tag-name group)))))) + +(defun helm-customize-group () + "Jump to customization group of current source. + +Default to Helm group when group is not defined in source." + (interactive) + (let ((source (or (helm-get-current-source) + (and (fboundp 'helm-comp-read) + (helm-comp-read + "Customize variables for: " + (cl-loop for src in (with-helm-buffer helm-sources) + collect `(,(assoc-default 'name src) . + ,src)) + :allow-nest t + :exec-when-only-one t)) + ;; No completion on sources when only helm-core package is + ;; used. + (car helm-sources)))) + (helm-run-after-exit 'helm-customize-group-1 (helm-get-attr 'group source)))) +(put 'helm-customize-group 'helm-only t) + +(defun helm--action-at-nth-set-fn-1 (value &optional negative unset) + "Bind VALUE to (+-)nth candidate depending of NEGATIVE arg value. +If UNSET is specified unbind VALUE instead." + (dotimes (n 9) + (let ((key (format value (1+ n))) + (fn (lambda () + (interactive) + (helm-execute-selection-action-at-nth + (if negative (- (1+ n)) (1+ n)))))) + (define-key helm-map (kbd key) nil) + (unless unset + (define-key helm-map (kbd key) fn))))) + +(defun helm--action-at-nth-set-fn- (val &optional unset) + ;; Bind `helm-action-at-nth-negative-prefix-key' to `helm-map'. + (helm--action-at-nth-set-fn-1 val 'negative unset)) + +(defun helm--action-at-nth-set-fn+ (val &optional unset) + ;; Bind `helm-action-at-nth-positive-prefix-key' to `helm-map'. + (helm--action-at-nth-set-fn-1 val nil unset)) + +(defcustom helm-action-at-nth-negative-prefix-key "M-%d" + "The prefix key to execute default action on nth <-n> candidate. + +This is a format spec where %d will be replaced by the candidate +number. + +This is activated only when `helm-display-line-numbers-mode' is turned on. +Note that default value `M-' defeat the usage of `M-' as prefix argument +in `helm-M-x'." + :group 'helm + :type 'string) + +(defcustom helm-action-at-nth-positive-prefix-key "C-%d" + "The prefix key to execute default action on nth <+n> candidate. + +This is a format spec where %d will be replaced by the candidate +number. + +This is activated only when `helm-display-line-numbers-mode' is turned on. +Note that default value `C-' defeat the usage of `C-' as prefix argument +in `helm-M-x'." + :group 'helm + :type 'string) + + +;;; User variables +(defgroup helm nil + "Open Helm." + :prefix "helm-" :group 'convenience) + +;; Easy access to customize +;;;###autoload +(defun helm-configuration () + "Customize Helm." + (interactive) + (customize-group "helm")) + +(defcustom helm-completion-window-scroll-margin 5 + "`scroll-margin' to use for Helm completion window. +Set to 0 to disable. +NOTE: This has no effect when `helm-display-source-at-screen-top' +id is non-nil." + :group 'helm + :type 'integer) + +(defcustom helm-left-margin-width 0 + "`left-margin-width' value for the `helm-buffer'." + :group 'helm + :type 'integer) + +(defcustom helm-display-source-at-screen-top t + "Display candidates at the top of screen. +This happens with `helm-next-source' and `helm-previous-source'. +NOTE: When non-nil (default), disable +`helm-completion-window-scroll-margin'." + :group 'helm + :type 'boolean) + +(defcustom helm-candidate-number-limit 500 + "Global limit for number of candidates displayed. +When the pattern is empty, the number of candidates shown will be +as set here instead of the entire list, which may be hundreds or +thousands. Since narrowing and filtering rapidly reduces +available candidates, having a small list will keep the interface +responsive. + +Set this value to nil for no limit." + :group 'helm + :type '(choice (const :tag "Disabled" nil) integer)) + +(defcustom helm-input-idle-delay (if (display-graphic-p) 0.01 0.05) ; Issue #2730. + "Idle time before updating, specified in seconds." + :group 'helm + :type 'float) + +(defcustom helm-exit-idle-delay 0 + "Idle time before exiting minibuffer while Helm is updating. +Has no affect when helm-buffer is up to date (i.e. exit without +delay in this condition)." + :group 'helm + :type 'float) + +(defvaralias 'helm-samewindow 'helm-full-frame) +(make-obsolete-variable 'helm-samewindow 'helm-full-frame "1.4.8.1") +(defcustom helm-full-frame nil + "Use current window for showing candidates. +If t, then Helm does not pop-up a new window." + :group 'helm + :type 'boolean) + +(defcustom helm-candidate-separator + (if (fontp (char-displayable-p (read "#x2015"))) + "――――――――――――――――――――――――――――――――――――――" + "--------------------------------------") + "Candidates separator of `multiline' source." + :group 'helm + :type 'string) + +(defcustom helm-save-configuration-functions + '(set-window-configuration . helm-current-window-configuration) + "Functions used to restore or save configurations for frames and windows. +Specified as a pair of functions, where car is the restore +function and cdr is the save function. + +To save and restore frame configuration, set this variable to +\\='(set-frame-configuration . helm-current-frame-configuration) + +NOTE: This may not work properly with own-frame minibuffer +settings. Older versions saves/restores frame configuration, but +the default has changed now to avoid flickering." + :group 'helm + :type 'sexp) + +(defcustom helm-display-function 'helm-default-display-buffer + "Function used to display `helm-buffer'. + +Local value in `helm-buffer' will take precedence on this default +value. Commands that are in `helm-commands-using-frame' will have +`helm-buffer' displayed in frame, `helm-display-function' being +ignored. +If no local value is found and current command is not one of +`helm-commands-using-frame' use this default value. +The function in charge of deciding which value use is +`helm-resolve-display-function'. + +To set it locally to `helm-buffer' in Helm sources use +`helm-set-local-variable' in init function or use +:display-function slot in `helm' call." + :group 'helm + :type 'symbol) + +(defcustom helm-case-fold-search 'smart + "Adds \\='smart' option to `case-fold-search'. +Smart option ignores case for searches as long as there are no +upper case characters in the pattern. + +Use nil or t to turn off smart behavior and use +`case-fold-search' behavior. + +Default is smart. + +NOTE: Case fold search has no effect when searching asynchronous +sources, which relies on customized features implemented directly +into their execution process. See helm-grep.el for an example." + :group 'helm + :type '(choice (const :tag "Ignore case" t) + (const :tag "Respect case" nil) + (other :tag "Smart" smart))) + +(defcustom helm-file-name-case-fold-search + (if (memq system-type + '(cygwin windows-nt ms-dos darwin)) + t + helm-case-fold-search) + "Local setting of `helm-case-fold-search' for reading filenames. + +See `helm-case-fold-search' for more info." + :group 'helm + :type 'symbol) + +(defcustom helm-reuse-last-window-split-state nil + "Use the same state of window split, vertical or horizontal. +For the next helm session `helm-resplit-window-clockwise' will use +the same window scheme as the previous session unless +`helm-split-window-default-side' is \\='same or \\='other." + :group 'helm + :type 'boolean) + +(defcustom helm-split-width-threshold nil + "The value of `split-width-threshold' for helm windows. +This affect the behavior of `helm-split-window-default-fn'. +When the value is an integer, `split-window-sensibly' is used inconditionally +and all the helm variables that affect window splitting are ignored." + :group 'helm + :type '(choice + (const :tag "Maybe use `split-window-sensibly'" nil) + (integer :tag "Inconditionally use `split-window-sensibly'"))) + +(defcustom helm-split-window-preferred-function 'helm-split-window-default-fn + "Default function used for splitting window." + :group 'helm + :type 'function) + +(defcustom helm-split-window-default-side 'below + "The default side to display `helm-buffer'. +Must be one acceptable arg for `split-window' SIDE, +that is `below', `above', `left' or `right'. + +Other acceptable values are `same' which always displays +`helm-buffer' in current window and `other' that displays +`helm-buffer' below if only one window or in +`other-window-for-scrolling' when available. + +A nil value has same effect as `below'. If `helm-full-frame' is +non-nil, it take precedence over this setting. + +See also `helm-split-window-inside-p' and +`helm-always-two-windows' that take precedence over this. + +NOTE: this has no effect if +`helm-split-window-preferred-function' is not +`helm-split-window-default-fn' unless this new function can +handle this." + :group 'helm + :type 'symbol) + +(defcustom helm-split-window-other-side-when-one-window 'below + "Place for `helm-window' when `helm-split-window-default-side' is \\='other. + +The default side to display `helm-buffer' when (1) +`helm-split-window-default-side' is \\='other and (2) +the current frame only has one window. Possible values +are acceptable args for `split-window' SIDE, that is `below', +`above', `left' or `right'. + +If `helm-full-frame' is non-nil, it takes precedence over this +setting. + +See also `helm-split-window-inside-p' and `helm-always-two-windows' that +takes precedence over this. + +NOTE: this has no effect if +`helm-split-window-preferred-function' is not +`helm-split-window-default-fn' unless this new function can +handle this." + :group 'helm + :type 'symbol) + +(defcustom helm-display-buffer-default-height nil + "Initial height of `helm-buffer', specified as an integer or a function. + +The function should take one arg and be responsible for re-sizing +the window; function's return value is ignored. Note that this +has no effect when the split is vertical. See `display-buffer' +for more info." + :group 'helm + :type '(choice integer function)) + +(defcustom helm-display-buffer-default-width nil + "Initial width of `helm-buffer', specified as an integer or a function. + +The function should take one arg and be responsible for re-sizing +the window; function's return value is ignored. Note that this +have no effect when the split is horizontal. See `display-buffer' +for more info." + :group 'helm + :type '(choice integer function)) + +(defvaralias 'helm-split-window-in-side-p 'helm-split-window-inside-p) +(make-obsolete-variable 'helm-split-window-in-side-p 'helm-split-window-inside-p "2.8.6") +(defcustom helm-split-window-inside-p nil + "Force split inside selected window when non-nil. +See also `helm-split-window-default-side'. + +NOTE: this has no effect if +`helm-split-window-preferred-function' is not +`helm-split-window-default-fn' unless this new function can +handle this." + :group 'helm + :type 'boolean) + +(defcustom helm-always-two-windows t + "When non-nil Helm uses two windows in this frame. + +I.e. `helm-buffer' in one window and `helm-current-buffer' +in the other. + +Note: this has no effect when `helm-split-window-inside-p' is +non-nil, or when `helm-split-window-default-side' is set to +\\='same. + +When `helm-autoresize-mode' is enabled, setting this to nil +will have no effect. + +Also when non-nil it overrides the effect of +`helm-split-window-default-side' set to `other'." + :group 'helm + :type 'boolean) + +(defcustom helm-display-buffer-width 72 + "Frame width when displaying helm-buffer in own frame." + :group 'helm + :type 'integer) + +(defcustom helm-display-buffer-height 20 + "Frame height when displaying helm-buffer in own frame." + :group 'helm + :type 'integer) + +(defcustom helm-default-display-buffer-functions nil + "Action functions to pass to `display-buffer'. +See (info \"(elisp) Buffer Display Action Functions\"). + +It may override others helm window related variables settings like +`helm-always-two-windows', `helm-split-window-inside-p' etc..." + :group 'helm + :type '(repeat symbol)) + +(defcustom helm-default-display-buffer-alist nil + "Additional alist to pass to `display-buffer' action. +See (info \"(elisp) Action Alists for Buffer Display\"). + +It may override others helm window related variables settings like +`helm-always-two-windows', `helm-split-window-inside-p' etc... + +Note that window-height and window-width have to be configured in +`helm-display-buffer-height' and `helm-display-buffer-width'." + :group 'helm + :type '(alist :key-type symbol :value-type sexp)) + +(defcustom helm-sources-using-default-as-input '(helm-source-imenu + helm-source-imenu-all + helm-source-info-elisp + helm-source-etags-select + helm-source-man-pages + helm-source-occur + helm-source-moccur + helm-source-grep-ag + helm-source-grep-git + helm-source-grep) + "List of Helm sources that need to use `helm-maybe-use-default-as-input'. +When a source is a member of this list, default `thing-at-point' +will be used as input." + :group 'helm + :type '(repeat (choice symbol))) + +(defcustom helm-delete-minibuffer-contents-from-point t + "When non-nil, `helm-delete-minibuffer-contents' deletes region from `point'. +Otherwise it deletes `minibuffer-contents'. +See documentation for `helm-delete-minibuffer-contents'." + :group 'helm + :type 'boolean) + +(defcustom helm-follow-mode-persistent nil + "When non-nil, save last state of `helm-follow-mode' for the next Emacs sessions. + +Each time you turn on or off `helm-follow-mode', the current +source name will be stored or removed from +`helm-source-names-using-follow'. + +Note that this may be disabled in some places where it is unsafe +to use because persistent action is changing according to +context." + :group 'helm + :type 'boolean) + +(defcustom helm-source-names-using-follow nil + "A list of source names to have follow enabled. +This list of source names will be used only +when `helm-follow-mode-persistent' is non-nil. + +You don't have to customize this yourself unless you really want +and know what you are doing, instead just set +`helm-follow-mode-persistent' to non-nil and as soon as you turn +on or off `helm-follow-mode' (C-c C-f) in a source, Helm will +save or remove source name in this variable." + :group 'helm + :type '(repeat (choice string))) + +(defcustom helm-prevent-escaping-from-minibuffer t + "Prevent escaping from minibuffer with `other-window' during the Helm session." + :group 'helm + :type 'boolean) + +(defcustom helm-allow-mouse t + "Allow mouse usage during the Helm session when non-nil. + +Note that this also allows moving out of minibuffer when clicking +outside of `helm-buffer', so it is up to you to get back to Helm +by clicking back in `helm-buffer' or minibuffer." + :group 'helm + :type 'boolean) + +(defcustom helm-move-to-line-cycle-in-source t + "Cycle to the beginning or end of the list after reaching the bottom or top. +This applies when using `helm-next/previous-line'." + :group 'helm + :type 'boolean) + +(defcustom helm-fuzzy-match-fn 'helm-fuzzy-match + "The function for fuzzy matching in `helm-source-sync' based sources." + :group 'helm + :type 'function) + +(defcustom helm-fuzzy-search-fn 'helm-fuzzy-search + "The function for fuzzy matching in `helm-source-in-buffer' based sources." + :group 'helm + :type 'function) + +(defcustom helm-fuzzy-sort-fn 'helm-fuzzy-matching-default-sort-fn + "The sort transformer function used in fuzzy matching." + :group 'helm + :type 'function) + +(defcustom helm-fuzzy-matching-highlight-fn #'helm-fuzzy-default-highlight-match + "The function to highlight fuzzy matches. +The function must have the same signature as +`helm-fuzzy-default-highlight-match' which is the default." + :group 'helm + :type 'function) + +(defcustom helm-autoresize-max-height 40 + "Specify maximum height and defaults to percent of Helm window's frame height. + +See `fit-window-to-buffer' for more infos." + :group 'helm + :type 'integer) + +(defcustom helm-autoresize-min-height 10 + "Specify minimum height and defaults to percent of Helm window's frame height. + +If nil, `window-min-height' is used. +See `fit-window-to-buffer' for details." + :group 'helm + :type 'integer) + +(defcustom helm-input-method-verbose-flag nil + "The default value for `input-method-verbose-flag' used in Helm minibuffer. +It is nil by default, which does not turn off input method. Helm +updates and exits without interruption -- necessary for complex +methods. + +If set to any other value as per `input-method-verbose-flag', +then use `C-\\' to disable the `current-input-method' to exit or +update Helm." + :group 'helm + :type '(radio :tag "A flag to control extra guidance for input methods in helm." + (const :tag "Never provide guidance" nil) + (const :tag "Always provide guidance" t) + (const :tag "Provide guidance only for complex methods" complex-only))) + +(defcustom helm-display-header-line t + "Display header-line when non nil. +It has to be non nil when you want to display minibuffer contents in there with +`helm-echo-input-in-header-line'." + :group 'helm + :type 'boolean) + +(defcustom helm-inherit-input-method t + "Inherit `current-input-method' from `current-buffer' when non-nil. +The default is to enable this by default and then toggle +`toggle-input-method'." + :group 'helm + :type 'boolean) + +(defcustom helm-echo-input-in-header-line nil + "Send current input to header-line when non-nil. +Note that `helm-display-header-line' has to be non nil as well for this to take +effect." + :group 'helm + :type 'boolean) + +(defcustom helm-header-line-space-before-prompt 'left-fringe + "Specify the space before prompt in header-line. + +This will be used when `helm-echo-input-in-header-line' is +non-nil. + +Value can be one of the symbols \\='left-fringe or \\='left-margin or +an integer specifying the number of spaces before prompt. Note +that on input longer that `window-width' the continuation string +will be shown on left side of window without taking care of +this." + :group 'helm + :type '(choice + (symbol + (const :tag "Fringe" left-fringe) + (const :tag "Margin" left-margin)) + integer)) + +(defcustom helm-tramp-connection-min-time-diff 5 + "Value of `tramp-connection-min-time-diff' for Helm remote processes. +If set to zero Helm remote processes are not delayed. + +Setting this to a value less than 5 or disabling it with a zero +value is risky, however on Emacs versions starting at 24.5 it +seems it is now possible to disable it. + +Anyway at any time in Helm you can suspend your processes while +typing by hitting \\ `\\[helm-toggle-suspend-update]'. + +Only async sources than use a sentinel calling +`helm-process-deferred-sentinel-hook' are affected by this." + :type 'integer + :group 'helm) + +(defcustom helm-show-action-window-other-window 'left + "Show action buffer beside `helm-buffer' when non-nil. + +If nil don't split and replace helm-buffer by the action buffer +in same window. +Possible value are left, right, below and above." + :group 'helm + :type '(choice + (const :tag "Split at left" left) + (const :tag "Split at right" right) + (const :tag "Split below" below) + (const :tag "Split above" above) + (const :tag "Don't split" nil))) + +(defcustom helm-cycle-resume-delay 1.0 + "Delay used before resuming in `helm-run-cycle-resume'." + :type 'float + :group 'helm) + +(defcustom helm-display-buffer-reuse-frame nil + "When non nil Helm frame is not deleted and reused in next sessions. + +This was used to workaround a bug in Emacs where frames where +popping up slowly, now that the bug have been fixed upstream +\(emacs-27) probably you don't want to use this any more. On +emacs-26 set `x-wait-for-event-timeout' to nil to have your +frames popping up fast." + :group 'helm + :type 'boolean) + +(defcustom helm-commands-using-frame nil + "A list of commands where `helm-buffer' is displayed in a frame." + :group 'helm + :type '(repeat symbol)) + +(defcustom helm-actions-inherit-frame-settings t + "Actions inherit Helm frame settings of initial command when non nil." + :group 'helm + :type 'boolean) + +(defcustom helm-use-undecorated-frame-option t + "Display Helm frame undecorated when non nil. + +This option has no effect with Emacs versions lower than 26." + :group 'helm + :type 'boolean) + +(defcustom helm-frame-background-color nil + "Background color for Helm frames, a string. +Fallback to default face background when nil." + :group 'helm + :type 'string) + +(defcustom helm-frame-foreground-color nil + "Foreground color for Helm frames, a string. +Fallback to default face foreground when nil" + :group 'helm + :type 'string) + +(defcustom helm-frame-alpha 100 + "Alpha parameter for Helm frames, an integer. +Fallback to 100 when nil." + :group 'helm + :type 'integer) + +(defcustom helm-use-frame-when-more-than-two-windows nil + "Display Helm buffer in frame when more than two windows." + :group 'helm + :type 'boolean) + +(defvaralias 'helm-use-frame-when-dedicated-window + 'helm-use-frame-when-no-suitable-window) + +(defcustom helm-use-frame-when-no-suitable-window nil + "Display Helm buffer in frame when Helm is started from a dedicated window." + :group 'helm + :type 'boolean) +(make-obsolete-variable 'helm-use-frame-when-dedicated-window + 'helm-use-frame-when-no-suitable-window + "3.8.1") + +(defcustom helm-default-prompt-display-function + #'helm-set-default-prompt-display + "The function to use to set face of fake cursor in header-line." + :group 'helm + :type 'function) + +(defcustom helm-truncate-lines nil + "The value of `truncate-lines' when Helm starts. +You can toggle later `truncate-lines' with +\\\\[helm-toggle-truncate-line]." + :group 'helm + :type 'boolean) + +(defcustom helm-visible-mark-prefix "*" + "Prefix used in margin for marked candidates. +Set this to an empty string if you don't want prefix in margin when marking." + :group 'helm + :type 'string) + +(defcustom helm-kill-real-or-display-selection 'display + "What to kill with `\\\\[helm-kill-selection-and-quit]'. +A prefix arg reverse the behavior of this variable." + :group 'helm + :type '(choice + (const :tag "Kill display" display) + (const :tag "Kill real" real))) + +(defcustom helm-follow-input-idle-delay 0.5 + "`helm-follow-mode' will execute action after this delay once idle. +Note that if the `follow-delay' attr is present in source, it +will take precedence over this." + :group 'helm + :type 'float) + +(defvar helm-update-edebug nil + "Development feature, make easier Edebug usage while in Helm. +If set to true then all functions invoked after `helm-update' can be +instrumented by `edebug' for stepping. `helm--maybe-use-while-no-input' +then doesn't use `while-no-input', because `while-no-input' throws on +`edebug' command key input. NOTE: This may hang helm a few seconds +while you are typing so use it only for debugging purpose, not +permanently.") + +(defvar helm-default-output-filter #'helm-output-filter + "The `process-filter' function for Helm async sources.") + +;;; Faces +;; +;; +(defgroup helm-faces nil + "Customize the appearance of Helm." + :prefix "helm-" + :group 'faces + :group 'helm) + +(defface helm-source-header + `((((type tty pc)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :background "blue" + :foreground "white") + (((background dark)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :background "#22083397778B" + :foreground "white" + :weight bold :height 1.3 :family "Sans Serif") + (((background light)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :background "#abd7f0" + :foreground "black" + :weight bold :height 1.3 :family "Sans Serif")) + "Face for source header in the Helm buffer." + :group 'helm-faces) + +(defface helm-visible-mark + `((((min-colors 88) (background dark)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :background "green1" + :foreground "black") + (((background dark)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :background "green" + :foreground "black") + (((background light)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :background "#d1f5ea") + (((min-colors 88)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :background "green1") + (t ,@(and (>= emacs-major-version 27) '(:extend t)) + :background "green")) + "Face for visible mark." + :group 'helm-faces) + +(defface helm-header + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :inherit header-line)) + "Face for header lines in the Helm buffer." + :group 'helm-faces) + +(defface helm-candidate-number + `((((background dark)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :background "yellow" :foreground "black") + (((background light)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :background "#faffb5" :foreground "black")) + "Face for candidate number in mode-line." + :group 'helm-faces) + +(defface helm-candidate-number-suspended + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :inherit helm-candidate-number :inverse-video t)) + "Face for candidate number in mode-line when Helm is suspended." + :group 'helm-faces) + +(defface helm-selection + `((((type tty pc)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :inherit isearch) + (((background dark)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :background "ForestGreen" + :distant-foreground "black") + (((background light)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :background "#b5ffd1" + :distant-foreground "black")) + "Face for currently selected item in the Helm buffer." + :group 'helm-faces) + +(defface helm-separator + `((((background dark)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :foreground "red") + (((background light)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :foreground "#ffbfb5")) + "Face for multiline source separator." + :group 'helm-faces) + +(defface helm-action + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :underline t)) + "Face for action lines in the Helm action buffer." + :group 'helm-faces) + +(defface helm-prefarg + `((((background dark)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :foreground "green") + (((background light)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :foreground "red")) + "Face for showing prefix arg in mode-line." + :group 'helm-faces) + +(defface helm-match + `((((background light)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :foreground "#b00000") + (((background dark)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :foreground "gold1")) + "Face used to highlight matches." + :group 'helm-faces) + +(defface helm-header-line-left-margin + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :foreground "black" :background "yellow")) + "Face used to highlight helm-header sign in left-margin. +This face is used only when using `helm-echo-input-in-header-line' and pattern +is wider then screen." + :group 'helm-faces) + +(defface helm-minibuffer-prompt + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :inherit minibuffer-prompt)) + "Face used for the minibuffer/headline prompt (such as Pattern:) in Helm." + :group 'helm-faces) + +(defface helm-eob-line + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :inherit default)) + "Face for empty line at end of sources in the Helm buffer. +Allow specifying the height of this line." + :group 'helm-faces) + +(defface helm-mark-prefix + `((t :inherit default)) + "Face for string `helm-visible-mark-prefix'." + :group 'helm-faces) + +(defface helm-dim-prompt + `((((class color) (min-colors 88) (background dark)) + :foreground "DimGray") + (t :inherit shadow)) + "Face used for shadowing prompt while updating." + :group 'helm-faces) + +;;; Variables. +;; +;; +(defvar helm-selection-overlay nil + "Overlay used to highlight the currently selected item.") + +(defvar helm-async-processes nil + "List of information about asynchronous processes managed by Helm.") + +(defvar helm-before-initialize-hook nil + "Runs before Helm initialization. +This hook runs before init functions in `helm-sources', which is +before creation of `helm-buffer'. Set local variables for +`helm-buffer' that need a value from `current-buffer' with +`helm-set-local-variable'.") + +(defvar helm-after-initialize-hook nil + "Runs after Helm initialization. +This hook runs after `helm-buffer' is created but not from +`helm-buffer'. The hook needs to specify in which buffer to +run.") + +(defvaralias 'helm-update-hook 'helm-after-update-hook) +(make-obsolete-variable 'helm-update-hook 'helm-after-update-hook "1.9.9") + +(defvar helm-after-update-hook nil + "Runs after updating the Helm buffer with the new input pattern.") + +(defvar helm-before-update-hook nil + "Runs before updating the Helm buffer with the new input pattern.") + +(defvar helm-cleanup-hook nil + "Runs after exiting the minibuffer and before performing an +action. + +This hook runs even if Helm exits the minibuffer abnormally (e.g. +via `helm-keyboard-quit').") + +(defvar helm-select-action-hook nil + "Runs when opening the action buffer.") + +(defvar helm-before-action-hook nil + "Runs before executing action. +Unlike `helm-cleanup-hook', this hook runs before Helm closes the +minibuffer and also before performing an action.") + +(defvar helm-after-action-hook nil + "Runs after executing action.") + +(defvar helm-exit-minibuffer-hook nil + "Runs just before exiting the minibuffer. + +This hook runs when Helm exits the minibuffer normally (e.g., via +candidate selection), but does NOT run if Helm exits the +minibuffer abnormally (e.g. via `helm-keyboard-quit').") + +(defvar helm-after-persistent-action-hook nil + "Runs after executing persistent action.") + +(defvar helm-move-selection-before-hook nil + "Runs before moving selection in `helm-buffer'.") + +(defvar helm-move-selection-after-hook nil + "Runs after moving selection in `helm-buffer'.") + +(defvar helm-after-preselection-hook nil + "Runs after pre-selection in `helm-buffer'.") + +(defvar helm-window-configuration-hook nil + "Runs when switching to and from the action buffer. +Should run also at end of `helm-display-function'.") + +(defvar helm-execute-action-at-once-if-one nil + "When non-nil execute the default action and then exit if only one candidate. +If symbol \\='current-source is given as value exit if only one +candidate in current source. This variable accepts a function +with no args that should returns a boolean value or \\='current-source.") + +(defvar helm-quit-if-no-candidate nil + "When non-nil, quit if there are no candidates. +This variable accepts a function.") + +(defvar helm-debug-function #'helm-default-debug-function + "A Function that returns a list of values to print in `helm-debug-output' buffer.") + +(defvar helm-debug-output-buffer "*Helm Debug*") + +(defvar helm-debug-buffer "*Debug Helm Log*") + +(defvar helm-debug nil + "If non-nil, write log message to `helm-debug-buffer'. +Default is nil, which disables writing log messages because the +size of `helm-debug-buffer' grows quickly.") + +(defvar helm-mode-line-string "\ +\\\ +\\[helm-help]:Help \ +\\[helm-select-action]:Act \ +\\[helm-maybe-exit-minibuffer]/\ +f1..f12:NthAct \ +\\[helm-toggle-suspend-update]:Tog.suspend \ +\\[helm-customize-group]:Conf" + "Help string displayed by Helm in the mode-line. +It is either a string or a list of two string arguments where the +first string is the name and the second string is displayed in +the mode-line. When nil, it defaults to `mode-line-format'.") + +(defvar helm-minibuffer-set-up-hook '(helm-hide-minibuffer-maybe) + "Hook that runs at minibuffer initialization. +A hook useful for modifying minibuffer settings in Helm. + +Uses `helm-hide-minibuffer-maybe' by default which hide minibuffer contents with +header-line contents when `helm-echo-input-in-header-line' is non nil.") + +(defvar helm-help-message + "* Helm Generic Help +** Basics + +To navigate in this Help buffer see [[Helm help][here]]. + +Helm narrows down the list of candidates as you type a filter +pattern. See [[Matching in Helm][Matching in Helm]]. + +Helm accepts multiple space-separated patterns, each pattern can +be negated with \"!\". + +Helm also supports fuzzy matching in some places when specified, +you will find several variables to enable fuzzy matching in +diverse [[Helm sources][sources]], see [[https://github.com/emacs-helm/helm/wiki/Fuzzy-matching][fuzzy-matching]] in helm-wiki for more infos. + +Helm generally uses familiar Emacs keys to navigate the list. +Here follow some of the less obvious bindings: + +- `\\\\[helm-maybe-exit-minibuffer]' selects the +candidate from the list, executes the default action upon exiting +the Helm session. + +- `\\\\[helm-execute-persistent-action]' executes the +default action but without exiting the Helm session. Not all +sources support this. + +- `\\\\[helm-select-action]' displays a list of actions +available on current candidate or all marked candidates. The +default binding is ordinarily used for completion, but that +would be redundant since Helm completes upon every character +entered in the prompt. See [[https://github.com/emacs-helm/helm/wiki#helm-completion-vs-emacs-completion][Helm wiki]]. + +Note: In addition to the default actions list, additional actions +appear depending on the type of the selected candidate(s). They +are called filtered actions. + +** Helm sources + +Helm uses what's called sources to provide different kinds of +completions. Each Helm session can handle one or more source. A +source is an alist object which is build from various classes, +see [[Writing your own Helm sources][here]] and [[https://github.com/emacs-helm/helm/wiki/Developing#creating-a-source][Helm wiki]] for more infos. + +*** Configure sources + +You will find in Helm sources already built and bound to a +variable called generally `helm-source-'. In this case +it is an alist and you can change the attributes (keys) values +using `helm-set-attr' function in your configuration. Of course +you have to ensure before calling `helm-set-attr' that the file +containing source is loaded, e.g. with `with-eval-after-load'. Of +course you can also completely redefine the source but this is +generally not elegant as it duplicate for its most part code +already defined in Helm. + +You will find also sources that are not built and even not bound +to any variables because they are rebuilded at each start of a +Helm session. In this case you can add a defmethod called +`helm-setup-user-source' to your config: + +#+begin_src elisp + + (cl-defmethod helm-setup-user-source ((source helm-moccur-class)) + (setf (slot-value source 'follow) -1)) + +#+end_src + +See +[[https://github.com/emacs-helm/helm/wiki/FAQ#why-is-a-customizable-helm-source-nil][here]] +for more infos, and for more complex examples of configuration +[[https://github.com/thierryvolpiatto/emacs-tv-config/blob/master/init-helm.el#L340][here]]. + +** Modify keybindings in Helm + +Helm main keymap is `helm-map', all keys bound in this map apply +to all Helm sources. However, most sources have their own keymap, +with each binding overriding its counterpart in `helm-map', you +can see all bindings in effect in the [[Commands][Commands]] +section (available only if the source has its own keymap and +documentation of course). + +** Matching in Helm + +All that you write in minibuffer is interpreted as a regexp or +multiple regexps if separated by a space. This is true for most +sources unless the developer of the source has disabled it or +have choosen to use fuzzy matching. Even if a source has fuzzy +matching enabled, Helm will switch to multi match as soon as it +detects a space in the pattern. It may also switch to multi match +as well if pattern starts with a \"^\" beginning of line sign. In +those cases each pattern separated with space should be a regexp +and not a fuzzy pattern. When using multi match patterns, each +pattern starting with \"!\" is interpreted as a negation i.e. +match everything but this. + +** Moving selection to a specific candidate + +Once you found the candidate you were searching by narrowing candidates, +you may want to keep the selection on this candidate after deleting +minibuffer contents and showing the whole list of candidates, this is +useful for example when examining and searching git log or similar. To +achieve this, ensure all candidates are shown at startup or at least +enough candidates to be sure your candidate is not beyond candidate-number-limit, +you can use \\\\[helm-show-all-candidates-in-source] for this with a prefix arg or a numeric prefix arg. +Once this is done narrow down your list by typing in minibuffer, once the +selection is on the candidate you want to keep, hit C-u \\\\[helm-delete-minibuffer-contents]. +Another way to achieve this is to mark the candidate, then delete minibuffer +contents with \\\\[helm-delete-minibuffer-contents] and reach back the mark with \\\\[helm-next-visible-mark]. + +*** Completion-styles + +UPDATE: At version 3.8.0 Helm default is now to NOT use +`completion-styles' i.e. now `helm-completion-style' default to +'helm and no more to 'emacs. + +If you want to use `completion-styles' in Helm customize +`helm-completion-style' to 'emacs. + +Helm generally fetches its candidates with the :candidates +function up to `helm-candidate-number-limit' and then applies +match functions to these candidates according to `helm-pattern'. +But Helm allows matching candidates directly from the :candidates +function using its own `completion-styles'. +Helm provides 'helm completion style but also 'helm-flex +completion style for Emacs<27 that don't have 'flex completion +style, otherwise (emacs-27) 'flex completion style is used to +provide fuzzy aka flex completion. + +When using helm-fuzzy as `helm-completion-style' helm use its own +fuzzy implementation which have nothing to do with emacs `flex' +style. + +Any Helm sources can use `completion-styles' +by using :match-dynamic slot and building their :candidates +function with `helm-dynamic-completion'. + +Example: + +#+begin_src elisp + + (helm :sources (helm-build-sync-source \"test\" + :candidates (helm-dynamic-completion + '(foo bar baz foab) + 'symbolp) + :match-dynamic t) + :buffer \"*helm test*\") + +#+end_src + +By default Helm sets up `completion-styles' and always adds 'helm +to it. However the flex completion styles are not added. This is +up to the user if she wants to have such completion to enable +this. +As specified above use 'flex for emacs-27 and 'helm-flex for +emacs-26. Anyway, 'helm-flex is not provided in +`completion-styles-alist' if 'flex is present. + +Finally Helm provides two user variables to control +`completion-styles' usage: `helm-completion-style' and +`helm-completion-styles-alist'. Both variables are customizable. +The former allows retrieving previous Helm behavior if needed, by +setting it to `helm' or `helm-fuzzy', default being `emacs' which +allows dynamic completion and usage of `completion-styles'. The +second allows setting `helm-completion-style' per mode and also +specifying `completion-styles' per mode (see its docstring). Note +that these two variables take effect only in helm-mode i.e. in +all that uses `completion-read' or `completion-in-region', IOW all +helmized commands. File completion in `read-file-name' family +doesn't obey completion-styles and has its own file completion +implementation. Native Helm commands using `completion-styles' +doesn't obey `helm-completion-style' and +`helm-completion-styles-alist' (e.g., helm-M-x). + +Also for a better control of styles in native Helm sources (not +helmized by helm-mode) using :match-dynamic, +`helm-dynamic-completion' provides a STYLES argument that allows +specifying explicitely styles for this source. + +NOTE: Some old completion styles are not working fine with Helm +and are disabled by default in +`helm-blacklist-completion-styles'. They are anyway not useful in +Helm because 'helm style supersedes these styles. + +** Helm mode + +`helm-mode' toggles Helm completion in native Emacs functions, so +when you turn `helm-mode' on, commands like `switch-to-buffer' +will use Helm completion instead of the usual Emacs completion +buffer. + +*** What gets or does not get \"helmized\" when `helm-mode' is enabled? + +Helm provides generic completion on all Emacs functions using +`completing-read', `completion-in-region' and their derivatives, +e.g. `read-file-name'. Helm exposes a user variable to control +which function to use for a specific Emacs command: +`helm-completing-read-handlers-alist'. If the function for a +specific command is nil, it turns off Helm completion. See the +variable documentation for more infos. + +*** Helm functions vs helmized Emacs functions + +While there are Helm functions that perform the same completion +as other helmized Emacs functions, e.g. `switch-to-buffer' and +`helm-buffers-list', the native Helm functions like +`helm-buffers-list' can receive new features that allow marking +candidates, have several actions, etc. Whereas the helmized Emacs +functions only have Helm completion, Emacs can provide no more +than one action for this function. This is the intended behavior. + +Generally you are better off using the native Helm command than +the helmized Emacs equivalent. + +*** Completion behavior with Helm and completion-at-point + +Helm is NOT completing dynamically. That means that when you are +completing some text at point, completion is done against this +text and subsequent characters you add AFTER this text. This +allows you to use matching methods provided by Helm, that is multi +matching or fuzzy matching (see [[Matching in Helm][Matching in +Helm]]). + +Completion is not done dynamically (against `helm-pattern') +because backend functions (i.e. `completion-at-point-functions') +are not aware of Helm matching methods. + +By behaving like this, the benefit is that you can fully use Helm +matching methods but you can't start a full completion against a +prefix different than the initial text you have at point. Helm +warns you against this by colorizing the initial input and sends +a user-error message when trying to delete backward text beyond +this limit at first hit on DEL. A second hit on DEL within a +short delay (1s) quits Helm and delete-backward char in +current-buffer. + +** Helm help + +\\[helm-documentation]: Show all Helm documentations concatenated +in one org file. + +From a Helm session, just hit \\\\[helm-help] to have +the documentation for the current source followed by the global +Helm documentation. + +While in the help buffer, most of the Emacs regular key bindings +are available; the most important ones are shown in minibuffer. +However, due to implementation restrictions, no regular Emacs +keymap is used (it runs in a loop when reading the help buffer). +Only simple bindings are available and they are defined in +`helm-help-hkmap', which is a simple alist of (key . function). +You can define or redefine bindings in help with +`helm-help-define-key' or by adding/removing entries directly in +`helm-help-hkmap'. For example if you want to replace isearch by [[https://github.com/thierryvolpiatto/isearch-light][isl-search]] +to have multi match like helm use: + + (helm-help-define-key \"C-s\" nil) + (helm-help-define-key \"C-r\" nil) + (helm-help-define-key \"C-s\" 'isl-search)) + +See `helm-help-hkmap' for restrictions on bindings and functions. + +The documentation of default bindings are: + +| Key | Alternative keys | Command | +|-----------+------------------+---------------------| +| C-v | Space next | Scroll up | +| M-v | b prior | Scroll down | +| C-s | | Isearch forward | +| C-r | | Isearch backward | +| C-a | | Beginning of line | +| C-e | | End of line | +| C-f | right | Forward char | +| C-b | left | Backward char | +| C-n | down | Next line | +| C-p | up | Previous line | +| M-a | | Backward sentence | +| M-e | | Forward sentence | +| M-f | | Forward word | +| M-b | | Backward word | +| M-> | | End of buffer | +| M-< | | Beginning of buffer | +| C- | | Toggle mark | +| C-M-SPACE | | Mark sexp | +| RET | | Follow org link | +| C-% | | Push org mark | +| C-& | | Goto org mark-ring | +| TAB | | Org cycle | +| M- | | Toggle visibility | +| M-w | | Copy region | +| q | | Quit | + +** Customize Helm + +Helm provides a lot of user variables for extensive customization. +From any Helm session, type \\\\[helm-customize-group] +to jump to the current source `custom' group. Helm also has a +special group for faces you can access via `M-x customize-group +RET helm-faces'. + +Note: Some sources may not have their group set and default to +the `helm' group. + +** Display Helm in windows and frames + +You can display the Helm completion buffer in many different +window configurations, see the custom interface to discover the +different windows configurations available (See [[Customize Helm][Customize Helm]] to jump to custom interface). +When using Emacs in a graphic display (i.e. not in a terminal) you can as +well display your Helm buffers in separated frames globally for +all Helm commands or separately for specific Helm commands. +See `helm-display-function' and `helm-commands-using-frame'. +See also [[https://github.com/emacs-helm/helm/wiki/frame][helm wiki]] for more infos. + +There is a variable to allow reusing frame instead of deleting +and creating a new one at each session, see `helm-display-buffer-reuse-frame'. +Normally you don't have to use this, it have been made to workaround +slow frame popup in Emacs-26, to workaround this slowness in Emacs-26 use instead + +#+begin_src elisp + (when (= emacs-major-version 26) + (setq x-wait-for-event-timeout nil)) +#+end_src + +WARNING: +There is a package called Posframe and also one called Helm-posframe, +you DO NOT need these packages to display helm buffers in frames. +Thus Posframe package use child frames which have no minibuffers +and are by the way not compatible with Helm. + +** Helm's basic operations and default key bindings + +| Key| Command| +|----+--------| +| | +| \\[helm-previous-line]| Previous line | +| \\[helm-next-line]| Next line | +| \\[helm-scroll-up]| Scroll up | +| \\[helm-scroll-down]| Scroll down | +| \\[helm-scroll-other-window]| Scroll up other-window | +| \\[helm-scroll-other-window-down]| Scroll down other-window | +| \\[helm-maybe-exit-minibuffer]| Execute first (default) action / Select [1] | +| \\[helm-beginning-of-buffer]| Goto beginning of buffer | +| \\[helm-end-of-buffer]| Goto end of buffer | +| \\[helm-select-action]| Show actions menu | +| \\[helm-previous-source]| Previous source | +| \\[helm-next-source]| Next source | +| \\[helm-delete-minibuffer-contents]| Delete pattern (with prefix arg delete from point to end or all [2]) | +| \\[helm-execute-persistent-action]| Persistent action (Execute and keep Helm session) | +|\\[helm-resplit-window-clockwise]|Resplit helm window clockwise. | +|\\[helm-resplit-window-counterclockwise]||Resplit helm window counterclockwise. | +|\\[helm-exchange-minibuffer-and-header-line]|Exchange minibuffer and header-line. | +|\\[helm-quit-and-find-file]|Drop into `helm-find-files'. | +|\\[helm-kill-selection-and-quit]|Kill display value of candidate and quit (with prefix arg, kill the real value). | +|\\[helm-yank-selection]|Yank current selection into pattern. | +|\\[helm-insert-or-copy]|Insert or copy marked candidates (C-u) . | +|\\[helm-follow-mode]|Toggle automatic execution of persistent action. | +|\\[helm-follow-action-forward]|Run persistent action then select next line. | +|\\[helm-follow-action-backward]|Run persistent action then select previous line. | +|\\[helm-refresh]|Recalculate and redisplay candidates. | +|\\[helm-toggle-suspend-update]|Toggle candidate updates. | + +\[1] Behavior may change depending context in some source e.g. `helm-find-files'. + +\[2] Delete from point to end or all depending on the value of +`helm-delete-minibuffer-contents-from-point'. When the cursor is at end +of minibuffer and a prefix arg is given, delete the whole contents of +minibuffer and keep selection as well when possible (depends of +candidate-number-limit) when helm update to the whole list of +candidates. This depends also of requires-pattern i.e. you may have a +source that display nothing when there is an input < to requires-pattern. + +NOTE: Any of these bindings are from `helm-map' and may be +overriten by the map specific to the current source in use (each +source can have its own keymap). + +** The actions menu + +You can display the action menu in the same window +as helm candidates (default) or in a side window according to +`helm-show-action-window-other-window' value. + +When the action menu popup, the helm prompt is used to narrow +down this menu, no more candidates. + +When `helm-allow-mouse' is non nil, you can use as well +mouse-3 (right click) in the candidate zone to select actions +with the mouse once your candidate is selected. + +** Action transformers + +You may be surprized to see your actions list changing depending +on the context. This happen when a source has an action +transformer function which checks the current selected candidate +and adds specific actions for this candidate. + +** Shortcuts for n-th first actions + +f1-f12: Execute n-th action where n is 1 to 12. + +** Shortcuts for executing the default action on the n-th candidate + +Helm does not display line numbers by default, with Emacs-26+ you +can enable it permanently in all helm buffers with: + + (add-hook 'helm-after-initialize-hook 'helm-init-relative-display-line-numbers) + +You can also toggle line numbers with +\\\\[helm-display-line-numbers-mode] in current Helm +buffer. + +Of course when enabling `global-display-line-numbers-mode' Helm +buffers will have line numbers as well. (Don't forget to +customize `display-line-numbers-type' to relative). + +In Emacs versions < to 26 you will have to use +[[https://github.com/coldnew/linum-relative][linum-relative]] +package and `helm-linum-relative-mode'. + +Then when line numbers are enabled with one of the methods above +the following keys are available: + + : Execute default action on the n-th candidate before +currently selected candidate. + + : Execute default action on the n-th candidate after +currently selected candidate. + +Where and are respectively the value of +the customizable variables `helm-action-at-nth-negative-prefix-key' and +`helm-action-at-nth-positive-prefix-key'. + + is limited to 1-9. + +** Mouse control in Helm + +A basic support for the mouse is provided when the user sets +`helm-allow-mouse' to non-nil. + +- mouse-1 selects the candidate. +- mouse-2 executes the default action on selected candidate. +- mouse-3 pops up the action menu. + +Note: When mouse control is enabled in Helm, it also lets you +click around and lose the minibuffer focus: you'll have to click +on the Helm buffer or the minibuffer to retrieve control of your +Helm session. + +** Marked candidates + +You can mark candidates to execute an action on all of them +instead of the current selected candidate only. (See bindings +below.) Most Helm actions operate on marked candidates unless +candidate-marking is explicitely forbidden for a specific source. + +- To mark/unmark a candidate, use +\\[helm-toggle-visible-mark]. (See bindings below.) With a +numeric prefix arg mark ARG candidates forward, if ARG is +negative mark ARG candidates backward. + +- To mark all visible unmarked candidates at once in current +source use \\[helm-mark-all]. With a prefix argument, mark all +candidates in all sources. + +- To unmark all visible marked candidates at once use + \\[helm-unmark-all]. + +- To mark/unmark all candidates at once use +\\[helm-toggle-all-marks]. With a prefix argument, mark/unmark +all candidates in all sources. + +Note: When multiple candidates are selected across different +sources, only the candidates of the current source will be used +when executing most actions (as different sources can have +different actions). Some actions support multi-source marking +however. + +** Follow candidates + +When `helm-follow-mode' is on (\\\\[helm-follow-mode] +to toggle it), moving up and down Helm session or updating the +list of candidates will automatically execute the +persistent-action as specified for the current source. + +If `helm-follow-mode-persistent' is non-nil, the state of the +mode will be restored for the following Helm sessions. + +If you just want to follow candidates occasionally without +enabling `helm-follow-mode', you can use +\\\\[helm-follow-action-forward] or +\\[helm-follow-action-backward] instead. Conversely, when +`helm-follow-mode' is enabled, those commands go to previous/next +line without executing the persistent action. + +** Special yes, no or yes for all answers + +You may be prompted in the minibuffer to answer by [y,n,!,q] in +some places for confirmation. + +- y mean yes +- no mean no +- ! mean yes for all +- q mean quit or abort current operation. + +When using ! you will not be prompted for the same thing in +current operation any more, e.g. file deletion, file copy etc... + +** Moving in `helm-buffer' + +You can move in `helm-buffer' with the usual commands used in +Emacs: \(\\\\[helm-next-line], +\\\\[helm-previous-line], etc. See above basic +commands. When `helm-buffer' contains more than one source, +change source with \\\\[helm-next-source] and +\\[helm-previous-source]. + +Note: When reaching the end of a source, +\\\\[helm-next-line] will *not* go to the next source +when variable `helm-move-to-line-cycle-in-source' is non-nil, so +you will have to use \\\\[helm-next-source] and +\\[helm-previous-source]. + +** Resume previous session from current Helm session + +You can use `C-c n' (`helm-run-cycle-resume') to cycle in +resumables sources. `C-c n' is a special key set with +`helm-define-key-with-subkeys' which, after pressing it, allows +you to keep cycling with further `n'. + +Tip: You can bound the same key in `global-map' to + `helm-cycle-resume' with `helm-define-key-with-subkeys' to + let you transparently cycle sessions, Helm fired up or not. + You can also bind the cycling commands to single key + presses (e.g., `S-') this time with a simple + `define-key'. (Note that `S-' is not available in + terminals.) + +Note: `helm-define-key-with-subkeys' is available only once Helm +is loaded. + +You can also use +\\\\[helm-resume-previous-session-after-quit] to resume +the previous session, or +\\\\[helm-resume-list-buffers-after-quit] to have +completion on all resumable buffers. + +** Global commands + +*** Resume Helm session from outside Helm + +\\\\[helm-resume] revives the last Helm session. +Binding a key to this command will greatly improve Helm +interactivity, e.g. when quitting Helm accidentally. + +You can call \\\\[helm-resume] with a prefix argument +to choose \(with completion!) which session you'd like to resume. +You can also cycle in these sources with `helm-cycle-resume' (see +above). + +** Debugging Helm + +Helm exposes the special variable `helm-debug': setting it to +non-nil will enable Helm logging in a special outline-mode +buffer. Helm resets the variable to nil at the end of each +session. + +For convenience, \\\\[helm-enable-or-switch-to-debug] +allows you to turn on debugging for this session only. To avoid +accumulating log entries while you are typing patterns, you can +use \\\\[helm-toggle-suspend-update] to turn off +updating. When you are ready turn it on again to resume logging. + +Once you exit your Helm session you can access the debug buffer +with `helm-debug-open-last-log'. + +Note: Be aware that Helm log buffers grow really fast, so use +`helm-debug' only when needed. + +** Writing your own Helm sources + +Writing simple sources for your own usage is easy. When calling +the `helm' function, the sources are added the :sources slot +which can be a symbol or a list of sources. Sources can be built +with different EIEIO classes depending on what you want to do. To +simplify this, several `helm-build-*' macros are provided. Below +there are simple examples to start with. + +We will not go further here, see +[[https://github.com/emacs-helm/helm/wiki/Developing][Helm wiki]] +and the source code for more information and more complex +examples. + +#+begin_src elisp + + ;; Candidates are stored in a list. + (helm :sources (helm-build-sync-source \"test\" + ;; A function can be used as well + ;; to provide candidates. + :candidates '(\"foo\" \"bar\" \"baz\")) + :buffer \"*helm test*\") + + ;; Candidates are stored in a buffer. + ;; Generally faster but doesn't allow a dynamic updating + ;; of the candidates list i.e the list is fixed on start. + (helm :sources (helm-build-in-buffer-source \"test\" + :data '(\"foo\" \"bar\" \"baz\")) + :buffer \"*helm test*\") + +#+end_src + +** Helm Map +\\{helm-map}" + "Message string containing detailed help for `helm'. +It also accepts function or variable symbol.") + +(defvar helm-autoresize-mode) ;; Undefined in `helm-default-display-buffer'. + +(defvar helm-async-outer-limit-hook nil + "Run in async sources when process output is out of `candidate-number-limit'. +Should be set locally to `helm-buffer' with `helm-set-local-variable'.") + +(defvar helm-quit-hook nil + "A hook that runs when quitting Helm.") + +(defvar helm-resume-after-hook nil + "A hook that runs after resuming a Helm session. +The hook should takes one arg SOURCES.") + +(defvar helm-help-buffer-name "*Helm Help*" + "The name of helm help buffer.") + +;; See bug#2503. +(defvar helm-process-output-split-string-separator "\n" + "Separator to use when splitting helm async output.") + +(defvar helm-last-query "" + "The value of `helm-pattern' is stored here exit or quit.") + +(defvar helm-dim-prompt-on-update nil + "Dim prompt when updating. +Do not set this globally. Do not use this in async sources or in +commands using an async source in their sources. +Use this either let-bounded or helm buffer local.") + +;; logging +(defun helm-log (from format-string &rest args) + "Log message if `helm-debug' is non-nil. +Messages are written to the `helm-debug-buffer' buffer. + +FROM is the place from where it is called. +Argument FORMAT-STRING is a string to use with `format'. +Use optional arguments ARGS like in `format'." + (when helm-debug + (with-current-buffer (get-buffer-create helm-debug-buffer) + (outline-mode) + (buffer-disable-undo) + (let ((inhibit-read-only t)) + (goto-char (point-max)) + (insert (let ((tm (current-time))) + (format (concat (if (string-match "Start session" format-string) + "* " "** ") + "%s.%06d (%s)\n %s\n") + (format-time-string "%H:%M:%S" tm) + (nth 2 tm) + from + (apply #'format (cons format-string args))))))))) + +(defun helm-log-run-hook (from hook) + "Run HOOK like `run-hooks' and log these actions to Helm log buffer. +FROM is the place from where it is called." + (helm-log from "Executing %s with value = %S" hook (symbol-value hook)) + (helm-log from "Executing %s with global value = %S" hook (default-value hook)) + (run-hooks hook) + (helm-log from "executed %s" hook)) + +(defun helm-log-error (from &rest args) + "Accumulate error messages into `helm-issued-errors'. +FROM is the place from where it is called. +ARGS are args given to `format'. +E.g. (helm-log-error \"Error %s: %s\" (car err) (cdr err))." + (apply 'helm-log from (concat "ERROR: " (car args)) (cdr args)) + (let ((msg (apply 'format args))) + (unless (member msg helm-issued-errors) + (cl-pushnew msg helm-issued-errors :test 'equal)))) + +;;;###autoload +(defun helm-debug-open-last-log () + "Open Helm log file or buffer of last Helm session." + (interactive) + (if helm--last-log-file + (progn + (find-file helm--last-log-file) + (outline-mode) (view-mode 1) (visual-line-mode 1)) + (switch-to-buffer helm-debug-buffer) + (view-mode 1) (visual-line-mode 1))) + +(defun helm-print-error-messages () + "Print error messages in `helm-issued-errors'." + (and helm-issued-errors + (message "Helm issued errors: %s" + (mapconcat 'identity (reverse helm-issued-errors) "\n")))) + + +;; Test tools +(defmacro with-helm-time-after-update (&rest body) + (helm-with-gensyms (start-time time-elapsed) + `(let ((,start-time (float-time)) ,time-elapsed) + (add-hook 'helm-after-update-hook + (lambda () + (setq ,time-elapsed (- (float-time) ,start-time)) + (keyboard-quit))) + (unwind-protect ,@body + (remove-hook 'helm-after-update-hook + (lambda () + (setq ,time-elapsed (- (float-time) ,start-time)) + (keyboard-quit)))) + ,time-elapsed))) + + +;; Helm API +(defmacro with-helm-default-directory (directory &rest body) + (declare (indent 1) (debug t)) + `(let ((default-directory (or (and ,directory + (file-name-as-directory ,directory)) + default-directory))) + ,@body)) + +(defun helm-default-directory () + "Return the local value of `default-directory' in `helm-buffer'." + (buffer-local-value 'default-directory (get-buffer helm-buffer))) + +(defmacro with-helm-temp-hook (hook &rest body) + "Execute temporarily BODY as a function for HOOK." + (declare (indent 1) (debug t)) + `(letrec ((helm--hook (lambda () + (unwind-protect + (progn ,@body) + (remove-hook ,hook helm--hook))))) + (push (cons helm--hook ,hook) helm--temp-hooks) + (add-hook ,hook helm--hook))) + +(defmacro with-helm-after-update-hook (&rest body) + "Execute BODY at end of `helm-update'." + (declare (indent 0) (debug t)) + `(with-helm-temp-hook 'helm-after-update-hook ,@body)) + +(defmacro with-helm-alive-p (&rest body) + "Return error when BODY run outside Helm context." + (declare (indent 0) (debug t)) + `(progn + (if helm-alive-p + (progn ,@body) + (error "Running helm command outside of context")))) + +(defmacro with-helm-in-frame (&rest body) + "Execute Helm function in BODY displaying `helm-buffer' in separate frame." + (declare (debug t) (indent 0)) + `(progn + (helm-set-local-variable + 'helm-display-function 'helm-display-buffer-in-own-frame) + ,@body)) + +(defmacro helm-make-command-from-action (symbol doc action &rest body) + "Make a command SYMBOL from ACTION with docstring DOC. +The command SYMBOL will quit helm before execute. +Argument ACTION should be an existing helm action in the source from where this +command will be called. +BODY form will run before calling action. + +Example: + + (helm-make-command-from-action foo-command + \"Docstring\" + \\='foo-action + (run body)) + +will produce a command like this: + + (defun foo-command () + \"docstring\" + (interactive) + (with-helm-alive-p + (run body) + (helm-exit-and-execute-action \\='foo-action))) + +And automatically put the symbol \\='helm-only on SYMBOL." + (declare (indent defun) (debug t)) + `(progn + (defun ,symbol () + ,doc + (interactive) + (with-helm-alive-p + (progn ,@body) + (helm-exit-and-execute-action ,action))) + (put ',symbol 'helm-only t))) + +(defmacro helm-make-persistent-command-from-action (symbol doc psymbol action) + "Make a persistent command SYMBOL bound to PSYMBOL from ACTION." + (declare (indent defun) (debug t)) + `(progn + (defun ,symbol () + ,doc + (interactive) + (with-helm-alive-p + (helm-set-attr ,psymbol (cons ,action 'never-split)) + (helm-execute-persistent-action ,psymbol))) + (put ',symbol 'helm-only t))) + + +;;; helm-attributes +;; +(defun helm-get-attr (attribute-name &optional source compute) + "Get the value of ATTRIBUTE-NAME of SRC. + +If SRC is omitted, use current source. + +If COMPUTE is non-`nil' compute value of ATTRIBUTE-NAME with +`helm-interpret-value'. COMPUTE can have also \\='ignorefn as value, +in this case `helm-interpret-value' will return a function as +value unchanged, but will eval a symbol which is bound. + +You can use `setf' to modify value of ATTRIBUTE-NAME unless +COMPUTE is specified, if attribute ATTRIBUTE-NAME is not found in +SOURCE `setf' will create new attribute ATTRIBUTE-NAME with +specified value. You can also use `helm-set-attr' to modify +ATTRIBUTE-NAME." + (declare (gv-setter + (lambda (val) + `(let* ((src (or ,source (helm-get-current-source))) + (attr (assq ,attribute-name src))) + (cl-assert (null ,compute) nil + "`setf' can't set the computed value of attribute `%s'" + ,attribute-name) + (if attr + (setcdr attr ,val) + (and (setcdr src (cons (cons ,attribute-name ,val) + (cdr src))) + ,val)))))) + (let ((src (or source (helm-get-current-source)))) + (helm-aif (assq attribute-name src) + (if compute + (helm-interpret-value (cdr it) src compute) + (cdr it))))) + +(defalias 'helm-attr 'helm-get-attr) +(make-obsolete 'helm-attr 'helm-get-attr "3.7.0") + +(defun helm-set-attr (attribute-name value &optional src) + "Set the value of ATTRIBUTE-NAME of source SRC to VALUE. + +If ATTRIBUTE-NAME doesn't exists in source it is created with +value VALUE. If SRC is omitted, use current source. If operation +succeed, return value, otherwise nil. + +Using this function is same as using `setf' on `helm-get-attr'." + (unless src (setq src (helm-get-current-source))) + (setf (helm-get-attr attribute-name src) value)) + +(defalias 'helm-attrset 'helm-set-attr) +(make-obsolete 'helm-attrset 'helm-set-attr "3.7.0") + +(defun helm-add-action-to-source (name fn source &optional index) + "Add new action NAME linked to function FN to SOURCE. +Function FN should be a valid function that takes one arg i.e. +candidate, argument NAME is a string that will appear in action +menu and SOURCE should be an existing helm source already loaded. +If INDEX is specified, action is added to the action list at INDEX, +otherwise added at end. +This allows users to add specific actions to an existing source +without modifying source code." + (let ((actions (helm-get-attr 'action source 'ignorefn)) + (new-action (list (cons name fn)))) + (when (functionp actions) + (setq actions (list (cons "Default action" actions)))) + (helm-set-attr 'action + (if index + (helm-append-at-nth actions new-action index) + (append actions new-action)) + source))) + +(defun helm-delete-action-from-source (action-or-name source) + "Delete ACTION-OR-NAME from SOURCE. +ACTION-OR-NAME can either be the name of action or the symbol +function associated to name." + (let* ((actions (helm-get-attr 'action source 'ignorefn)) + (del-action (if (symbolp action-or-name) + (rassoc action-or-name actions) + (assoc action-or-name actions)))) + (helm-set-attr 'action (delete del-action actions) source))) + +(defun helm-add-action-to-source-if (name fn source predicate &optional index test-only) + "Add new action NAME linked to function FN to SOURCE. +Action NAME will be available when the current candidate matches +PREDICATE. +This function adds an entry in the `action-transformer' attribute +of SOURCE (or creates one if not found). +Function PREDICATE must take one candidate as arg. +Function FN should be a valid function that takes one arg i.e. +candidate, argument NAME is a string that will appear in action +menu and SOURCE should be an existing Helm source already loaded. +If INDEX is specified, action is added in action list at INDEX. +Value of INDEX should be always >=1, default to 4. This allows +user to add a specific `action-transformer' to an existing source +without modifying source code. + +E.g. + +Add the action \"Byte compile file async\" linked to function +`async-byte-compile-file' to source `helm-source-find-files' only +when predicate helm-ff-candidates-lisp-p returns non-nil: + +\(helm-add-action-to-source-if \"Byte compile file async\" + \\='async-byte-compile-file + helm-source-find-files + \\='helm-ff-candidates-lisp-p)." + (unless index (setq index 4)) + (let* ((actions (helm-get-attr 'action source 'ignorefn)) + (action-transformers (helm-get-attr 'action-transformer source)) + (new-action (list (cons name fn))) + (transformer (lambda (actions _candidate) + (let ((candidate (car (helm-marked-candidates)))) + (cond ((funcall predicate candidate) + (helm-append-at-nth + actions new-action index)) + (t actions)))))) + (when (functionp actions) + (helm-set-attr 'action (list (cons "Default action" actions)) source)) + (when (or (symbolp action-transformers) (functionp action-transformers)) + (setq action-transformers (list action-transformers))) + (if test-only ; debug + (delq nil (append (list transformer) action-transformers)) + (helm-set-attr 'action-transformer + (helm-fast-remove-dups + (delq nil (append (list transformer) action-transformers)) + :test 'equal) + source)))) + + +;;; Source filter +;; +(defun helm-set-source-filter (sources) + "Set the value of `helm-source-filter' to SOURCES and update. + +This function sets a filter for Helm sources and it may be called +while Helm is running. It can be used to toggle displaying of +sources dynamically. For example, additional keys can be bound +into `helm-map' to display only the file-related results if there +are too many matches from other sources and you're after files +only: + +Shift+F shows only file results from some sources: + +\(define-key helm-map \"F\" \\='helm-my-show-files-only) + +\(defun helm-my-show-files-only () + (interactive) + (helm-set-source-filter \\='(\"File Name History\" + \"Files from Current Directory\"))) + +Shift+A shows all results: + +\(define-key helm-map \"A\" \\='helm-my-show-all) + +\(defun helm-my-show-all () + (interactive) + (helm-set-source-filter nil)) + +The -my- part is added to avoid collisions with +existing Helm function names." + (with-helm-buffer + (let ((cur-disp-sel (helm-get-selection nil t))) + (set (make-local-variable 'helm-source-filter) + (helm--normalize-filter-sources sources)) + (helm-log "helm-set-source-filter" "helm-source-filter = %S" helm-source-filter) + ;; Use force-update to run init/update functions. + (helm-update (and (stringp cur-disp-sel) + (regexp-quote cur-disp-sel)))))) + +(defun helm--normalize-filter-sources (sources) + (cl-loop for s in sources collect + (cl-typecase s + (symbol (assoc-default 'name (symbol-value s))) + (list (assoc-default 'name s)) + (string s)))) + +(defun helm-set-sources (sources &optional no-init no-update) + "Set SOURCES during `helm' invocation. +If NO-INIT is non-nil, skip executing init functions of SOURCES. +If NO-UPDATE is non-nil, skip executing `helm-update'." + (with-current-buffer helm-buffer + (setq helm-sources (helm-get-sources sources)) + (helm-log "helm-set-sources" "helm-sources = %S" helm-sources)) + (unless no-init (helm-compute-attr-in-sources 'init)) + (unless no-update (helm-update))) + +(defun helm--get-candidate-number-limit-value (arg) + "Return a suitable value for candidate-number-limit according to pref ARG." + (helm-acase arg + ;; Using a large number instead of nil allows always having a value with + ;; helm-get-attr. + ((guard* (consp arg)) 9999999) + ((guard* (numberp arg)) it) + (t (default-value 'helm-candidate-number-limit)))) + +(defun helm-show-all-candidates-in-source (arg) + "Toggle all sources or only current source visibility. +With a prefix arg show all candidates in current source +disregarding candidate-number-limit and with a numeric prefix arg +show ARG number of candidates. With no prefix arg candidate-number-limit is +reset to default value." + (interactive "P") + (with-helm-alive-p + (with-helm-buffer + (if helm-source-filter + (progn + (if (helm-get-attr 'candidate-number-limit) + (helm-set-attr 'candidate-number-limit + (helm--get-candidate-number-limit-value arg)) + (setq-local helm-candidate-number-limit + (default-value 'helm-candidate-number-limit))) + (helm-set-source-filter nil)) + ;; FIXME: What default-directory has to do with this? + (with-helm-default-directory (helm-default-directory) + (if (helm-get-attr 'candidate-number-limit) + (helm-set-attr 'candidate-number-limit + (helm--get-candidate-number-limit-value arg)) + (setq-local helm-candidate-number-limit + (helm--get-candidate-number-limit-value arg))) + (helm-set-source-filter + (list (helm-get-current-source)))))))) +(put 'helm-show-all-candidates-in-source 'helm-only t) + +(defun helm-display-all-sources () + "Display all sources previously hidden by `helm-set-source-filter'." + (interactive) + (with-helm-alive-p + (helm-set-source-filter nil))) +(put 'helm-display-all-sources 'helm-only t) + +(defun helm-limit-to-sources () + "Limit sources to display from current session. +This is a toggle command, when hit a second time reset to all sources." + (interactive) + (with-helm-alive-p + (with-helm-buffer + (if (null helm-source-filter) + (when (cdr helm-sources) + (let ((headers (if (fboundp 'helm-comp-read) + (helm-comp-read + "Limit to source(s): " + (mapcar + (lambda (s) + (let* ((name (assoc-default 'name s)) + (disp (helm-aif (assoc-default 'header-name s) + (funcall it name) name))) + (cons disp name))) + helm-sources) + :marked-candidates t + :allow-nest t + :buffer "*helm sources*") + ;; No completion on sources when only helm-core package is + ;; used. + (list (assoc-default 'name (helm-get-current-source)))))) + (helm-set-source-filter headers))) + (helm-set-source-filter nil))))) +(put 'helm-limit-to-sources 'helm-only t) + +;;; Source infos fns. +;; +(defun helm-get-selection (&optional buffer force-display-part source) + "Return the currently selected candidate from BUFFER. + +If BUFFER is nil or unspecified, use `helm-buffer' as default value. + +If FORCE-DISPLAY-PART is non-nil, return the display part of candidate. + +If FORCE-DISPLAY-PART value is `withprop' the display part of +candidate is returned with its properties. + +If FORCE-DISPLAY-PART value is `noicon' return the display part with its +properties but without its leading icon if some. + +When FORCE-DISPLAY-PART is nil the real part of candidate is returned. + +SOURCE default to current-source when unspecified but it is better to +specify SOURCE when it is already available to avoid to call +`helm-get-current-source' uselessly. + +Note that FORCE-DISPLAY-PART when specified takes precedence over +`display-to-real' attribute, that's mean don't use FORCE-DISPLAY-PART +when you want the `display-to-real' function(s) to be applied." + (with-current-buffer (or buffer helm-buffer) + (unless (or (helm-empty-buffer-p (current-buffer)) + (helm-pos-header-line-p)) + (let* ((beg (overlay-start helm-selection-overlay)) + (end (overlay-end helm-selection-overlay)) + (disp-fn (if (memq force-display-part '(withprop noicon)) + 'buffer-substring + 'buffer-substring-no-properties)) + ;; If there is no selection at point, the + ;; overlay is at its initial pos, (point-min) + ;; (point-min), that's mean the helm-buffer + ;; is not empty but have no selection yet, + ;; this happen with grep sentinel sending an + ;; error message in helm-buffer when no matches. + (disp (unless (= beg end) + (helm-acase (funcall disp-fn beg (1- end)) + ((guard* (and (eq force-display-part 'noicon) + (get-text-property 0 'icon it))) + ;; Remove icon if some from display see issue#2743. + (substring it (1+ guard))) ; icon length + one space. + (t it)))) + (src (or source (helm-get-current-source))) + (selection (helm-acond (force-display-part disp) + ;; helm-realvalue always takes precedence + ;; over display-to-real. + ((get-text-property beg 'helm-realvalue) it) + ((assoc-default 'display-to-real src) + (helm-apply-functions-from-source source it disp)) + (t disp)))) + (unless (equal selection "") + (helm-log "helm-get-selection" "selection = %S" selection) + selection))))) + +(defun helm-get-actions-from-current-source (&optional source) + "Return the associated action for the selected candidate. +It is a function symbol (sole action) or list +of (action-display . function)." + (unless (helm-empty-buffer-p (helm-buffer-get)) + (let* ((src (or source (helm-get-current-source))) + (marked (helm-marked-candidates)) + (action-transformer (helm-get-attr 'action-transformer src)) + (actions (helm-get-attr 'action src 'ignorefn))) + (if action-transformer + (helm-apply-functions-from-source + src action-transformer actions + ;; When there is marked candidates assume the set of + ;; candidates user selected contains candidates of the same + ;; type so that the actions added by transformer fit with + ;; all marked (previously we were looping on each marked + ;; but it is too costly for the benefit it brings). + (car marked)) + actions)))) + +(defun helm-get-current-source () + "Return the source for the current selection. +Return nil when `helm-buffer' is empty." + (or helm-current-source + (with-helm-buffer + (or (get-text-property (point) 'helm-cur-source) + (progn + ;; This is needed to not loose selection. + (goto-char (overlay-start helm-selection-overlay)) + (let ((header-pos (or (helm-get-previous-header-pos) + (helm-get-next-header-pos)))) + ;; Return nil when no--candidates. + (when header-pos + (cl-loop with source-name = (save-excursion + (goto-char header-pos) + (helm-current-line-contents)) + for source in helm-sources thereis + (and (equal (assoc-default 'name source) source-name) + source))))))))) + +(defun helm-run-after-exit (function &rest args) + "Execute FUNCTION with ARGS after exiting Helm. +The action is to call FUNCTION with arguments ARGS. +Unlike `helm-exit-and-execute-action', this can be used +to call non-actions functions with any ARGS or no ARGS at all. + +Use this on commands invoked from key bindings, but not on action +functions invoked as action from the action menu, i.e. functions +called with RET." + (helm-kill-async-processes) + (helm-log "helm-run-after-exit" "function = %S" function) + (helm-log "helm-run-after-exit" "args = %S" args) + (helm-exit-and-execute-action + (lambda (_candidate) + (apply function args)))) + +(defun helm-exit-and-execute-action (action) + "Exit current Helm session and execute ACTION. +Argument ACTION is a function called with one arg (candidate) and +part of the actions of current source. + +Use this on commands invoked from key bindings, but not +on action functions invoked as action from the action menu, +i.e. functions called with RET." + ;; If ACTION is not an action available in source 'action attribute, + ;; return an error. This allow to remove unneeded actions from + ;; source that inherit actions from type, note that ACTION have to + ;; be bound to a symbol and not to be an anonymous action + ;; i.e. lambda or byte-code. + (helm-log "helm-exit-and-execute-action" "Start executing action") + (let ((actions (helm-get-actions-from-current-source))) + (when actions + (cl-assert (or + ;; Single actions defined as symbol. + (eq action actions) + ;; Compiled lambdas + (byte-code-function-p action) + ;; Natively compiled (libgccjit) + (helm-subr-native-elisp-p action) + ;; Lambdas (lambdas are no more represented as list in + ;; Emacs-29+) Bug#2666. + (and (not (symbolp action)) (functionp action)) + ;; One of current actions. + (rassq action actions)) + nil "No such action `%s' for this source" action))) + (setq helm-saved-action action) + (setq helm-saved-selection (or (helm-get-selection) "")) + (setq helm--executing-helm-action t) + (helm-set-local-variable + ;; When toggling minibuffer and header-line, we want next action + ;; inherit this setting. + 'helm-echo-input-in-header-line + (with-helm-buffer helm-echo-input-in-header-line) + ;; Keep the same buffer for subsequent helm sessions started as actions. + 'helm-current-buffer + (with-helm-buffer helm-current-buffer)) + ;; Ensure next action use same display function as initial helm-buffer when + ;; helm-actions-inherit-frame-settings is non nil. + (when (and helm-actions-inherit-frame-settings + helm--buffer-in-new-frame-p) + (helm-set-local-variable 'helm-display-function + (with-helm-buffer helm-display-function) + 'helm--last-frame-parameters + (with-helm-buffer + (helm--get-frame-parameters))) + ;; The helm-buffer keeps `helm-display-function' and + ;; `helm--get-frame-parameters' values during 0.5 seconds, just + ;; the time to execute the possible helm action with those values. + ;; If no helm based action run within 0.5 seconds, the next helm + ;; session will have to resolve again those variable values. + (run-with-idle-timer 0.5 nil + (lambda () + (helm-set-local-variable + 'helm-display-function nil + 'helm--last-frame-parameters nil)))) + (helm-exit-minibuffer)) + +(defun helm-quit-and-find-file () + (interactive) + (if (fboundp 'helm-quit-and-find-file-1) + (helm-quit-and-find-file-1) + (error "No rules to find file, please install helm package for this"))) +(put 'helm-quit-and-find-file 'helm-only t) + +(defun helm--get-frame-parameters (&optional frame) + (cl-loop with params = (frame-parameters frame) + for p in helm--frame-default-attributes + when (assq p params) collect it)) + +(defalias 'helm-run-after-quit 'helm-run-after-exit) +(make-obsolete 'helm-run-after-quit 'helm-run-after-exit "1.7.7") +(defalias 'helm-quit-and-execute-action 'helm-exit-and-execute-action) +(make-obsolete 'helm-quit-and-execute-action 'helm-exit-and-execute-action "1.7.7") + +(defun helm-interpret-value (value &optional source compute) + "Interpret VALUE as variable, function or literal and return it. +If VALUE is a function, call it with no arguments and return the value +unless COMPUTE value is \\='ignorefn. +If SOURCE compute VALUE for this source. +If VALUE is a variable, return the value. +If VALUE is a symbol, but it is not a function or a variable, cause an error. +Otherwise, return VALUE itself." + (cond ((and source (functionp value) (not (eq compute 'ignorefn))) + (helm-apply-functions-from-source source value)) + ((and (functionp value) (not (eq compute 'ignorefn))) + (funcall value)) + ((and (symbolp value) (boundp value)) + (symbol-value value)) + ((and (symbolp value) (not (functionp value))) + (error + "helm-interpret-value: Symbol must be a function or a variable")) + (t + value))) + +(defun helm-set-local-variable (&rest args) + "Bind each pair in ARGS locally to `helm-buffer'. + +Use this to set local vars before calling helm. + +When used from an init or update function +\(i.e. when `helm-force-update' is running) the variables are set +using `make-local-variable' within the `helm-buffer'. + +Usage: helm-set-local-variable ([VAR VALUE]...) +Just like `setq' except that the vars are not set sequentially. +IOW Don't use VALUE of previous VAR to set the VALUE of next VAR. + +\(fn VAR VALUE ...)" + (if helm--force-updating-p + (with-helm-buffer + (cl-loop for i on args by #'cddr + do (set (make-local-variable (car i)) (cadr i)))) + (setq helm--local-variables + (append (cl-loop for i on args by #'cddr + collect (cons (car i) (cadr i))) + helm--local-variables)))) + +(defun helm--set-local-variables-internal () + (cl-loop for (var . val) in helm--local-variables + ;; If `helm-set-local-variable' is called twice or more + ;; on same variable use the last value entered which is + ;; the first on stack e.g. + ;; (helm-set-local-variable 'helm-foo 1) + ;; (helm-set-local-variable 'helm-foo 2) + ;; helm--local-variables => + ;; '((helm-foo . 2) (helm-foo. 1)) + ;; (helm-foo . 2) is retained and (helm-foo . 1) + ;; ignored. + unless (memq var computed) + do (set (make-local-variable var) val) + collect var into computed + finally (setq helm--local-variables nil))) + + +;; API helper +(defun helm-empty-buffer-p (&optional buffer) + "Check if BUFFER have candidates. +Default value for BUFFER is `helm-buffer'." + (unless buffer (setq buffer helm-buffer)) + (zerop (buffer-size (and buffer (get-buffer buffer))))) + +(defun helm-empty-source-p () + "Check if current source contains candidates. +This could happen when for example the last element of a source +was deleted and the candidates list not updated." + (when (helm-window) + (with-helm-window + (or (helm-empty-buffer-p) + (and (helm-end-of-source-p) + (eq (pos-bol) (pos-eol)) + (or + (save-excursion + (forward-line -1) + (helm-pos-header-line-p)) + (bobp))))))) + + +;; Tools +;; +(defun helm-apply-functions-from-source (source functions &rest args) + "From SOURCE apply FUNCTIONS on ARGS. + +This function is used to process filter functions. When filter is +a `filtered-candidate-transformer', we pass to ARGS +candidates+source whereas when the filter is +`candidate-transformer' we pass to ARGS candidates only. +This function is also used to process functions called with no +args, e.g. init functions. In this case it is called without +ARGS. +See `helm-process-filtered-candidate-transformer' + `helm-compute-attr-in-sources' + `helm-process-candidate-transformer'. + +Arg FUNCTIONS is either a symbol or a list of functions, each +function being applied on ARGS and called on the result of the +precedent function. Return the result of last function call." + (let ((helm--source-name (assoc-default 'name source)) + (helm-current-source source) + (funs (if (functionp functions) (list functions) functions))) + (cl-loop with result + for fn in funs + ;; In filter functions, ARGS is a list of one or two elements where + ;; the first element is the list of candidates and the second + ;; a list containing the source. + do (setq result (apply fn args)) + when (and args (cdr funs)) + ;; When more than one fn, set the candidates list to what returns + ;; this fn to compute the modified candidates with the next fn + ;; and so on. + do (setcar args result) + finally return result))) + +(defalias 'helm-funcall-with-source 'helm-apply-functions-from-source) +(make-obsolete 'helm-funcall-with-source 'helm-apply-functions-from-source "2.9.7") + +(defun helm-compute-attr-in-sources (attr &optional sources) + "Call the associated function(s) to ATTR for each source if any." + (let ((sources (or (helm-get-sources sources) + ;; Fix error no buffer named *helm... by checking + ;; if helm-buffer exists. + (and (buffer-live-p (get-buffer (helm-buffer-get))) + ;; `helm-sources' are local to helm-buffer. + (with-helm-buffer helm-sources))))) + (when sources + (dolist (source sources) + (helm-aif (assoc-default attr source) + (helm-apply-functions-from-source source it)))))) + +(defalias 'helm-funcall-foreach 'helm-compute-attr-in-sources) +(make-obsolete 'helm-funcall-foreach 'helm-compute-attr-in-sources "2.9.7") + +(defun helm-normalize-sources (sources) + "If SOURCES is only one source, make a list of one element." + (if (or (and sources (symbolp sources)) + (and (listp sources) (assq 'name sources))) + (list sources) + sources)) + +(defun helm-get-candidate-number (&optional in-current-source) + "Return candidates number in `helm-buffer'. +If IN-CURRENT-SOURCE is provided return the number of candidates +of current source only." + (with-helm-buffer + (if (or (helm-empty-buffer-p) + (helm-empty-source-p)) + 0 + (save-excursion + (helm-aif (and in-current-source (helm-get-previous-header-pos)) + (goto-char it) + (goto-char (point-min))) + (forward-line 1) + (if (helm-pos-multiline-p) + (cl-loop with count-multi = 1 + while (and (not (if in-current-source + (save-excursion + (forward-line 2) + (or (helm-pos-header-line-p) (eobp))) + (eobp))) + (search-forward helm-candidate-separator nil t)) + do (cl-incf count-multi) + finally return count-multi) + (cl-loop with ln = 0 + while (not (if in-current-source + (or (helm-pos-header-line-p) (eobp)) + (eobp))) + ;; Don't count empty lines maybe added by popup (bug#1370). + unless (or (eq (pos-bol) (pos-eol)) + (helm-pos-header-line-p)) + do (cl-incf ln) + do (forward-line 1) finally return ln)))))) + +;;; Main functions +;; +(defconst helm-argument-keys + ;; `:allow-nest' is not in this list because it is treated before. + '(:sources :input :prompt :resume + :preselect :buffer :keymap :default :history)) + +;;;###autoload +(defun helm (&rest plist) + "Main function to execute helm sources. + +PLIST is a list like + +\(:key1 val1 :key2 val2 ...) + + or + +\(&optional sources input prompt resume preselect + buffer keymap default history allow-nest). + +** Keywords + +Keywords supported: + +- :sources +- :input +- :prompt +- :resume +- :preselect +- :buffer +- :keymap +- :default +- :history +- :allow-nest + +Extra LOCAL-VARS keywords are supported, see the \"** Other +keywords\" section below. + +Basic keywords are the following: + +*** :sources + +One of the following: + +- List of sources +- Symbol whose value is a list of sources +- Alist representing a Helm source. + - In this case the source has no name and is referenced in + `helm-sources' as a whole alist. + +*** :input + +Initial input of minibuffer (temporary value of `helm-pattern') + +*** :prompt + +Minibuffer prompt. Default value is `helm--prompt'. + +*** :resume + +If t, allow resumption of the previous session of this Helm +command, skipping initialization. + +If \\='noresume, this instance of `helm' cannot be resumed. + +*** :preselect + +Initially selected candidate (string or regexp). + +*** :buffer + +Buffer name for this Helm session. `helm-buffer' will take this value. + +*** :keymap + +\[Obsolete] + +Keymap used at the start of this Helm session. + +It is overridden by keymaps specified in sources, and is kept +only for backward compatibility. + +Keymaps should be specified in sources using the :keymap slot +instead. See `helm-source'. + +This keymap is not restored by `helm-resume'. + +*** :default + +Default value inserted into the minibuffer \ with +\\\\[next-history-element]. + +It can be a string or a list of strings, in this case +\\\\[next-history-element] cycles through +the list items, starting with the first. + +If nil, `thing-at-point' is used. + +If `helm-maybe-use-default-as-input' is non-nil, display is +updated using this value if this value matches, otherwise it is +ignored. If :input is specified, it takes precedence on :default. + +*** :history + +Minibuffer input, by default, is pushed to `minibuffer-history'. + +When an argument HISTORY is provided, input is pushed to +HISTORY. HISTORY should be a valid symbol. + +*** :allow-nest + +Allow running this Helm command in a running Helm session. + +** Other keywords + +Other keywords are interpreted as local variables of this Helm +session. The `helm-' prefix can be omitted. For example, + +\(helm :sources \\='helm-source-buffers-list + :buffer \"*helm buffers*\" + :candidate-number-limit 10) + +Starts a Helm session with the variable +`helm-candidate-number-limit' set to 10. + +** Backward compatibility + +For backward compatibility, positional parameters are +supported: + +\(helm sources input prompt resume preselect + buffer keymap default history allow-nest) + +However, the use of non-keyword args is deprecated. + +\(fn &key SOURCES INPUT PROMPT RESUME PRESELECT BUFFER KEYMAP DEFAULT HISTORY ALLOW-NEST OTHER-LOCAL-VARS)" + (let ((fn (cond ((or (and helm-alive-p (plist-get plist :allow-nest)) + (and helm-alive-p (memq 'allow-nest plist))) + #'helm--nest) + ((keywordp (car plist)) + #'helm) + (t #'helm-internal)))) + (if (and helm-alive-p (eq fn #'helm)) + (if (helm--alive-p) + ;; A helm session is normally running. + (error "Error: Trying to run helm within a running helm session") + ;; A helm session is already running and user jump somewhere else + ;; without deactivating it. + (with-helm-buffer + (prog1 + (message "Aborting an helm session running in background") + ;; `helm-alive-p' will be reset in unwind-protect forms. + (helm-keyboard-quit)))) + (if (keywordp (car plist)) + ;; Parse `plist' and move not regular `helm-argument-keys' + ;; to `helm--local-variables', then calling helm on itself + ;; with normal arguments (the non--arguments-keys removed) + ;; will end up in [1]. + (progn + (setq helm--local-variables + (append helm--local-variables + ;; Vars passed by keyword on helm call + ;; take precedence on same vars + ;; that may have been passed before helm call. + (helm-parse-keys plist))) + (apply fn (mapcar (lambda (key) (plist-get plist key)) + helm-argument-keys))) + (apply fn plist))))) ; [1] fn == helm-internal. + +(defun helm--alive-p () + "[INTERNAL] Check if `helm' is alive. +An Helm session is considered alive if `helm-alive-p' value is +non-nil, the `helm-buffer' is visible, and cursor is in the +minibuffer." + (and helm-alive-p + (get-buffer-window (helm-buffer-get) 'visible) + (minibuffer-window-active-p (minibuffer-window)) + (minibufferp (current-buffer)))) + +(defun helm-parse-keys (keys) + "Parse the KEYS arguments of `helm'. +Return only those keys not in `helm-argument-keys', prefix them +with \"helm\", and then convert them to an alist. This allows +adding arguments that are not part of `helm-argument-keys', but +are valid helm variables nevertheless. For example, +:candidate-number-limit is bound to `helm-candidate-number-limit' +in the source. + + (helm-parse-keys \\='(:sources ((name . \"test\") + (candidates . (a b c))) + :buffer \"toto\" + :candidate-number-limit 4)) + ==> ((helm-candidate-number-limit . 4))." + + (cl-loop for (key value) on keys by #'cddr + for symname = (substring (symbol-name key) 1) + for sym = (intern (if (string-match "^helm-" symname) + symname + (concat "helm-" symname))) + unless (memq key helm-argument-keys) + collect (cons sym value))) + +(defun helm-internal (&optional + sources input + prompt resume + preselect buffer + keymap default history) + "The internal Helm function called by `helm'. +For SOURCES INPUT PROMPT RESUME PRESELECT BUFFER KEYMAP DEFAULT and +HISTORY args see `helm'." + (cl-assert (or (stringp input) + (null input)) + nil "Error in %S buffer: Initial input should be a string or nil" + buffer) + ;; Set all windows NON dedicated to avoid headaches with PA and + ;; helm-window (bug#2443) + (cl-loop for win in (window-list nil 1) + for state = (window-dedicated-p win) + when state + do (progn (set-window-dedicated-p win nil) + (push `(,win . ,state) helm--original-dedicated-windows-alist))) + (unless helm--nested (setq helm-initial-frame (selected-frame))) + ;; Launch tramp-archive with dbus-event in `while-no-input-ignore-events'. + (helm--maybe-load-tramp-archive) + ;; Activate the advices. + ;; Advices will be available only in >=emacs-24.4, but + ;; allow compiling without errors on lower emacs. + (when (fboundp 'advice-add) + (advice-add 'tramp-read-passwd :around #'helm--suspend-read-passwd) + (advice-add 'ange-ftp-get-passwd :around #'helm--suspend-read-passwd) + (advice-add 'epa-passphrase-callback-function + :around #'helm--suspend-read-passwd) + ;; Ensure linum-mode is disabled in Helm buffers to preserve + ;; performances (Bug#1894). + (advice-add 'linum-on :override #'helm--advice-linum-on '((depth . 100)))) + (helm-log "helm-internal" (concat "[Start session] " (make-string 41 ?+))) + (helm-log "helm-internal" "prompt = %S" prompt) + (helm-log "helm-internal" "preselect = %S" preselect) + (helm-log "helm-internal" "buffer = %S" buffer) + (helm-log "helm-internal" "default = %S" default) + (helm-log "helm-internal" "history = %S" history) + (setq helm--prompt (or prompt "pattern: ")) + (let ((non-essential t) + ;; Prevent mouse jumping to the upper-right + ;; hand corner of the frame (bug#1538). + mouse-autoselect-window + focus-follows-mouse + mode-line-in-non-selected-windows + minibuffer-completion-confirm + (ori--minibuffer-follows-selected-frame + (and (boundp 'minibuffer-follows-selected-frame) + (default-toplevel-value 'minibuffer-follows-selected-frame))) + (input-method-verbose-flag helm-input-method-verbose-flag) + (helm-maybe-use-default-as-input + (and (null input) + (or helm-maybe-use-default-as-input ; it is let-bounded so use it. + (cl-loop for s in (helm-normalize-sources sources) + thereis (memq s helm-sources-using-default-as-input)))))) + (unwind-protect + (condition-case-unless-debug _v + (let ( ;; `helm--source-name' is non-`nil' + ;; when `helm' is invoked by action, reset it. + helm--source-name + helm-current-source + helm-in-persistent-action + helm--quit + (helm-buffer (or buffer helm-buffer))) + (helm-initialize + resume input default sources) + ;; This allows giving the focus to a nested helm session which use + ;; a frame, like completion in + ;; `helm-eval-expression'. Unfortunately + ;; `minibuffer-follows-selected-frame' is available only in + ;; emacs-28+ (bug#2536). + ;; When non-nil (the default) the current active + ;; minibuffer is used in new frame, which is not what we + ;; want in helm when starting from an active minibuffer, + ;; either a helm minibuffer or something line M-:. + (and ori--minibuffer-follows-selected-frame + (setq minibuffer-follows-selected-frame + (unless (or helm--nested + ;; Allow keeping initial minibuffer visible + ;; e.g. completion-at-point from M-:. + (minibufferp helm-current-buffer)) + t))) + ;; We don't display helm-buffer here to avoid popping + ;; up a window or a frame when exiting immediately when + ;; only one candidate (this avoid having the helm frame + ;; flashing), lets first compute candidates and if more + ;; than one display helm-buffer (this is done later in + ;; helm-read-from-minibuffer). + (unless helm-execute-action-at-once-if-one + (helm-display-buffer helm-buffer resume) + (select-window (helm-window)) + (when (and resume helm-visible-mark-overlays) + (set-window-margins (selected-window) + (+ (string-width helm-visible-mark-prefix) + helm-left-margin-width)))) + ;; We are now in helm-buffer. + (unless helm-allow-mouse + (helm--remap-mouse-mode 1)) ; Disable mouse bindings. + (add-hook 'post-command-hook 'helm--maybe-update-keymap) + ;; Add also to update hook otherwise keymap is not updated + ;; until a key is hit (Bug#1670). + (add-hook 'helm-after-update-hook 'helm--maybe-update-keymap) + (add-hook 'post-command-hook 'helm--update-header-line) + (helm-log "helm-internal" "show prompt") + (unwind-protect + (helm-read-from-minibuffer + prompt input preselect + resume keymap default history) + (helm-cleanup)) + (prog1 + (unless helm--quit (helm-execute-selection-action)) + (helm-log "helm-internal" (concat "[End session] " (make-string 41 ?-))))) + (quit + (helm-restore-position-on-quit) + (helm-log-run-hook "helm-internal" 'helm-quit-hook) + (helm-log "helm-internal" (concat "[End session (quit)] " (make-string 34 ?-))) + nil)) + (when (fboundp 'advice-remove) + (advice-remove 'tramp-read-passwd #'helm--suspend-read-passwd) + (advice-remove 'ange-ftp-get-passwd #'helm--suspend-read-passwd) + (advice-remove 'epa-passphrase-callback-function #'helm--suspend-read-passwd) + (advice-remove 'linum-on #'helm--advice-linum-on)) + (helm-log "helm-internal" "helm-alive-p = %S" (setq helm-alive-p nil)) + (helm--remap-mouse-mode -1) ; Reenable mouse bindings. + (setq helm-alive-p nil) + (and ori--minibuffer-follows-selected-frame + (set-default-toplevel-value 'minibuffer-follows-selected-frame + ori--minibuffer-follows-selected-frame)) + ;; Prevent error "No buffer named *helm*" triggered by + ;; `helm-set-local-variable'. + (setq helm--force-updating-p nil) + (setq helm--buffer-in-new-frame-p nil) + ;; Reset helm-pattern so that lambda's using it + ;; before running helm will not start with its old value. + (setq helm-pattern "") + (setq helm--ignore-errors nil + helm-debug nil)))) + +(defun helm--maybe-load-tramp-archive () + ;; Should fix bug#2393 and bug#2394. `while-no-input-ignore-events' + ;; is also let-bounded in `helm--maybe-use-while-no-input'. + (let ((while-no-input-ignore-events + (and (boundp 'while-no-input-ignore-events) + (cons 'dbus-event while-no-input-ignore-events)))) + (unless helm--tramp-archive-maybe-loaded + ;; This for Emacs-27 not requiring tramp-archive. + (and (boundp 'tramp-archive-enabled) + (require 'tramp-archive nil t)) + (setq helm--tramp-archive-maybe-loaded t)))) + +(defun helm--advice-linum-on () + (unless (or (minibufferp) + (string-match "\\`\\*helm" (buffer-name)) + (and (daemonp) (null (frame-parameter nil 'client)))) + (linum-mode 1))) + +;;; Helm resume +;; +;; +(defun helm-resume (arg) + "Resume a previous Helm session. +Call with a prefix arg to choose among existing Helm +buffers (sessions). When calling from Lisp, specify a +`buffer-name' as a string with ARG." + (interactive "P") + (let (buffer + cur-dir + narrow-pos + (helm-full-frame (default-value 'helm-full-frame)) + sources) + (if arg + (if (and (stringp arg) (bufferp (get-buffer arg))) + (setq buffer arg) + (setq buffer (helm-resume-select-buffer))) + (setq buffer helm-last-buffer)) + (cl-assert buffer nil + "helm-resume: No helm buffers found to resume") + (setq sources (buffer-local-value + 'helm-sources (get-buffer buffer))) + ;; Reset `cursor-type' to nil as it have been set to t + ;; when quitting previous session. + (with-current-buffer buffer (setq cursor-type nil)) + (setq helm-full-frame (buffer-local-value + 'helm-full-frame (get-buffer buffer))) + (setq cur-dir (buffer-local-value + 'default-directory (get-buffer buffer))) + (setq helm-saved-selection nil + helm-saved-action nil) + ;; Always resume from current-buffer, if a source needs to resume from a + ;; specific buffer it should be specified from this source, not here. + (setq helm-current-buffer (current-buffer)) + (helm-aif (with-current-buffer buffer + helm--current-buffer-narrowed) + (progn + (set-buffer (car it)) + (setq narrow-pos (cdr it)))) + ;; This happen when calling C-x b within helm. + (helm-aif (get-buffer-window helm-marked-buffer-name 'visible) + (progn (delete-window it) (kill-buffer helm-marked-buffer-name))) + (save-restriction + (when narrow-pos (apply #'narrow-to-region narrow-pos)) + ;; Restart with same `default-directory' value this session + ;; was initially started with. + (with-helm-default-directory cur-dir + (unwind-protect + (helm + :sources sources + :input (buffer-local-value 'helm-input-local (get-buffer buffer)) + :prompt (buffer-local-value 'helm--prompt (get-buffer buffer)) + :resume t + :buffer buffer) + (run-hook-with-args 'helm-resume-after-hook sources)))))) + +(defun helm-resume-previous-session-after-quit () + "Resume previous Helm session within a running Helm." + (interactive) + (with-helm-alive-p + (let ((arg (if (null (member helm-buffer helm-buffers)) 0 1))) + (cond ((> (minibuffer-depth) 1) + (message "Can't resume from recursive minibuffers")) + ((> (length helm-buffers) arg) + (helm-run-after-exit (lambda () (helm-resume (nth arg helm-buffers))))) + (t (message "No previous helm sessions available for resuming")))))) +(put 'helm-resume-previous-session-after-quit 'helm-only t) + +(defun helm-resume-list-buffers-after-quit () + "List Helm buffers that can be resumed within a running Helm." + (interactive) + (with-helm-alive-p + (cond ((> (minibuffer-depth) 1) + (message "Can't resume from recursive minibuffers")) + ((> (length helm-buffers) 0) + (helm-run-after-exit (lambda () (helm-resume t)))) + (t (message "No previous helm sessions available for resuming"))))) +(put 'helm-resume-list-buffers-after-quit 'helm-only t) + +(defun helm-resume-p (resume) + "Whether current Helm session is resumed or not." + (eq resume t)) + +(defun helm-resume-select-buffer () + "Select an `helm-buffer' in `helm-buffers' list to resume a helm session. +Return nil if no `helm-buffer' found." + (when helm-buffers + (or (helm :sources (helm-build-sync-source "Resume helm buffer" + :candidates helm-buffers) + :resume 'noresume + :buffer "*helm resume*") + (keyboard-quit)))) + +;;;###autoload +(defun helm-cycle-resume () + "Cycle in `helm-buffers' list and resume when waiting more than 1.2s." + (interactive) + (cl-assert (and helm-buffers helm-last-buffer) + nil "No helm buffers to resume") + ;; Setup a new iterator only on first hit on + ;; `helm-run-cycle-resume', subsequents hits should reuse same + ;; iterator. + (unless (and (eq last-command 'helm-cycle-resume) + helm--cycle-resume-iterator) + (setq helm--cycle-resume-iterator + (helm-iter-sub-next-circular + helm-buffers helm-last-buffer :test 'equal))) + (helm--resume-or-iter)) + +(defun helm--resume-or-iter (&optional from-helm) + (message "Resuming helm buffer `%s'" helm-last-buffer) + (if (sit-for helm-cycle-resume-delay) + ;; Delay expire, run helm-resume. + (if from-helm + (helm-run-after-exit (lambda () (helm-resume helm-last-buffer))) + (helm-resume helm-last-buffer)) + ;; key pressed before delay, cycle. + (unless from-helm ; cycling to next item already done. + (message "Resuming helm buffer `%s'" + (setq helm-last-buffer + (helm-iter-next helm--cycle-resume-iterator)))))) + +(defun helm-run-cycle-resume () + "Same as `helm-cycle-resume' but intended to be called only from Helm." + (interactive) + (when (cdr helm-buffers) ; only one session registered. + ;; Setup a new iterator only on first hit on + ;; `helm-run-cycle-resume', subsequents hits should reuse same + ;; iterator. + (unless (and (eq last-command 'helm-run-cycle-resume) + helm--cycle-resume-iterator) + (setq helm--cycle-resume-iterator + (helm-iter-sub-next-circular + helm-buffers helm-last-buffer :test 'equal))) + ;; start at next buffer as we already are at `helm-last-buffer'. + (setq helm-last-buffer + (helm-iter-next helm--cycle-resume-iterator)) + (helm--resume-or-iter 'from-helm))) +(put 'helm-run-cycle-resume 'helm-only t) + + +;;; Nested sessions +;; +;; +(defun helm--nest (&rest same-as-helm) + "[INTERNAL] Allow calling `helm' within a running Helm session. + +Arguments SAME-AS-HELM are the same as `helm'. + +Don't use this directly, use instead `helm' with the keyword +:allow-nest. + +\(fn &key SOURCES INPUT PROMPT RESUME PRESELECT BUFFER KEYMAP DEFAULT HISTORY OTHER-LOCAL-VARS)" + (with-helm-window + (let ((orig-helm-current-buffer helm-current-buffer) + (orig-helm-buffer helm-buffer) + (orig-helm--prompt helm--prompt) + (orig-helm-sources helm-sources) + (orig-helm--in-fuzzy helm--in-fuzzy) + (orig-helm--display-frame helm--buffer-in-new-frame-p) + (orig-helm-last-frame-or-window-configuration + helm-last-frame-or-window-configuration) + (orig-one-window-p helm-onewindow-p) + (helm--nested (if helm--buffer-in-new-frame-p 'share t)) + ;; Prevent reusing the underlying value of + ;; `helm-execute-action-at-once-if-one' particularly if it is a function. + helm-execute-action-at-once-if-one) + ;; Using helm-full-frame here allow showing the new + ;; helm-buffer in the same window as old helm-buffer by forcing the usage + ;; of switch-to-buffer in `helm-default-display-buffer', using the flag + ;; `helm--nested' would have the same effect and be more explicit. + (helm-set-local-variable 'helm-full-frame t) + (unwind-protect + (let (helm-current-position + helm-current-buffer + helm-pattern + (helm-buffer (or (cl-getf same-as-helm :buffer) + (nth 5 same-as-helm) + "*Helm*")) + (enable-recursive-minibuffers t)) + (setq helm-sources nil) + (apply #'helm same-as-helm)) + (with-current-buffer orig-helm-buffer + (setq helm-sources orig-helm-sources) + (setq helm--nested nil) + (setq helm--buffer-in-new-frame-p orig-helm--display-frame) + (setq helm-alive-p t) ; Nested session set this to nil on exit. + (setq helm-buffer orig-helm-buffer) + (setq helm-full-frame nil) + (setq helm--prompt orig-helm--prompt) + (setq helm--in-fuzzy orig-helm--in-fuzzy) + (helm-initialize-overlays helm-buffer) + (unless (helm-empty-buffer-p) (helm-mark-current-line t)) + (setq helm-last-frame-or-window-configuration + orig-helm-last-frame-or-window-configuration) + (setq cursor-type nil) + (setq helm-current-buffer orig-helm-current-buffer) + (setq helm-onewindow-p orig-one-window-p) + ;; Be sure advices, hooks, and local modes keep running. + (advice-add 'tramp-read-passwd + :around #'helm--suspend-read-passwd) + (advice-add 'ange-ftp-get-passwd + :around #'helm--suspend-read-passwd) + (advice-add 'epa-passphrase-callback-function + :around #'helm--suspend-read-passwd) + (unless helm-allow-mouse + (helm--remap-mouse-mode 1)) + (unless (cl-loop for h in post-command-hook + thereis (memq h '(helm--maybe-update-keymap + helm--update-header-line))) + (add-hook 'post-command-hook 'helm--maybe-update-keymap) + (add-hook 'post-command-hook 'helm--update-header-line)) + (helm-display-mode-line (helm-get-current-source))))))) + + +;;; Windows and frames +;; +;; + +(defun helm-frame-or-window-configuration (save-or-restore) + "Save or restore last frame or window configuration. +Argument SAVE-OR-RESTORE is either save or restore of window or +frame configuration as per `helm-save-configuration-functions'." + (helm-log "helm-frame-or-window-configuration" "helm-save-configuration-functions = %S" + helm-save-configuration-functions) + (let ((window-persistent-parameters (append '((no-other-window . t)) + window-persistent-parameters))) + (cl-case save-or-restore + (save (setq helm-last-frame-or-window-configuration + (funcall (cdr helm-save-configuration-functions)))) + (restore (funcall (car helm-save-configuration-functions) + helm-last-frame-or-window-configuration) + ;; Restore dedicated windows (bug#2443). + (when helm--original-dedicated-windows-alist + (cl-loop for (win . state) in helm--original-dedicated-windows-alist + when (window-live-p win) + do (set-window-dedicated-p win state)) + (setq helm--original-dedicated-windows-alist nil)) + ;; Restore frame focus. + ;; This is needed for minibuffer own-frame config + ;; when recursive minibuffers are in use. + ;; e.g M-: + helm-minibuffer-history. + (cl-letf ((frame (if (minibufferp helm-current-buffer) + (selected-frame) + (last-nonminibuffer-frame))) + ;; This is a workaround, because the i3 window + ;; manager developers are refusing to fix their + ;; broken timestamp and event handling. + ;; + ;; We basically just disable the part of + ;; select-frame-set-input-focus that would call + ;; XSetInputFocus in Xlib (x-focus-frame), that + ;; resets a timestamp in the xserver which the i3 + ;; developers fail to notice. + ;; + ;; Since they don't know about the new timestamp, + ;; their keyboard handling can break after a helm + ;; user quits emacs, as reported in bug#1641. + ;; + ;; Fortunately for us, we really don't need this + ;; XSetInputFocus call, since we already have focus + ;; for Emacs, the user is just using helm! We call + ;; select-frame-set-input-focus for the other + ;; side-effects, not for x-focus-frame. + ((symbol-function 'x-focus-frame) #'ignore)) + (select-frame-set-input-focus frame)))))) + +(defun helm-current-window-configuration () + "Like `current-window-configuration' but deal with Transient incompatibility. +See https://github.com/magit/transient/discussions/361 for details." + (when (and (window-live-p (bound-and-true-p transient--window)) + (not (transient--preserve-window-p))) + (transient--delete-window)) + (current-window-configuration)) + +(defun helm-split-window-default-fn (window) + "Default function to split windows before displaying `helm-buffer'. + +It is used as default value for +`helm-split-window-preferred-function' which is then the +let-bounded value of `split-window-preferred-function' in +`helm-display-buffer'. When `helm-display-function' which default +to `helm-default-display-buffer' is called from +`helm-display-buffer' the value of +`split-window-preferred-function' will be used by +`display-buffer'." + (let* ((split-width-threshold (and (integerp helm-split-width-threshold) + helm-split-width-threshold)) + (win (if (and (fboundp 'window-in-direction) + ;; Don't try to split when starting in a minibuffer + ;; e.g M-: and try to use helm-show-kill-ring. + (not (minibufferp helm-current-buffer)) + (null helm-split-width-threshold)) + (if (or (one-window-p t) + helm-split-window-inside-p) + (split-window + (selected-window) nil + (if (eq helm-split-window-default-side 'other) + helm-split-window-other-side-when-one-window + helm-split-window-default-side)) + ;; If more than one window reuse one of them. + (cl-case helm-split-window-default-side + (left (or (helm-window-in-direction 'left) + (helm-window-in-direction 'above) + (selected-window))) + (above (or (helm-window-in-direction 'above) + (helm-window-in-direction 'left) + (selected-window))) + (right (or (helm-window-in-direction 'right) + (helm-window-in-direction 'below) + (selected-window))) + (below (or (helm-window-in-direction 'below) + (helm-window-in-direction 'right) + (selected-window))) + (same (selected-window)) + (other (or (helm-other-window-for-scrolling) + (selected-window))) + (t (or (window-next-sibling) (selected-window))))) + (split-window-sensibly window)))) + (setq helm-persistent-action-window-buffer (window-buffer win)) + win)) + +(defun helm-window-in-direction (direction) + "Same as `window-in-direction' but check if window is dedicated. +Return nil when window is dedicated." + (helm-aif (window-in-direction direction) + (and (not (window-dedicated-p it)) it))) + +(defun helm-other-window-for-scrolling () + "Same as `other-window-for-scrolling' but check if window is dedicated. +Returns nil when window is dedicated." + (helm-aif (other-window-for-scrolling) + (and (not (window-dedicated-p it)) it))) + +(defun helm-resolve-display-function (com) + "Decide which display function to use according to `helm-commands-using-frame'. + +The `helm-display-function' buffer local value takes precedence +on `helm-commands-using-frame'. +If `helm-initial-frame' has no minibuffer, use +`helm-display-buffer-in-own-frame' function. +Fallback to global value of `helm-display-function' when no local +value found and current command is not in +`helm-commands-using-frame'." + (let ((win (get-buffer-window helm-current-buffer))) + (or (with-helm-buffer helm-display-function) + (and (or (memq com helm-commands-using-frame) + (and helm-use-frame-when-no-suitable-window + (or (window-dedicated-p win) + (window-parameter win 'window-side))) + (and helm-use-frame-when-more-than-two-windows + (null helm--nested) + (> (length (window-list)) 2)) + ;; Frame parameter is unreliable for minibuffer on emacs-26. + (null (member helm-initial-frame (minibuffer-frame-list)))) + #'helm-display-buffer-in-own-frame) + (default-value 'helm-display-function)))) + +(defun helm-display-buffer (buffer &optional resume) + "Display BUFFER. + +The function used to display `helm-buffer' by calling +`helm-display-function' which splits window with +`helm-split-window-preferred-function'." + (let ((split-window-preferred-function + helm-split-window-preferred-function) + (helm-split-window-default-side + (if (and (not helm-full-frame) + helm-reuse-last-window-split-state) + (helm-acase helm-split-window-default-side + ((same other) it) ; take precedence on *-window-side-state. + ((guard* (progn helm--window-side-state)) guard) + (t it)) + helm-split-window-default-side)) + (disp-fn (with-current-buffer buffer + (helm-resolve-display-function + (if helm-actions-inherit-frame-settings + (helm-this-command) this-command))))) + (prog1 + (funcall disp-fn buffer (or (helm-resume-p resume) + (and helm-actions-inherit-frame-settings + helm--executing-helm-action))) + (with-helm-buffer (setq-local helm-display-function disp-fn)) + (setq helm-onewindow-p (one-window-p t)) + ;; Don't allow other-window and friends switching out of minibuffer. + (when helm-prevent-escaping-from-minibuffer + (helm-prevent-switching-other-window))))) + +(cl-defun helm-prevent-switching-other-window (&key (enabled t)) + "Allow setting `no-other-window' parameter for all windows. +Arg ENABLE is the value of `no-other-window' window property." + (walk-windows + (lambda (w) + (unless (window-dedicated-p w) + (set-window-parameter w 'no-other-window enabled))) + 0)) + +(defun helm-default-display-buffer (buffer &optional _resume) + "Default function to display `helm-buffer' BUFFER. + +It is the default value of `helm-display-function'. +It uses `switch-to-buffer' or `display-buffer' depending on the +value of `helm-full-frame' or `helm-split-window-default-side'." + (let (pop-up-frames + (curwin (get-buffer-window helm-current-buffer))) + (if (or (buffer-local-value 'helm-full-frame (get-buffer buffer)) + (and (eq helm-split-window-default-side 'same) + (one-window-p t))) + (progn (and (not (minibufferp helm-current-buffer)) + ;; side-windows can't be the only window in frame, + ;; emacs refuse to delete other windows when + ;; current is a side-window [1]. + (not (window-parameter curwin 'window-side)) + (delete-other-windows)) + (switch-to-buffer buffer)) + (when (and (or helm-always-two-windows helm-autoresize-mode) + (not (eq helm-split-window-default-side 'same)) + (not (minibufferp helm-current-buffer)) + (not helm-split-window-inside-p) + ;; Same comment as in [1]. + (not (window-parameter curwin 'window-side))) + (delete-other-windows)) + (display-buffer + buffer `(,helm-default-display-buffer-functions + . ,(append helm-default-display-buffer-alist + `((window-height . ,helm-display-buffer-default-height) + (window-width . ,helm-display-buffer-default-width))))) + (helm-log-run-hook "helm-default-display-buffer" 'helm-window-configuration-hook)))) + +;; Shut up byte-compiler in emacs-26 +(defvar tab-bar-mode) +;; No warnings in Emacs built --without-x +(defvar x-display-name) + +(defun helm-display-buffer-in-own-frame (buffer &optional resume) + "Display Helm buffer BUFFER in a separate frame. + +Function suitable for `helm-display-function', +`helm-completion-in-region-display-function' and/or +`helm-show-completion-default-display-function'. + +See `helm-display-buffer-height' and `helm-display-buffer-width' +to configure frame size. + +Note that this feature is available only with emacs-25+. +Note also it is not working properly in helm nested session with emacs +version < emacs-28." + (cl-assert (and (fboundp 'window-absolute-pixel-edges) + (fboundp 'frame-geometry)) + nil "Helm buffer in own frame is only available starting at emacs-25+") + (if (not (display-graphic-p)) + ;; Fallback to default when frames are not usable. + (helm-default-display-buffer buffer) + (setq helm--buffer-in-new-frame-p t) + (let* ((pos (window-absolute-pixel-position)) + (px (car pos)) + (py (cdr pos)) + (half-screen-size (/ (display-pixel-height x-display-name) 2)) + (frame-info (frame-geometry)) + (screen-width (display-pixel-width x-display-name)) + (helm-frame-width (* (frame-char-width) (+ 2 helm-display-buffer-width))) + (prmt-size (length helm--prompt)) + (prmt-width (* prmt-size (frame-char-width))) + (line-height (frame-char-height)) + tab-bar-mode + (new-frame-alist + (if resume + (buffer-local-value 'helm--last-frame-parameters + (get-buffer buffer)) + `((width . ,helm-display-buffer-width) + (height . ,helm-display-buffer-height) + (tool-bar-lines . 0) + ;; lateral constraint to keep the frame inside of the screen + (left . ,(cond ((> (+ px helm-frame-width) screen-width) + (- screen-width helm-frame-width)) + (t (max (- px prmt-width) 0)))) + ;; Try to put frame at the best possible place. + ;; Frame should be below point if enough + ;; place, otherwise above point and + ;; current line should not be hidden + ;; by helm frame. + (top . ,(if (> py half-screen-size) + ;; Above point + (- py + ;; add 2 lines to make sure there is always a gap + (* (+ helm-display-buffer-height 2) line-height) + ;; account for title bar height too + (cddr (assq 'title-bar-size frame-info))) + ;; Below point + (+ py line-height))) + (title . "Helm") + (undecorated . ,helm-use-undecorated-frame-option) + (background-color . ,(or helm-frame-background-color + (face-attribute 'default :background))) + (foreground-color . ,(or helm-frame-foreground-color + (face-attribute 'default :foreground))) + (alpha . ,(or helm-frame-alpha 100)) + (font . ,(assoc-default 'font (frame-parameters))) + (vertical-scroll-bars . nil) + (menu-bar-lines . 0) + (fullscreen . nil) + (visibility . ,(null helm-display-buffer-reuse-frame)) + (minibuffer . t)))) + display-buffer-alist) + ;; Display minibuffer above or below only in initial session, + ;; not on a session triggered by action, this way if user have + ;; toggled minibuffer and header-line manually she keeps this + ;; setting in next action. + (unless (or helm--executing-helm-action resume) + ;; Add the hook inconditionally, if + ;; helm-echo-input-in-header-line is nil helm-hide-minibuffer-maybe + ;; will have anyway no effect so no need to remove the hook. + (add-hook 'helm-minibuffer-set-up-hook 'helm-hide-minibuffer-maybe) + (with-helm-buffer + (setq-local helm-echo-input-in-header-line + (not (> py half-screen-size))))) + (helm-display-buffer-popup-frame buffer new-frame-alist) + ;; When frame size have been modified manually by user restore + ;; it to default value unless resuming or not using + ;; `helm-display-buffer-reuse-frame'. + ;; This have to be done AFTER raising the frame otherwise + ;; minibuffer visibility is lost until next session. + (unless (or resume (not helm-display-buffer-reuse-frame)) + (set-frame-size helm-popup-frame + helm-display-buffer-width + helm-display-buffer-height))) + (helm-log-run-hook "helm-display-buffer-in-own-frame" 'helm-window-configuration-hook))) + +(defun helm-display-buffer-popup-frame (buffer frame-alist) + (if helm-display-buffer-reuse-frame + (let* ((x (cdr (assoc 'left frame-alist))) + (y (cdr (assoc 'top frame-alist))) + (width (cdr (assoc 'width frame-alist))) + (height (cdr (assoc 'height frame-alist)))) + (unless (and helm-popup-frame + (frame-live-p helm-popup-frame)) + (setq helm-popup-frame (make-frame frame-alist))) + (select-frame helm-popup-frame) + (set-frame-position helm-popup-frame x y) + (set-frame-width helm-popup-frame width) + (set-frame-height helm-popup-frame height) + (switch-to-buffer buffer) + (select-frame-set-input-focus helm-popup-frame t)) + ;; If user have changed `helm-display-buffer-reuse-frame' to nil + ;; maybe kill the frame. + (when (and helm-popup-frame + (frame-live-p helm-popup-frame)) + (delete-frame helm-popup-frame)) + (display-buffer + buffer `(display-buffer-pop-up-frame + . ((pop-up-frame-parameters . ,frame-alist)))))) + +(defun helm--frame () + (cl-loop for f in (frame-list) + when (equal (frame-parameter f 'title) "Helm") + return f)) + +;; Ensure to quit helm when user delete helm frame manually. +;; If user deletes another frame keep session running. +(defun helm--delete-frame-function (frame) + (when (and helm-alive-p + ;; FRAME is handling helm-buffer + (get-buffer-window helm-buffer frame)) + (helm-keyboard-quit))) +(add-hook 'delete-frame-functions 'helm--delete-frame-function) + +;;; Initialize +;; +(defun helm-get-sources (sources) + "Transform each element of SOURCES in alist. +Return the resulting list." + (when sources + (mapcar (lambda (source) + (if (listp source) + source (symbol-value source))) + (helm-normalize-sources sources)))) + +(defun helm-initialize (resume input default sources) + "Start initialization of Helm session. +For RESUME INPUT DEFAULT and SOURCES see `helm'." + (helm-log "helm-initialize" "start initialization: resume=%S input=%S" + resume input) + (helm-frame-or-window-configuration 'save) + (setq helm-initial-windows (window-list nil 1)) + (let ((sources-list (helm-get-sources sources))) + (setq helm--in-fuzzy + (cl-loop for s in sources-list + for matchfns = (helm-match-functions s) + for searchfns = (helm-search-functions s) + when (or (memq 'helm-fuzzy-match matchfns) + (memq 'helm-fuzzy-search searchfns)) + return t)) + (helm-log "helm-initialize" "sources-list = %S" sources-list) + (helm-set-local-variable 'helm-sources sources-list) + ;; Once `helm-buffer' is created `helm-sources' will be a local + ;; variable which value is a list of alists. + (helm-current-position 'save) + (if (helm-resume-p resume) + (helm-initialize-overlays (helm-buffer-get)) + (helm-initial-setup input default sources-list)) + (setq helm-alive-p t) + (unless (eq resume 'noresume) + (helm--push-and-remove-dups helm-buffer 'helm-buffers) + (setq helm-last-buffer helm-buffer)) + ;; If a `resume' attribute is present `helm-compute-attr-in-sources' + ;; will run its function. + (when (helm-resume-p resume) + (helm-compute-attr-in-sources 'resume)) + (helm-log "helm-initialize" "end initialization"))) + +(defun helm-current-position (save-or-restore) + "Save or restore current position in `helm-current-buffer'. +Argument SAVE-OR-RESTORE is either save or restore." + (cl-case save-or-restore + (save + (helm-log "helm-current-position" "Save position at %S" (cons (point) (window-start))) + (setq helm-current-position (cons (point) (window-start)))) + (restore + ;; Maybe `helm-current-buffer' have been deleted + ;; during helm session so check if it is here + ;; otherwise position in underlying buffer will be lost. + (when (get-buffer-window helm-current-buffer 'visible) + (helm-log "helm-current-position" "Restore position at %S in buffer %s" + helm-current-position + (buffer-name (current-buffer))) + (goto-char (car helm-current-position)) + ;; Fix this position with the NOFORCE arg of `set-window-start' + ;; otherwise, if there is some other buffer than `helm-current-buffer' + ;; one, position will be lost. + (set-window-start (selected-window) (cdr helm-current-position) t))))) + +(defun helm-initialize-overlays (buffer) + "Initialize Helm overlays in BUFFER." + (helm-log "helm-initialize-overlays" "overlay setup") + (if helm-selection-overlay + ;; make sure the overlay belongs to the helm buffer if + ;; it's newly created + (move-overlay helm-selection-overlay (point-min) (point-min) + (get-buffer buffer)) + + (setq helm-selection-overlay + (make-overlay (point-min) (point-min) (get-buffer buffer))) + (overlay-put helm-selection-overlay 'face 'helm-selection) + (overlay-put helm-selection-overlay 'priority 1))) + +(defun helm-initial-setup (input default sources) + "Initialize Helm settings and set up the Helm buffer." + ;; Run global hook. + (helm-log-run-hook "helm-initial-setup" 'helm-before-initialize-hook) + ;; Run local source hook. + (helm--run-init-hooks 'before-init-hook sources) + ;; For initialization of helm locals vars that need + ;; a value from current buffer, it is here. + (helm-set-local-variable 'current-input-method current-input-method) + (setq helm-current-prefix-arg nil + helm-saved-action nil + helm-saved-selection nil + helm-suspend-update-flag nil + ;; Ensure this is called BEFORE selecting helm-window. + helm-current-buffer (helm--current-buffer) + helm-buffer-file-name buffer-file-name + helm-issued-errors nil + helm-saved-current-source nil + helm--suspend-update-interactive-flag nil) + (when (and (with-helm-current-buffer + (and (buffer-narrowed-p) + (use-region-p))) + (not helm--nested)) + (helm-set-local-variable 'helm--current-buffer-narrowed + (list (current-buffer) + (region-beginning) (region-end)))) + (unless (and (or helm-split-window-state + helm--window-side-state) + helm-reuse-last-window-split-state) + ;; `helm-split-window-state' should be the contrary of what we currently + ;; have to allow toggling windows with C-t. This was influencing the + ;; behavior of `helm-show-action-window-other-window' but we have now + ;; removed this limitation, the action buffer beeing displayed 'below' when + ;; helm-window is too narrow (vertical split). See bug#2635. + (setq helm-split-window-state + (if (or (null helm-split-window-default-side) ; same as below. + (memq helm-split-window-default-side '(below above)) + (null helm-split-width-threshold) + (and (integerp helm-split-width-threshold) + (>= helm-split-width-threshold (+ (frame-width) 4)))) + 'vertical 'horizontal)) + (setq helm--window-side-state + (or helm-split-window-default-side 'below))) + ;; Some sources like helm-mu are using input to init their + ;; candidates in init function, so setup initial helm-pattern here. + ;; See bug#2530 and https://github.com/emacs-helm/helm-mu/issues/54. + ;; Input should have precedence on default. + (cond (input + (setq helm-input input + helm-pattern input)) + ((and default helm-maybe-use-default-as-input) + (setq helm-pattern (if (listp default) + (car default) + default) + ;; Even if helm-pattern is set we want the + ;; prompt to be empty when using default as input, why + ;; helm-input is initialized to "". + helm-input "")) + (helm-maybe-use-default-as-input + (setq helm-pattern (or (with-helm-current-buffer + (thing-at-point 'symbol)) + "") + helm-input "")) + (t + (setq helm-pattern "" + helm-input ""))) + (helm--fuzzy-match-maybe-set-pattern) + ;; Call the init function for sources where appropriate + (helm-compute-attr-in-sources 'init sources) + (clrhash helm-candidate-cache) + (helm-create-helm-buffer) + (helm-clear-visible-mark) + ;; Run global hook. + (helm-log-run-hook "helm-initial-setup" 'helm-after-initialize-hook) + ;; Run local source hook. + (helm--run-init-hooks 'after-init-hook sources)) + +(defun helm--run-init-hooks (hook sources) + "Run after and before init hooks local to source. +See :after-init-hook and :before-init-hook in `helm-source'." + ;; We handle here incorrect values of hooks to not break packages using such + ;; values i.e. lambda's or lists not bound to a symbol. In the future we may + ;; use `helm-log-run-hook' directly which allow using add-hook, remove-hook + ;; etc... + (dolist (s sources) + (helm-acase (assoc-default hook s) + ((guard* (and (functionp it) (not (symbolp it)))) + (funcall it)) + ((guard* (listp it)) + (dolist (h it) (funcall h))) + (t (helm-log-run-hook "helm--run-init-hooks" it))))) + +(defun helm-restore-position-on-quit () + "Restore position in `helm-current-buffer' when quitting." + (helm-current-position 'restore)) + +(defun helm--push-and-remove-dups (elm sym) + "Move ELM of SYM value on top and set SYM to this new value." + (set sym (cons elm (delete elm (symbol-value sym))))) + +(defun helm--current-buffer () + "[INTERNAL] Return `current-buffer' BEFORE `helm-buffer' is initialized. +Note that it returns the minibuffer in use after Helm has started +and is intended for `helm-initial-setup'. To get the buffer where +Helm was started, use `helm-current-buffer' instead." + (if (minibuffer-window-active-p (minibuffer-window)) + ;; If minibuffer is active be sure to use it's buffer + ;; as `helm-current-buffer', this allow to use helm + ;; from an already active minibuffer (M-: etc...) + (window-buffer (active-minibuffer-window)) + ;; Fix Bug#456 + ;; Use this instead of `current-buffer' to ensure + ;; helm session started in helm-mode from a completing-read + ;; Use really the buffer where we started and not the one + ;; where the completing-read is wrapped. i.e + ;; (with-current-buffer SOME-OTHER-BUFFER (completing-read [...]) + (window-buffer (with-selected-window (minibuffer-window) + (minibuffer-selected-window))))) + +(define-derived-mode helm-major-mode + fundamental-mode "Hmm" + "[INTERNAL] Provide major-mode name in Helm buffers. +Unuseful when used outside Helm, don't use it.") +(put 'helm-major-mode 'mode-class 'special) +(put 'helm-major-mode 'helm-only t) + +(defun helm-create-helm-buffer () + "Create and setup `helm-buffer'." + (let ((root-dir default-directory) + (inhibit-read-only t)) + (with-current-buffer (get-buffer-create helm-buffer) + (helm-log "helm-create-helm-buffer" "Enabling major-mode %S" major-mode) + (helm-log "helm-create-helm-buffer" "kill local variables: %S" (buffer-local-variables)) + (kill-all-local-variables) + (helm-major-mode) + (set (make-local-variable 'buffer-read-only) nil) + (buffer-disable-undo) + (erase-buffer) + ;; Use this instead of setting helm-map local ensure we have all + ;; our keys when helm loose minibuffer focus. And the map is + ;; made local as well AFAIU. + (use-local-map helm-map) + (set (make-local-variable 'helm-source-filter) nil) + (make-local-variable 'helm-sources) + (set (make-local-variable 'helm-display-function) nil) + (set (make-local-variable 'helm-selection-point) nil) + (set (make-local-variable 'scroll-margin) + (if helm-display-source-at-screen-top + 0 helm-completion-window-scroll-margin)) + (set (make-local-variable 'default-directory) root-dir) + (set (make-local-variable 'helm-marked-candidates) nil) + (set (make-local-variable 'helm--prompt) helm--prompt) + (helm-initialize-persistent-action) + (helm-log "helm-create-helm-buffer" "helm-display-function = %S" helm-display-function) + (helm-log "helm-create-helm-buffer" "helm--local-variables = %S" helm--local-variables) + (helm--set-local-variables-internal) + (setq truncate-lines helm-truncate-lines) ; already local. + (setq left-margin-width helm-left-margin-width) + (setq cursor-type nil)) + (helm-initialize-overlays helm-buffer) + (get-buffer helm-buffer))) + +(define-minor-mode helm--minor-mode + "[INTERNAL] Enable keymap in Helm minibuffer. +Since this mode has no effect when run outside of Helm context, +please don't use it outside of Helm. + +\\{helm-map}" + :group 'helm + :keymap (and helm-alive-p helm-map) + (unless helm-alive-p (setq helm--minor-mode nil))) +(put 'helm--minor-mode 'helm-only t) + +(defun helm--reset-default-pattern () + (setq helm-pattern "") + (setq helm-maybe-use-default-as-input nil)) + +(defun helm-read-from-minibuffer (prompt + input preselect resume + keymap default history) + "Read pattern with prompt PROMPT and initial input INPUT. +For PRESELECT RESUME KEYMAP DEFAULT HISTORY, see `helm'." + (with-helm-buffer + (if (and (helm-resume-p resume) + ;; When no source, helm-buffer is empty + ;; or contain non--candidate lines (e.g grep exit status) + (helm-get-current-source)) + (helm-mark-current-line t) + (helm-update preselect)) + (let* ((src (helm-get-current-source)) + (src-keymap (assoc-default 'keymap src)) + (hist (or (and history (symbolp history) history) + ;; Needed for resuming. + (assoc-default 'history src))) + (timer nil) + blink-matching-paren + (first-src (car helm-sources)) + (source-process-p (or (assq 'candidates-process src) + (assq 'candidates-process first-src))) + ;; As we are using `helm-keyboard-quit' for `C-g' we have + ;; to prevent emacs command loop redefining `C-g' during + ;; helm-session. This happen only on async source with + ;; large output after a certain delay. The effect is that + ;; the minibuffer is exited but the helm async process + ;; continue running, and because minibuffer is lost `C-g' + ;; have no more effect. By binding `inhibit-quit' here we + ;; prevent this and allow `C-g' (the helm one aka + ;; `helm-keyboard-quit') to quit immediately. + (inhibit-quit source-process-p)) + (helm-log "helm-read-from-minibuffer" "helm-get-candidate-number => %S" + (helm-get-candidate-number)) + (helm-log "helm-read-from-minibuffer" "helm-execute-action-at-once-if-one = %S" + helm-execute-action-at-once-if-one) + (helm-log "helm-read-from-minibuffer" + "helm-quit-if-no-candidate = %S" helm-quit-if-no-candidate) + (when (and src (helm-resume-p resume)) + (helm-display-mode-line src) + (setq helm-pattern input)) + ;; Reset `helm-pattern' and update + ;; display if no result found with precedent value of `helm-pattern' + ;; unless `helm-quit-if-no-candidate' is non-`nil', in this case + ;; Don't force update with an empty pattern. + ;; Reset also `helm-maybe-use-default-as-input' as this checking + ;; happen only on startup. + (when helm-maybe-use-default-as-input + ;; Store value of `default' temporarily here waiting next update + ;; to allow actions like helm-moccur-action matching pattern + ;; at the place it jump to. + (setq helm-input helm-pattern) + (if source-process-p + ;; Reset pattern to next update. + (with-helm-after-update-hook + (helm--reset-default-pattern)) + ;; Reset pattern right now. + (helm--reset-default-pattern)) + ;; Ensure force-update when no candidates + ;; when we start with an empty pattern. + (and (helm-empty-buffer-p) + (null helm-quit-if-no-candidate) + (helm-force-update preselect))) + ;; Handle `helm-execute-action-at-once-if-one' and + ;; `helm-quit-if-no-candidate' now. + (cond ((and (if (functionp helm-execute-action-at-once-if-one) + (funcall helm-execute-action-at-once-if-one) + helm-execute-action-at-once-if-one) + (= (helm-get-candidate-number + (eq helm-execute-action-at-once-if-one 'current-source)) + 1)) + (ignore)) ; Don't enter the minibuffer loop. + ((and helm-quit-if-no-candidate + (= (helm-get-candidate-number) 0)) + (setq helm--quit t) + (and (functionp helm-quit-if-no-candidate) + (funcall helm-quit-if-no-candidate))) + (t ; Enter now minibuffer and wait for input. + (let ((tap (or default + (with-helm-current-buffer + (thing-at-point 'symbol))))) + (when helm-execute-action-at-once-if-one + (helm-display-buffer helm-buffer resume) + (select-window (helm-window))) + (unwind-protect + (minibuffer-with-setup-hook + (lambda () + ;; Start minor-mode with global value of helm-map. + (helm--minor-mode 1) + ;; Now override the global value of `helm-map' with + ;; the local one which is in this order: + ;; - The keymap of current source. + ;; - The value passed in KEYMAP + ;; - Or fallback to the global value of helm-map. + (helm--maybe-update-keymap + (or src-keymap keymap helm-map)) + (helm-log-run-hook "helm-read-from-minibuffer" + 'helm-minibuffer-set-up-hook) + (setq timer + (run-with-idle-timer + (max (with-helm-buffer helm-input-idle-delay) + 0.001) + 'repeat + (lambda () + ;; Stop updating in persistent action + ;; or when `helm-suspend-update-flag' + ;; is non-`nil'. + (unless (or helm-in-persistent-action + helm-suspend-update-flag) + (save-selected-window + (helm-check-minibuffer-input) + (helm-print-error-messages)))))) + ;; minibuffer has already been filled here. + (helm--update-header-line)) + (read-from-minibuffer (propertize (or prompt "pattern: ") + 'face 'helm-minibuffer-prompt) + input helm-map + nil hist tap + helm-inherit-input-method)) + (when timer (cancel-timer timer) (setq timer nil))))))))) + +(defun helm-toggle-suspend-update () + "Enable or disable display update in helm. +This can be useful for example for quietly writing a complex +regexp without Helm constantly updating." + (interactive) + (helm-suspend-update (not helm-suspend-update-flag) t) + (setq helm--suspend-update-interactive-flag + (not helm--suspend-update-interactive-flag))) +(put 'helm-toggle-suspend-update 'helm-only t) + +(defun helm-suspend-update (arg &optional verbose) + "Enable or disable display update in helm. +If ARG is 1 or non nil suspend update, if it is -1 or nil reenable +updating. When VERBOSE is specified display a message." + (with-helm-buffer + (when (setq helm-suspend-update-flag + (helm-acase arg + (1 t) + (-1 nil) + (t it))) + (helm-kill-async-processes) + (setq helm-pattern "")) + (when verbose + (message (if helm-suspend-update-flag + "Helm update suspended!" + "Helm update re-enabled!"))) + (helm-aif (helm-get-current-source) + (helm-display-mode-line it t)))) + +(defun helm-delete-backward-no-update (arg) + "Disable update and delete ARG chars backward. +Update is reenabled when idle 1s." + (interactive "p") + (with-helm-alive-p + (unless helm--suspend-update-interactive-flag + (helm-suspend-update 1)) + (delete-char (- arg)) + (run-with-idle-timer + 1 nil + (lambda () + (unless helm--suspend-update-interactive-flag + (helm-suspend-update -1) + (helm-check-minibuffer-input) + (helm-force-update)))))) +(put 'helm-delete-backward-no-update 'helm-only t) + +(defun helm-delete-char-backward (arg) + "Delete char backward and update when reaching prompt." + (interactive "p") + (condition-case _err + (cond ((and (use-region-p) + delete-active-region + (= arg 1)) + ;; If a region is active, kill or delete it. + (if (eq delete-active-region 'kill) + (kill-region (region-beginning) (region-end) 'region) + (delete-region (region-beginning) (region-end)))) + (t (delete-char (- arg)))) + (buffer-read-only + (progn + (helm-update) + (helm-reset-yank-point))))) +(put 'helm-delete-char-backward 'helm-only t) + +(defun helm--suspend-read-passwd (old--fn &rest args) + "Suspend Helm while reading password. +This is used to advice `tramp-read-passwd', `ange-ftp-get-passwd' +and `epa-passphrase-callback-function'." + ;; Suspend update when prompting for a tramp password. + (setq helm-suspend-update-flag t) + (setq overriding-terminal-local-map nil) + (setq helm--reading-passwd-or-string t) + (unwind-protect + ;; No need to suspend timer in emacs-24.4 + ;; it is fixed upstream. + (apply old--fn args) + (setq helm--reading-passwd-or-string nil) + (setq helm-suspend-update-flag nil))) + +(defun helm--maybe-update-keymap (&optional map) + "Handle different keymaps in multiples sources. + +Overrides `helm-map' with the local map of current source. If no +map is found in current source, does nothing (keeps previous +map)." + (with-helm-buffer + (helm-aif (or map (assoc-default 'keymap (helm-get-current-source))) + ;; We used a timer in the past to leave + ;; enough time to helm to setup its keymap + ;; when changing source from a recursive minibuffer. + ;; e.g C-x C-f M-y C-g + ;; => *find-files have now the bindings of *kill-ring. + ;; It is no more true now we are using `minor-mode-overriding-map-alist' + ;; and `helm--minor-mode' thus it fix Bug#1076 for emacs-24.3 + ;; where concurrent timers are not supported. + ;; i.e update keymap+check input. + (with-current-buffer (window-buffer (minibuffer-window)) + (setq minor-mode-overriding-map-alist `((helm--minor-mode . ,it))))))) + +;;; Prevent loosing focus when using mouse. +;; +(defvar helm--remap-mouse-mode-map + (let ((map (make-sparse-keymap))) + (cl-loop for k in '([mouse-1] [mouse-2] [mouse-3] + [down-mouse-1] [down-mouse-2] [down-mouse-3] + [drag-mouse-1] [drag-mouse-2] [drag-mouse-3] + [double-mouse-1] [double-mouse-2] [double-mouse-3] + [triple-mouse-1] [triple-mouse-2] [triple-mouse-3]) + do (define-key map k 'ignore)) + map)) + +(define-minor-mode helm--remap-mouse-mode + "[INTERNAL] Prevent escaping helm minibuffer with mouse clicks. +Do nothing when used outside of helm context. + +WARNING: Do not use this mode yourself, it is internal to Helm." + :group 'helm + :global t + :keymap helm--remap-mouse-mode-map + (unless helm-alive-p + (setq helm--remap-mouse-mode-map nil))) +(put 'helm--remap-mouse-mode 'helm-only t) + +;; Clean up + +(defun helm-cleanup () + "Clean up the mess when Helm exit or quit." + (helm-log "helm-cleanup" "start cleanup") + (with-selected-window + ;; When exiting with `helm-execute-action-at-once-if-one', + ;; `helm-window' may not be created and we endup with an error + ;; e.g. in eshell completion when only one candidate to complete + ;; so fallback to selected-window in such cases. + (or (get-buffer-window helm-buffer) + (selected-window)) + (let ((frame (helm--frame))) + (setq cursor-type (default-value 'cursor-type)) + ;; Ensure restoring default-value of mode-line to allow user + ;; using the mouse when helm is inactive (Bug#1517,Bug#2377). + (setq mode-line-format (default-value 'mode-line-format)) + (remove-hook 'post-command-hook 'helm--maybe-update-keymap) + (remove-hook 'post-command-hook 'helm--update-header-line) + (helm-display-line-numbers-mode -1) + ;; Be sure we call cleanup functions from helm-buffer. + (helm-compute-attr-in-sources 'cleanup) + ;; Delete or make invisible helm frame. + (if (and helm--buffer-in-new-frame-p + ;; a helm session running in a frame that runs a nested + ;; session share the same frame for both sessions so + ;; don't delete the common frame. + ;; i.e. helm--nested == t => delete + ;; helm--nested == nil => delete + ;; helm--nested == share => don't delete + (not (eq helm--nested 'share)) + ;; Do not delete inadvertently the main frame, this may happen + ;; when hitting quickly twice the same command + ;; e.g. completion-at-point. Should not happen now we use + ;; `helm--frame'. + (not (eql frame helm-initial-frame))) + (progn + (setq-local helm--last-frame-parameters + (helm--get-frame-parameters)) + (bury-buffer) + (if helm-display-buffer-reuse-frame + (make-frame-invisible frame) (delete-frame frame))) + ;; bury-buffer from this window [1]. + ;; Do it at end to make sure buffer is still current. + (bury-buffer)))) + (helm-kill-async-processes) + ;; Remove the temporary hooks added + ;; by `with-helm-temp-hook' that + ;; may not have been consumed. + (when helm--temp-hooks + (cl-loop for (fn . hook) in helm--temp-hooks + do (remove-hook hook fn)) + (setq helm--temp-hooks nil)) + ;; When running helm from a dedicated frame + ;; with no minibuffer, helm will run in the main frame + ;; which have a minibuffer, so be sure to disable + ;; the `no-other-window' prop there. + (helm-prevent-switching-other-window :enabled nil) + (helm-log-run-hook "helm-cleanup" 'helm-cleanup-hook) + (helm-frame-or-window-configuration 'restore) + ;; [1] now bury-buffer from underlying windows otherwise, + ;; if this window is killed the underlying buffer will + ;; be a helm buffer. + (replace-buffer-in-windows helm-buffer) + (setq helm-alive-p nil) + ;; Prevent error "No buffer named *helm*" triggered by + ;; `helm-set-local-variable'. + (setq helm--force-updating-p nil) + (setq helm--buffer-in-new-frame-p nil) + ;; No need to reinitialize helm-pattern here now it is done only + ;; once in init function bug#2530. + (setq helm-last-query helm-pattern) + ;; This is needed in some cases where last input + ;; is yielded infinitely in minibuffer after helm session. + (helm-clean-up-minibuffer)) + +(defun helm-clean-up-minibuffer () + "Remove contents of minibuffer." + (let ((miniwin (minibuffer-window))) + ;; Clean only current minibuffer used by helm. + ;; i.e The precedent one is active. + (unless (minibuffer-window-active-p miniwin) + (with-current-buffer (window-buffer miniwin) + (delete-minibuffer-contents))))) + + +;;; Input handling +;; +;; +(defun helm-check-minibuffer-input () + "Check minibuffer content." + (with-selected-window (or (active-minibuffer-window) + (minibuffer-window)) + (helm-check-new-input (minibuffer-contents)))) + +(defun helm-check-new-input (input) + "Check INPUT string and update the helm buffer if necessary." + (unless (equal input helm-pattern) + (setq helm-pattern input) + (unless (helm-action-window) + (setq helm-input helm-pattern)) + (helm-log "helm-check-new-input" "helm-pattern = %S" helm-pattern) + (helm-log "helm-check-new-input" "helm-input = %S" helm-input) + (helm-log-run-hook "helm-check-new-input" 'helm-before-update-hook) + (setq helm--in-update t) + (helm-update))) + +(defun helm--reset-update-flag () + (run-with-idle-timer + helm-exit-idle-delay nil + (lambda () (setq helm--in-update nil)))) + +;; (add-hook 'helm-after-update-hook #'helm--reset-update-flag) + + +;; All candidates + +(defun helm-get-candidates (source) + "Retrieve and return the list of candidates from SOURCE." + (let* ((candidate-fn (assoc-default 'candidates source)) + (candidate-proc (assoc-default 'candidates-process source)) + ;; See comment in helm-get-cached-candidates (Bug#2113). + (inhibit-quit candidate-proc) + cfn-error + (notify-error + (lambda (&optional e) + (error + "In `%s' source: `%s' %s %s" + (assoc-default 'name source) + (or candidate-fn candidate-proc) + (if e "\n" "must be a list, a symbol bound to a list, or a function returning a list") + (if e (prin1-to-string e) "")))) + (candidates (condition-case-unless-debug err + ;; Process candidates-(process) function + ;; It may return a process or a list of candidates. + (if candidate-proc + ;; Calling `helm-interpret-value' with no + ;; SOURCE arg force the use of `funcall' + ;; and not `helm-apply-functions-from-source'. + (helm-interpret-value candidate-proc) + (helm-interpret-value candidate-fn source)) + (error (helm-log "helm-get-candidates" + "Error: %S" (setq cfn-error err)) + nil)))) + (cond ((and (processp candidates) (not candidate-proc)) + (warn "Candidates function `%s' should be called in a `candidates-process' attribute" + candidate-fn)) + ((and candidate-proc (not (processp candidates))) + (error "Candidates function `%s' should run a process" candidate-proc))) + (cond ((processp candidates) + ;; Candidates will be filtered later in process filter. + candidates) + ;; An error occured in candidates function. + (cfn-error (unless helm--ignore-errors + (funcall notify-error cfn-error))) + ;; Candidates function returns no candidates. + ((or (null candidates) + ;; Can happen when the output of a process + ;; is empty, and the candidates function call + ;; something like (split-string (buffer-string) "\n") + ;; which result in a list of one empty string (Bug#938). + ;; e.g (completing-read "test: " '("")) + (equal candidates '(""))) + nil) + ((listp candidates) + ;; Transform candidates with `candidate-transformer' functions or + ;; `real-to-display' functions if those are found, + ;; otherwise return candidates unmodified. + ;; `filtered-candidate-transformer' is NOT called here. + (helm-transform-candidates candidates source)) + (t (funcall notify-error))))) + +(defun helm-get-cached-candidates (source) + "Return the cached value of candidates for SOURCE. +Cache the candidates if there is no cached value yet." + (let* ((name (assoc-default 'name source)) + (candidate-cache (gethash name helm-candidate-cache)) + ;; Bind inhibit-quit to ensure function terminate in case of + ;; quit from `helm-while-no-input' and processes are added to + ;; helm-async-processes for further deletion (Bug#2113). + ;; FIXME: Is this still needed now `helm-while-no-input' + ;; handles quit-flag? + (inhibit-quit (assoc-default 'candidates-process source))) + (helm-aif candidate-cache + (prog1 it (helm-log "helm-get-cached-candidates" + "Use cached candidates")) + (helm-log "helm-get-cached-candidates" + "No cached candidates, calculate candidates") + (let ((candidates (helm-get-candidates source))) + (cond ((processp candidates) + (push (cons candidates + (append source + (list (cons 'item-count 0) + (cons 'incomplete-line "")))) + helm-async-processes) + (set-process-filter candidates helm-default-output-filter) + (setq candidates nil)) + ((not (assq 'volatile source)) + (puthash name candidates helm-candidate-cache))) + candidates)))) + + +;;; Candidate transformers + +(defun helm-process-candidate-transformer (candidates source) + "Execute `candidate-transformer' function(s) on CANDIDATES in SOURCE." + (helm-aif (assoc-default 'candidate-transformer source) + (helm-apply-functions-from-source source it candidates) + candidates)) + +(defun helm-process-filtered-candidate-transformer (candidates source) + "Execute `filtered-candidate-transformer' function(s) on CANDIDATES in SOURCE." + (helm-aif (assoc-default 'filtered-candidate-transformer source) + (helm-apply-functions-from-source source it candidates source) + candidates)) + +(defun helm--maybe-process-filter-one-by-one-candidate (candidate source) + "Execute `filter-one-by-one' function(s) on real value of CANDIDATE in SOURCE. +Return CANDIDATE modified by the function(s)." + (helm-aif (assoc-default 'filter-one-by-one source) + (let ((real (if (consp candidate) (cdr candidate) candidate))) + (when real + (if (and (listp it) + (not (functionp it))) ;; Don't treat lambda's as list. + (cl-loop with cand = candidate + for f in it + do (setq cand (funcall f real)) + finally return cand) + (funcall it real)))) + candidate)) + +(defun helm--initialize-one-by-one-candidates (candidates source) + "Process CANDIDATES with the `filter-one-by-one' function in SOURCE. +Return CANDIDATES unchanged when pattern is not empty." + (helm-aif (and (string= helm-pattern "") + (assoc-default 'filter-one-by-one source)) + (cl-loop for cand in candidates collect + (helm--maybe-process-filter-one-by-one-candidate cand source)) + candidates)) + +(defun helm-process-filtered-candidate-transformer-maybe + (candidates source process-p) + "Execute `filtered-candidate-transformer' function(s) on CANDIDATES in SOURCE. +When PROCESS-P is non-nil execute +`filtered-candidate-transformer' functions if some, otherwise +return CANDIDATES." + (if process-p + ;; When no filter return CANDIDATES unmodified. + (helm-process-filtered-candidate-transformer candidates source) + candidates)) + +(defun helm-process-real-to-display (candidates source) + "Execute real-to-display function on all CANDIDATES of SOURCE." + (helm-aif (assoc-default 'real-to-display source) + (setq candidates (helm-apply-functions-from-source + source 'mapcar + (lambda (cand) + (if (consp cand) + ;; override DISPLAY from candidate-transformer + (cons (funcall it (cdr cand)) (cdr cand)) + (cons (funcall it cand) cand))) + candidates)) + candidates)) + +(defun helm-transform-candidates (candidates source &optional process-p) + "Transform CANDIDATES from SOURCE according to candidate transformers. + +When PROCESS-P is non-nil executes the +`filtered-candidate-transformer' functions, otherwise processes +`candidate-transformer' functions only, +`filtered-candidate-transformer' functions being processed later, +after the candidates have been narrowed by +`helm-candidate-number-limit', see `helm-compute-matches'. When +`real-to-display' attribute is present, execute its functions on all +maybe filtered CANDIDATES." + (helm-process-real-to-display + (helm-process-filtered-candidate-transformer-maybe + (helm-process-candidate-transformer + candidates source) + source process-p) + source)) + + +;; Narrowing candidates +(defun helm-candidate-number-limit (source) + "Apply candidate-number-limit attribute value. +This overrides `helm-candidate-number-limit' variable. + +E.g.: +If (candidate-number-limit) is in SOURCE, show all candidates in SOURCE. +If (candidate-number-limit . 123) is in SOURCE limit candidate to 123." + (helm-aif (assq 'candidate-number-limit source) + ;; When assoc value is nil use by default 99999999 otherwise use + ;; the assoc value, when it is a symbol interpret its value (bug#1831). + (or (helm-aand (cdr it) (helm-interpret-value it)) 99999999) + (or helm-candidate-number-limit 99999999))) + +(defun helm-candidate-get-display (candidate) + "Get searched display part from CANDIDATE. +CANDIDATE is either a string, a symbol, or a (DISPLAY . REAL) +cons cell." + (helm-acase candidate + ((dst* (disp . real)) disp) + ((guard* (symbolp candidate)) + (symbol-name candidate)) + ((guard* (numberp candidate)) + (number-to-string candidate)) + (t candidate))) + +(defun helm-process-pattern-transformer (pattern source) + "Execute pattern-transformer attribute function(s) on PATTERN in SOURCE." + (helm-aif (assoc-default 'pattern-transformer source) + (helm-apply-functions-from-source source it pattern) + pattern)) + +(defun helm-default-match-function (candidate) + "Check if `helm-pattern' match CANDIDATE. +Default function to match candidates according to `helm-pattern'." + (string-match helm-pattern candidate)) + + +;;; Fuzzy matching +;; +;; +(defvar helm--fuzzy-regexp-cache (make-hash-table :test 'eq)) +(defun helm--fuzzy-match-maybe-set-pattern () + ;; Computing helm-pattern with helm--mapconcat-pattern + ;; is costly, so cache it once time for all and reuse it + ;; until pattern change. + (when helm--in-fuzzy + (let ((fun (if (string-match "\\`\\^" helm-pattern) + #'identity + #'helm--mapconcat-pattern))) + (clrhash helm--fuzzy-regexp-cache) + ;; 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 "\\`!" helm-pattern) + (puthash 'helm-pattern + (if (> (length helm-pattern) 1) + (list (regexp-quote (substring helm-pattern 1 2)) + (funcall fun (substring helm-pattern 1))) + '("" "")) + helm--fuzzy-regexp-cache) + (puthash 'helm-pattern + (if (> (length helm-pattern) 0) + (list (regexp-quote (substring helm-pattern 0 1)) + (funcall fun helm-pattern)) + '("" "")) + helm--fuzzy-regexp-cache))))) + +(defun helm-fuzzy-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 (cadr (gethash 'helm-pattern helm--fuzzy-regexp-cache)))) + (if (string-match "\\`!" helm-pattern) + (not (string-match regexp candidate)) + (string-match regexp candidate))))) + +(defun helm-fuzzy-search (pattern) + "Same as `helm-fuzzy-match' but for sources built with +`helm-source-in-buffer'." + (unless (string-match " " helm-pattern) + ;; Same as in `helm-fuzzy-match' ref[1]. + (let* ((regexps (gethash 'helm-pattern helm--fuzzy-regexp-cache)) + (partial-regexp (car regexps)) + (regexp (cadr regexps))) + (if (string-match "\\`!" pattern) + ;; Don't try to search here, just return + ;; the position of line and go ahead, + ;; letting `helm-search-match-part' checking if + ;; pattern match against this line. + (prog1 (list (pos-bol) (pos-eol)) + (forward-line 1)) + ;; We could use here directly `re-search-forward' + ;; on the regexp produced by `helm--mapconcat-pattern', + ;; but it is very slow because emacs have to do an incredible + ;; amount of loops to match e.g "[^f]*f[^o]*o..." in the whole buffer, + ;; more the regexp is long more the amount of loops grow. + ;; (Probably leading to a max-lisp-eval-depth error if both + ;; regexp and buffer are too big) + ;; So just search the first bit of pattern e.g "[^f]*f", and + ;; then search the corresponding line with the whole regexp, + ;; which increase dramatically the speed of the search. + (cl-loop while (re-search-forward partial-regexp nil t) + for bol = (pos-bol) + for eol = (pos-eol) + if (progn (goto-char bol) + (re-search-forward regexp eol t)) + do (goto-char eol) and return t + else do (goto-char eol) + finally return nil))))) + +(defvar helm-fuzzy-default-score-fn #'helm-fuzzy-flex-style-score) +(defun helm-score-candidate-for-pattern (candidate pattern) + "Assign score to CANDIDATE according to PATTERN." + ;; Unknown candidates always go on top. + (if (helm-candidate-prefixed-p candidate) + 200.00 + (funcall helm-fuzzy-default-score-fn candidate pattern))) + +;; The flex scoring needs a regexp whereas the fuzzy scoring works +;; directly with helm-pattern, so cache the needed regexp for flex +;; scoring to not (re)compute it at each candidate. We could reuse +;; the regexp cached in `helm--fuzzy-regexp-cache' but it is not +;; exactly the same as the one needed for flex and also it is always +;; computed against the whole helm-pattern which is not usable for +;; e.g. file completion. +(defvar helm--fuzzy-flex-regexp-cache (make-hash-table :test 'equal)) +(defun helm-fuzzy-flex-style-score (candidate pattern) + "Give a score to CANDIDATE according to PATTERN. +A regexp is generated from PATTERN to calculate score. +Score is calculated with the emacs-27 flex algorithm using +`helm-flex--style-score'." + (let ((regexp (helm-aif (gethash pattern helm--fuzzy-flex-regexp-cache) + it + (clrhash helm--fuzzy-flex-regexp-cache) + (puthash pattern (helm--fuzzy-flex-pattern-to-regexp pattern) + helm--fuzzy-flex-regexp-cache)))) + (helm-flex--style-score candidate regexp t))) + +(defun helm--fuzzy-flex-pattern-to-regexp (pattern) + "Return a regexp from PATTERN compatible with emacs-27 flex algorithm." + (completion-pcm--pattern->regex + (helm-completion--flex-transform-pattern (list pattern)) 'group)) + +(defun helm-flex-add-score-as-prop (candidates regexp) + (cl-loop with case-fold-search = (helm-set-case-fold-search) + for cand in candidates + collect (helm-flex--style-score cand regexp))) + +(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))) + +(defun helm-fuzzy-helm-style-score (candidate pattern) + "Give a score to CANDIDATE according to PATTERN. +Score is calculated for contiguous matches found with PATTERN. +Score is 100 (maximum) if PATTERN is fully matched in CANDIDATE. +One point bonus is added to score when PATTERN prefix matches +CANDIDATE. Contiguous matches get a coefficient of 2." + (let* ((cand (if (stringp candidate) + 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))) + 2) + ((and (null pat-lookup) ; length = 1 + (string= pattern (substring cand 0 1))) + 150) + (t 0))) + ;; Exact match e.g. foo -> foo == 200 + (bonus1 (and (string= cand pattern) 200)) + ;; Partial match e.g. foo -> aafooaa == 100 + ;; or foo -> fooaaa + (bonus2 (and (or (string-match + (concat "\\`" (regexp-quote pattern)) + cand) + (string-match + (concat "\\<" (regexp-quote pattern) "\\>") + cand)) + 100))) + (+ bonus + (or bonus1 bonus2 + ;; Give a coefficient of 2 for contiguous matches. + ;; That's mean that "wiaaaki" will not take precedence + ;; on "aaawiki" when matching on "wiki" even if "wiaaaki" + ;; starts by "wi". + (* (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. +It sorts on the display part by default. + +It sorts CANDIDATES by their scores as calculated by +`helm-score-candidate-for-pattern'. Set USE-REAL to non-nil to +sort on the real part. If BASENAME is non-nil assume we are +completing filenames and sort on basename of candidates. If +PRESERVE-TIE-ORDER is nil, ties in scores are sorted by length of +the candidates." + (if (string= helm-pattern "") + candidates + (let ((table-scr (make-hash-table :test 'equal))) + (sort candidates + (lambda (s1 s2) + ;; Score and measure the length on real or display part of candidate + ;; according to `use-real'. + (let* ((real-or-disp-fn (if use-real #'cdr #'car)) + (cand1 (cond ((and basename (consp s1)) + (helm-basename (funcall real-or-disp-fn s1))) + ((consp s1) (funcall real-or-disp-fn s1)) + (basename (helm-basename s1)) + (t s1))) + (cand2 (cond ((and basename (consp s2)) + (helm-basename (funcall real-or-disp-fn s2))) + ((consp s2) (funcall real-or-disp-fn s2)) + (basename (helm-basename s2)) + (t s2))) + (data1 (or (gethash cand1 table-scr) + (puthash cand1 + (list (helm-score-candidate-for-pattern + cand1 helm-pattern) + (length (helm-stringify cand1))) + table-scr))) + (data2 (or (gethash cand2 table-scr) + (puthash cand2 + (list (helm-score-candidate-for-pattern + cand2 helm-pattern) + (length (helm-stringify cand2))) + table-scr))) + (len1 (cadr data1)) + (len2 (cadr data2)) + (scr1 (car data1)) + (scr2 (car data2))) + (cond ((= scr1 scr2) + ;; Comparison by length should not be called here most of + ;; the time because we use now flex scoring which does + ;; such test, however we still use helm fuzzy scoring + ;; with preserve-tie-order, so keep testing length here + ;; for it. + (unless preserve-tie-order + (< len1 len2))) + ((> scr1 scr2))))))))) + +(defun helm-fuzzy-matching-default-sort-fn (candidates _source) + "Default `filtered-candidate-transformer' to sort in fuzzy matching." + (helm-fuzzy-matching-default-sort-fn-1 candidates)) + +(defun helm-fuzzy-matching-sort-fn-preserve-ties-order (candidates _source) + "Same as `helm-fuzzy-matching-default-sort-fn' but preserving order of ties. +The default function, `helm-fuzzy-matching-default-sort-fn', +sorts ties by length, shortest first. This function may be more +useful when the order of the candidates is meaningful, e.g. with +`recentf-list'." + ;; Flex scoring is already taking in account length of strings so this + ;; function have no effect when flex scoring is in use, force the usage of + ;; helm fuzzy scoring to ensure no testing against length is done. + (let ((helm-fuzzy-default-score-fn #'helm-fuzzy-helm-style-score)) + (helm-fuzzy-matching-default-sort-fn-1 candidates nil nil t))) + +(defun helm--maybe-get-migemo-pattern (pattern &optional diacritics) + (or (and helm-migemo-mode + (assoc-default pattern helm-mm--previous-migemo-info)) + (if diacritics + (char-fold-to-regexp pattern) + pattern))) + +(defun helm-fuzzy-default-highlight-match-1 (candidate &optional pattern diacritics file-comp) + (let* ((pair (and (consp candidate) candidate)) + (display (helm-stringify (if pair (car pair) candidate))) + (real (cdr pair)) + (host (and file-comp (get-text-property + (max 0 (1- (length display))) 'host display))) + (regex (helm--maybe-get-migemo-pattern pattern diacritics)) + ;; Match prop at end, because at 0 we might have an icon. + (mpart (get-text-property (1- (length display)) 'match-part display)) + (mp (cond ((and mpart (string= display mpart)) nil) + (mpart) + ;; FIXME: This may be wrong when match-on-real + ;; is nil, so we should flag match-on-real on + ;; top and use it. + (file-comp (file-name-nondirectory + (or host (and (stringp real) real) display))))) + (count 0) + beg-str end-str) + ;; Happens when matching empty lines (^$), in this case there is nothing to + ;; highlight. + (if (string= mpart "") + candidate + (when host (setq pattern (cadr (split-string pattern ":")))) + ;; Extract all parts of display keeping original properties. + (when (and mp (ignore-errors + ;; Avoid error when candidate is a huge line. + (string-match (regexp-quote mp) display))) + (setq beg-str (substring display 0 (match-beginning 0)) + end-str (substring display (match-end 0) (length display)) + mp (substring display (match-beginning 0) (match-end 0)))) + (with-temp-buffer + ;; Insert the whole display part and remove non--match-part + ;; to keep their original face properties. + (insert (propertize (or mp display) 'read-only nil)) ; Fix (bug#1176) + (goto-char (point-min)) + (condition-case nil + (progn + ;; Try first matching against whole pattern. + (unless (string= pattern "") + (while (helm-re-search-forward regex nil t) + (cl-incf count) + (helm-add-face-text-properties + (match-beginning 0) (match-end 0) 'helm-match))) + ;; If no matches start matching against multiples or fuzzy matches. + (when (zerop count) + (cl-loop with multi-match = (string-match-p " " pattern) + with patterns = (if multi-match + (cl-loop for pat in (helm-mm-split-pattern + pattern) + collect + (helm--maybe-get-migemo-pattern + pat diacritics)) + (helm-acase (split-string pattern "" t) + ((guard* (string= "!" (car it))) nil) + (t it))) + for p in patterns + ;; Multi matches (regexps patterns). + if multi-match do + (progn + (while (helm-re-search-forward p nil t) + (helm-add-face-text-properties + (match-beginning 0) (match-end 0) 'helm-match)) + (goto-char (point-min))) + ;; Fuzzy matches (literal patterns). + else do + (when (search-forward p nil t) + (helm-add-face-text-properties + (match-beginning 0) (match-end 0) + 'helm-match))))) + (invalid-regexp nil)) + ;; Now replace the original match-part with the part + ;; with face properties added. + (setq display (if mp (concat beg-str (buffer-string) end-str) (buffer-string)))) + (if real (cons display real) display)))) + +(defun helm-fuzzy-default-highlight-match (candidate &optional pattern diacritics file-comp) + "The default function to highlight matches in fuzzy matching. +Highlight elements in CANDIDATE matching PATTERN according +to the matching method in use. When DIACRITICS is specified, ignore +diacritics, see `char-fold-to-regexp' for more infos." + (unless pattern (setq pattern helm-pattern)) + (if (string= pattern "") + ;; Empty pattern, do nothing. This is needed when this function + ;; is used outside of helm-fuzzy-highlight-matches like in *buffers-list. + candidate + ;; Else start highlighting. + (helm-fuzzy-default-highlight-match-1 candidate pattern diacritics file-comp))) + +(defun helm-fuzzy-highlight-matches (candidates source) + "Highlight matches in CANDIDATES for SOURCE. +The filtered-candidate-transformer function to highlight fuzzy matches. +See `helm-fuzzy-default-highlight-match'." + (cl-assert helm-fuzzy-matching-highlight-fn nil "Wrong type argument functionp: nil") + (cl-loop with diac = (helm-get-attr 'diacritics source) + with file-comp-p = (and (not (helm-action-window)) + (or minibuffer-completing-file-name + helm--minibuffer-completing-file-name + (helm-get-attr 'completing-file-name source))) + ;; helm-pattern may have been modified (fuzzy) so ensure to + ;; use helm-input which is the raw pattern. + with pattern = (if file-comp-p + (file-name-nondirectory helm-input) + helm-pattern) + when (string= pattern "") return candidates + for c in candidates + collect (funcall helm-fuzzy-matching-highlight-fn c pattern diac file-comp-p))) + + +;;; helm-flex style +;; +;; Provide the emacs-27 flex style for emacs<27. +;; Reuse the flex scoring algorithm of flex style in emacs-27. +(defun helm-flex--style-score (str regexp &optional score) + "Score STR candidate according to REGEXP. + +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 may be build with +`helm-completion--flex-transform-pattern' function, and the regexp +with `completion-pcm--pattern->regex'. For commodity, +`helm--fuzzy-flex-pattern-to-regexp' is used to build such regexp. + +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)) + (if (string-match 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))) + result) + (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)) + (setq result (/ score-numerator (* len (1+ score-denominator)) 1.0)) + (put-text-property 0 1 'completion-score result str)) + (if (and score result) result str)) + (put-text-property 0 1 'completion-score 0.0 str) + (if score 0.0 str))) + + +;;; Matching candidates +;; +;; +(defun helm-match-functions (source) + (let ((matchfns (or (assoc-default 'match source) + (assoc-default 'match-strict source) + #'helm-default-match-function))) + (if (and (listp matchfns) (not (functionp matchfns))) + matchfns (list matchfns)))) + +(defun helm-search-functions (source) + (let ((searchfns (assoc-default 'search source))) + (if (and (listp searchfns) (not (functionp searchfns))) + searchfns (list searchfns)))) + +(defun helm-match-from-candidates (cands matchfns match-part-fn limit source) + "Filter CANDS list in SOURCE with functions in MATCHFNS. +If MATCH-PART-FN is a valid function, use it to determine in each +candidate of CANDS the part of candidate we want to match on (see the +:match-part documentation in `helm-source'). When LIMIT in CANDS is +reached, stop and return the filtered list. This function is used only +by sync sources, i.e. sources built with `helm-source-sync', see +`helm-search-from-candidate-buffer' for `helm-source-in-buffer' sources +and `helm-output-filter' for async sources." + (when cands ; nil in async sources. + (condition-case-unless-debug err + (cl-loop with hash = (make-hash-table :test 'equal) + with allow-dups = (assq 'allow-dups source) + with case-fold-search = (helm-set-case-fold-search) + with count = 0 + for iter from 1 + for fn in matchfns + when (< count limit) nconc + (cl-loop for c in cands + for dup = (gethash c hash) + for disp = (helm-candidate-get-display c) + while (< count limit) + for target = (if (helm-get-attr 'match-on-real source) + ;; Let's fails on error in + ;; case next block returns nil. + (or (cdr-safe c) + (get-text-property 0 'helm-realvalue disp)) + disp) + for prop-part = (get-text-property 0 'match-part target) + for part = (and match-part-fn + (or prop-part + (funcall match-part-fn target))) + ;; When allowing dups check if DUP + ;; have been already found in previous loop + ;; by comparing its value with ITER. + when (and (or (and allow-dups dup (= dup iter)) + (null dup)) + (condition-case nil + (funcall fn (or part target)) + (invalid-regexp nil))) + do + (progn + ;; Give as value the iteration number of + ;; inner loop to be able to check if + ;; the duplicate have not been found in previous loop. + (puthash c iter hash) + (setq c (helm--maybe-process-filter-one-by-one-candidate c source)) + (cl-incf count)) + ;; Filter out nil candidates maybe returned by + ;; `helm--maybe-process-filter-one-by-one-candidate'. + and when c collect + (if (and part (not prop-part)) + (if (consp c) + (cons (propertize target 'match-part part) (cdr c)) + (propertize c 'match-part part)) + c))) + (error (unless (eq (car err) 'invalid-regexp) ; Always ignore regexps errors. + (helm-log-error "helm-match-from-candidates" + "helm-match-from-candidates in source `%s': %s %s" + (assoc-default 'name source) (car err) (cdr err))) + nil)))) + +(defun helm-compute-matches (source) + "Start computing candidates in SOURCE." + (save-current-buffer + (let ((matchfns (helm-match-functions source)) + (matchpartfn (assoc-default 'match-part source)) + (helm--source-name (assoc-default 'name source)) + (helm-current-source source) + (limit (helm-candidate-number-limit source)) + (helm-pattern (helm-process-pattern-transformer + helm-pattern source))) + (helm--fuzzy-match-maybe-set-pattern) + ;; If source have a `filtered-candidate-transformer' attr + ;; Filter candidates with this func, otherwise just compute + ;; candidates. + ;; NOTE that this next block of code is returning nil on async sources, + ;; the candidates being processed directly in `helm-output-filter' + ;; process-filter. + (helm-process-filtered-candidate-transformer + ;; When using in-buffer method or helm-pattern is empty or + ;; using dynamic completion always compute all candidates. + (if (or (equal helm-pattern "") + (assq 'match-dynamic source) + (helm--candidates-in-buffer-p source)) + ;; Compute all candidates up to LIMIT. + ;; one-by-one are computed here only for sources that + ;; display a list of candidates even with an empty + ;; pattern. + (helm--initialize-one-by-one-candidates + (helm-take (helm-get-cached-candidates source) limit) + source) + ;; Compute candidates according to pattern with their match + ;; fns. + ;; one-by-one filtered candidates are computed during the + ;; execution of next loop in `helm-match-from-candidates'. + (helm-match-from-candidates + (helm-get-cached-candidates source) matchfns matchpartfn limit source)) + source)))) + +(defun helm--candidates-in-buffer-p (source) + (assq 'search source)) + +(defun helm-render-source (source matches) + "Display MATCHES from SOURCE according to its settings." + (when matches + (helm-insert-header-from-source source) + (let ((start (point)) + (multiline (assq 'multiline source)) + (count 1) + separate) + (dolist (m matches) + (when multiline + (if separate + (helm-insert-candidate-separator) + (setq separate t))) + (helm-insert-match m 'insert count source) + (cl-incf count)) + (when multiline + (put-text-property start (point) 'helm-multiline t))))) + +(defmacro helm-while-no-input (&rest body) + "Same as `while-no-input' but returns either BODY or nil. +Unlike `while-no-input' this macro ensure to not returns `t'." + (declare (debug t) (indent 0)) + (let ((catch-sym (make-symbol "input"))) + `(with-local-quit + (catch ',catch-sym + (let ((throw-on-input ',catch-sym) + val) + (setq val (progn ,@body)) + ;; See comments in `while-no-input' about resetting + ;; quit-flag. + (cond ((eq quit-flag throw-on-input) + (setq quit-flag nil)) + (quit-flag nil) + (t val))))))) + +(defmacro helm--maybe-use-while-no-input (&rest body) + "Wrap BODY in `helm-while-no-input' unless initializing a remote connection." + `(progn + ;; Tramp would ask for passwd, so don't use `helm-while-no-input' until + ;; connected to remote. + (if (or (and (file-remote-p helm-pattern) + (not (file-remote-p helm-pattern nil t))) + helm-update-edebug + ;; Don't use while-no-input on initial helm-update before minibuffer + ;; is not ready (Issue #2729), this happen in + ;; `helm-read-from-minibuffer'. + (not (helm-active-minibuffer-window))) + ,@body + (helm-log "helm--maybe-use-while-no-input" + "Using here `helm-while-no-input'") + ;; Emacs bug , unexpected + ;; dbus-event is triggered on dbus init. + ;; Ignoring the dbus-event work on emacs28+; for emacs27 or older + ;; version, require tramp-archive can workaround the issue. + (let ((while-no-input-ignore-events + (and (boundp 'while-no-input-ignore-events) + (cons 'dbus-event while-no-input-ignore-events)))) + (helm-while-no-input ,@body))))) + +(defun helm-active-minibuffer-window () + "Check if helm-window has an active minibuffer." + (and (helm-window) (minibuffer-window-active-p (minibuffer-window)))) + +(defun helm--collect-matches (src-list) + "Return a list of matches for each source in SRC-LIST. + +The resulting value is a list of lists, e.g. ((a b c) (c d) (e +f)) or (nil nil nil) for three sources when no matches found, +however this function can be interrupted by new input and in this +case returns a plain nil i.e. not (nil), in this case +`helm-update' is not rendering the source, keeping previous +candidates in display." + (let ((matches (helm--maybe-use-while-no-input + (cl-loop for src in src-list + collect (helm-compute-matches src))))) + (unless (eq matches t) matches))) + + +;;; Case fold search +;; +;; +(defun helm-set-case-fold-search (&optional pattern) + "Used to set the value of `case-fold-search' in Helm. +Return t or nil depending on the value of `helm-case-fold-search' +and `helm-pattern'." + (unless pattern (setq pattern helm-pattern)) + (if helm-alive-p + (let ((helm-case-fold-search + (helm-aif (assq 'case-fold-search (helm-get-current-source)) + (cdr it) + helm-case-fold-search)) + ;; Only parse basename for filenames + ;; to avoid setting case sensitivity + ;; when expanded directories contains upcase + ;; characters. + (bn-or-pattern (if (string-match "[~/]*" pattern) + (helm-basename pattern) + pattern))) + (helm-set-case-fold-search-1 bn-or-pattern)) + case-fold-search)) + +(defun helm-set-case-fold-search-1 (pattern) + (cl-case helm-case-fold-search + (smart (let ((case-fold-search nil)) + (if (string-match "[[:upper:]]" pattern) nil t))) + (t helm-case-fold-search))) + + +;;; Helm update +;; +(defun helm-update (&optional preselect source candidates) + "Update candidates list in `helm-buffer' based on `helm-pattern'. +Argument PRESELECT is a string or regexp used to move selection +to a particular place after finishing update. +When SOURCE is provided update mode-line for this source, otherwise +the current source will be used. +Argument CANDIDATES when provided is used to redisplay these candidates +without recomputing them, it should be a list of lists." + (helm-log "helm-update" "Start updating") + (helm-kill-async-processes) + ;; When persistent action have been called + ;; we have two windows even with `helm-full-frame'. + ;; So go back to one window when updating if `helm-full-frame' + ;; is non-`nil'. + (when (with-helm-buffer + (and helm-onewindow-p + ;; We are not displaying helm-buffer in a frame and + ;; helm-window is already displayed. + (not helm--buffer-in-new-frame-p) + (helm-window) + (not (helm-action-window)))) + (with-helm-window (delete-other-windows))) + (with-current-buffer (helm-buffer-get) + (set (make-local-variable 'helm-input-local) helm-pattern) + (let ((ov '(nil))) + (unwind-protect + (let (sources matches) + ;; Collect sources ready to be updated. + (setq sources + (cl-loop for src in helm-sources + when (helm-update-source-p src) + collect src)) + ;; When no sources to update erase buffer to avoid duplication of + ;; header and candidates when next chunk of update will arrive, + ;; otherwise the buffer is erased AFTER [1] the results are + ;; computed. This is also needed when pattern is quickly deleted + ;; backward and we reach requires-pattern limit, in this case the helm + ;; buffer is not updated and stays with the results of the last + ;; matching pattern. + (unless sources (erase-buffer)) + (helm-maybe-dim-prompt-on-update ov) + ;; Compute matches without rendering the sources. + ;; This prevent the helm-buffer flickering when constantly + ;; updating. + (setq matches (or candidates (helm--collect-matches sources))) + ;; If computing matches finished and is not interrupted + ;; erase the helm-buffer and render results (Fix bug#1157). + (when matches ;; nil only when interrupted by while-no-input. + (erase-buffer) + (cl-loop for src in sources + for mtc in matches + do (helm-render-source src mtc)) + ;; Move to first line only when there is matches + ;; to avoid cursor moving upside down (Bug#1703). + (helm--update-move-first-line))) + ;; When there is only one async source, update mode-line and run + ;; `helm-after-update-hook' in `helm-output-filter--post-process', + ;; when there is more than one source, update mode-line and run + ;; `helm-after-update-hook' now even if an async source is + ;; present and running in BG. + (let ((src (or source (helm-get-current-source)))) + (unless (assq 'candidates-process src) + (helm-display-mode-line src 'force) + (and (car ov) (delete-overlay (car ov))) + (helm-log-run-hook "helm-update" 'helm-after-update-hook))) + (when preselect + (helm-log "helm-update" "Update preselect candidate %s" preselect) + (if (helm-window) + (with-helm-window (helm-preselect preselect source)) + (helm-preselect preselect source))) + (setq helm--force-updating-p nil) + (helm--reset-update-flag)) + (helm-log "helm-update" "end update")))) + +(defun helm-maybe-dim-prompt-on-update (overlay) + "Make minibuffer foreground gray while updating. +Argument OVERLAY is a ref-cell." + (when (and helm-dim-prompt-on-update + ;; Avoid an empty window when coming from bookmarks. + (not (helm-empty-buffer-p)) + (consp overlay)) ;; Ensure OVERLAY is a ref-cell. + (with-selected-window (minibuffer-window) + (setcar overlay (make-overlay (minibuffer-prompt-end) (point-max))) + (overlay-put (car overlay) 'face 'helm-dim-prompt) + (redisplay)))) + +(defun helm-update-source-p (source) + "Whether SOURCE needs updating or not." + (let ((len (string-width + (if (assq 'multimatch source) + ;; Don't count spaces entered when using + ;; multi-match. + (replace-regexp-in-string " " "" helm-pattern) + helm-pattern)))) + (and (or (not helm-source-filter) + (member (assoc-default 'name source) helm-source-filter)) + (>= len + (helm-aif (assq 'requires-pattern source) (or (cdr it) 1) 0)) + ;; bugs were mentioned here before: Bug#1802, bug#2423 + ;; must be fixed already by 'helm-re-search-forward' + ;; + ;; short patterns that are alone not expected to return any results, + ;; ignore in order to not erase Helm buffer on such patterns. + (cl-loop for p in (helm-mm-split-pattern helm-pattern) + never (member p '("!" "!^" "?" "@!")))))) + +(defun helm--update-move-first-line () + "Goto first line of `helm-buffer'." + (goto-char (point-min)) + (if (helm-window) + (helm-move-selection-common :where 'line + :direction 'next + :follow t) + (forward-line 1) + (helm-mark-current-line) + ;; If we are here, it is because helm-window is not ready, if one of the + ;; functions in `helm-move-selection-after-hook' is called with + ;; `with-helm-window' (it shouldn't but never know) we will have an error. + (condition-case-unless-debug _err + (helm-log-run-hook "helm--update-move-first-line" + 'helm-move-selection-after-hook) + (error nil)) + (helm-follow-execute-persistent-action-maybe))) + +(cl-defun helm-force-update (&optional (preselect nil spreselect) (recenter t)) + "Force recalculation and update of candidates. + +Unlike `helm-update', this function re-evaluates `init' and +`update' attributes when present; also `helm-candidate-cache' is +not reinitialized, meaning candidates are not recomputed unless +pattern has changed. + +Selection is preserved to current candidate if it still exists after +update or moved to PRESELECT, if specified. If PRESELECT is specified with a +nil value no preselection at all is done. +The helm-window is re-centered at the end when RECENTER is t which +is the default. RECENTER can be also a number in this case it is +passed as argument to `recenter'." + (with-helm-buffer + (let* ((source (helm-get-current-source)) + (selection (helm-aif (helm-get-selection nil t source) + (regexp-quote it)))) + (setq helm--force-updating-p t) + (mapc 'helm-force-update--reinit helm-sources) + (helm-update (if spreselect preselect selection) source) + (when (and (helm-window) recenter) + (with-helm-window + (recenter (and (numberp recenter) recenter))))))) + +(defun helm-refresh () + "Force recalculation and update of candidates." + (interactive) + (with-helm-alive-p + (helm-force-update))) +(put 'helm-refresh 'helm-only t) + +(defun helm-force-update--reinit (source) + "Reinit SOURCE by calling its update and init functions." + ;; When using a specific buffer as cache, don't kill it. + (helm-aif (and (null (bufferp (assoc-default + (helm-get-attr 'name source) + helm--candidate-buffer-alist))) + (helm-apply-functions-from-source + source 'helm-candidate-buffer)) + (kill-buffer it)) + (dolist (attr '(update init)) + (helm-aif (assoc-default attr source) + (helm-apply-functions-from-source source it))) + (helm-remove-candidate-cache source)) + +(defun helm-redisplay-buffer () + "Redisplay candidates in `helm-buffer'. + +Candidates are not recomputed, only redisplayed after modifying +the whole list of candidates in each source with functions found +in `redisplay' attribute of current source. Note that candidates +are redisplayed with their display part with all properties +included only. This function is used in async sources to +transform the whole list of candidates from the sentinel +functions (i.e. when all candidates have been computed) because +other filters like `candidate-transformer' are modifying only +each chunk of candidates from `process-filter' as they come in +and not the whole list. Use this for e.g. sorting the whole list +of async candidates once computed. + +Note: To ensure redisplay is done in async sources after Helm +reached `candidate-number-limit' you will have also to redisplay +your candidates from `helm-async-outer-limit-hook'." + (with-helm-buffer + (let ((get-cands (lambda (source) + (let ((fns (assoc-default 'redisplay source)) + candidates + helm-move-to-line-cycle-in-source + helm-allow-mouse) + (helm-goto-source source) + (helm-next-line) + (helm-awhile (condition-case-unless-debug nil + (and (not (helm-pos-header-line-p)) + (helm-get-selection + nil 'withprop source)) + (error nil)) + (push it candidates) + (when (save-excursion + (forward-line 1) (helm-end-of-source-p t)) + (cl-return nil)) + (helm-next-line)) + (helm-apply-functions-from-source + source fns (nreverse candidates))))) + (get-sources (lambda () + (let (sources helm-move-to-line-cycle-in-source) + (helm-awhile (helm-get-current-source) + (push it sources) + (when (save-excursion + (helm-move--end-of-source) + (forward-line 1) (eobp)) + (cl-return nil)) + (helm-next-source)) + (nreverse sources))))) + (goto-char (point-min)) + (helm-update nil (helm-get-current-source) + (cl-loop with sources = (funcall get-sources) + for s in helm-sources + for name = (assoc-default 'name s) collect + (when (cl-loop for src in sources thereis + (string= name + (assoc-default 'name src))) + (funcall get-cands s))))))) + +(defun helm-remove-candidate-cache (source) + "Remove SOURCE from `helm-candidate-cache'." + (remhash (assoc-default 'name source) helm-candidate-cache)) + +(defvar helm-drag-mouse-1-fn 'ignore) +(defun helm-insert-match (match insert-function &optional num source) + "Insert MATCH into `helm-buffer' with INSERT-FUNCTION. +If MATCH is a cons cell then insert the car as display with the +cdr stored as real value in a `helm-realvalue' text property. +Args NUM and SOURCE are also stored as text property when +specified as respectively `helm-cand-num' and `helm-cur-source'." + (let ((start (pos-bol (point))) + (dispvalue (helm-candidate-get-display match)) + (realvalue (cdr-safe match)) + (map (when helm-allow-mouse (make-sparse-keymap))) + (inhibit-read-only t) + end) + (when (and (stringp dispvalue) + (not (zerop (length dispvalue)))) + (funcall insert-function dispvalue) + (setq end (pos-eol)) + ;; Some strings may handle another keymap prop. + (remove-text-properties start end '(keymap nil)) + (put-text-property start end 'read-only nil) + ;; Some sources with candidates-in-buffer have already added + ;; 'helm-realvalue property when creating candidate buffer. + (unless (get-text-property start 'helm-realvalue) + (and realvalue + (put-text-property start end + 'helm-realvalue realvalue))) + (when map + (define-key map [drag-mouse-1] 'ignore) + (define-key map [mouse-1] 'helm-mouse-select-candidate) + (define-key map [mouse-2] 'ignore) + (define-key map [mouse-3] 'helm-menu-select-action) + (add-text-properties + start end + `(mouse-face highlight + keymap ,map + ;; At 0 we might have an icon, so match at end. + help-echo ,(helm-acase (get-text-property (1- end) 'help-echo) + ((guard* (stringp it)) + (concat it "\nmouse-1: select candidate\nmouse-3: menu actions")) + (t "mouse-1: select candidate\nmouse-3: menu actions"))))) + (when num + (put-text-property start end 'helm-cand-num num)) + (when source + (put-text-property start end 'helm-cur-source source)) + (funcall insert-function "\n")))) + +(defun helm--mouse-reset-selection-help-echo () + (let* ((inhibit-read-only t) + (start (overlay-start helm-selection-overlay)) + (end (overlay-end helm-selection-overlay)) + (help-echo (get-text-property start 'help-echo))) + (when (and (stringp help-echo) + (string-match "mouse-2: execute action" help-echo)) + (put-text-property + start end + 'help-echo (replace-match "mouse-1: select candidate" + t t help-echo))))) + +(defun helm--bind-mouse-for-selection (pos) + (let ((inhibit-read-only t) + (map (get-text-property pos 'keymap))) + (when map + (define-key map [down-mouse-1] helm-drag-mouse-1-fn) + (define-key map [mouse-2] 'helm-maybe-exit-minibuffer) + (put-text-property + helm-selection-point + (overlay-end helm-selection-overlay) + 'help-echo (helm-aif (get-text-property pos 'help-echo) + (if (and (stringp it) + (string-match "mouse-1: select candidate" it)) + (replace-match "mouse-2: execute action" t t it) + "mouse-2: execute action\nmouse-3: menu actions") + "mouse-2: execute action\nmouse-3: menu actions"))))) + +(defun helm-mouse-select-candidate (event) + (interactive "e") + (let* ((window (posn-window (event-end event))) + (pos (posn-point (event-end event)))) + (unwind-protect + (with-current-buffer (window-buffer window) + (if (and (helm-action-window) + (eql window (get-buffer-window helm-buffer))) + (user-error "selection in helm-window not available while selecting action") + (helm--mouse-reset-selection-help-echo) + (goto-char pos) + (when (helm-pos-multiline-p) + (goto-char (or (helm-get-previous-candidate-separator-pos) + (helm-get-previous-header-pos))) + (forward-line 1))) + (helm-mark-current-line) + (when helm-popup-tip-mode + (helm-maybe-show-popup-tip-info)) + (helm-follow-execute-persistent-action-maybe)) + (select-window (minibuffer-window)) + (set-buffer (window-buffer window))))) +(put 'helm-mouse-select-candidate 'helm-only t) + +(defun helm-insert-header-from-source (source) + "Insert SOURCE name in `helm-buffer' header. +Maybe insert, by overlay, additional info after the source name +if SOURCE has header-name attribute." + (let ((name (assoc-default 'name source))) + (helm-insert-header + name + (helm-aif (assoc-default 'header-name source) + (helm-apply-functions-from-source source it name))))) + +(defun helm-insert-header (name &optional display-string) + "Insert header of source NAME into the helm buffer. +If DISPLAY-STRING is non-nil and a string value then display this +additional info after the source name by overlay." + (unless (bobp) + (let ((start (point))) + (insert (propertize "\n" 'face 'helm-eob-line)) + (put-text-property start (point) 'helm-header-separator t))) + (let ((start (point))) + (insert name) + (put-text-property (pos-bol) + (pos-eol) 'helm-header t) + (when display-string + (overlay-put (make-overlay (pos-bol) (pos-eol)) + 'display display-string)) + (insert "\n") + (add-text-properties start (point) '(face helm-source-header + ;; Disable line numbers on + ;; source headers. + display-line-numbers-disable t)))) + +(defun helm-insert-candidate-separator () + "Insert separator of candidates into the Helm buffer." + (insert (propertize helm-candidate-separator 'face 'helm-separator)) + (put-text-property (pos-bol) + (pos-eol) 'helm-candidate-separator t) + (insert "\n")) + +(defun helm-init-relative-display-line-numbers () + "Enable `display-line-numbers' for Helm buffers. +This is intended to be added to `helm-after-initialize-hook'. +This will work only in Emacs-26+, i.e. Emacs versions that have +`display-line-numbers-mode'." + (when (boundp 'display-line-numbers) + (with-helm-buffer + (setq display-line-numbers 'relative)))) + +(define-minor-mode helm-display-line-numbers-mode + "Toggle display of line numbers in current Helm buffer." + :group 'helm + (with-helm-alive-p + (cl-assert (boundp 'display-line-numbers) nil + "`display-line-numbers' not available") + (if helm-display-line-numbers-mode + (with-helm-buffer + (setq display-line-numbers 'relative) + (helm--action-at-nth-set-fn+ + helm-action-at-nth-positive-prefix-key) + (helm--action-at-nth-set-fn- + helm-action-at-nth-negative-prefix-key)) + (with-helm-buffer + (setq display-line-numbers nil) + (helm--action-at-nth-set-fn+ + helm-action-at-nth-positive-prefix-key 'unset) + (helm--action-at-nth-set-fn- + helm-action-at-nth-negative-prefix-key 'unset))))) +(put 'helm-display-line-numbers-mode 'helm-only t) + + + +;;; Async process +;; +(defun helm-output-filter (process output) + "The default `process-filter' function for Helm async sources. +See `helm-default-output-filter'." + (with-local-quit + (let* ((process-assoc (assoc process helm-async-processes)) + (source (cdr process-assoc)) + (insertion-marker (cdr (assq 'insertion-marker source))) + (incomplete-line-info (assq 'incomplete-line source)) + (item-count-info (assq 'item-count source)) + (multiline (assq 'multiline source))) + (with-helm-buffer + (save-excursion + (if insertion-marker + (prog1 + ;; Marker position is constantly updated while + ;; text is inserted by `insert-before-markers' which ignore + ;; its type. + (goto-char insertion-marker) + (helm-log "helm-output-filter" + "Goto insertion marker at %S" insertion-marker)) + (goto-char (point-max)) + (helm-insert-header-from-source source) + (helm-log "helm-output-filter" + "Inserting source header name = %S" (assq 'name source)) + (setcdr process-assoc + (append source `((insertion-marker . ,(point-marker)))))) + ;; Split output and treat incomplete lines one by one. We don't use + ;; OMIT-NULLS deliberately to have ("output" "") when splitting + ;; "output\n". + (let ((lines (split-string output "\n")) + candidates) + (while lines + (if (not (cdr lines)) ; An incomplete line. + ;; store it until new output arrives. + (setcdr incomplete-line-info (pop lines)) + (helm-aif (cdr incomplete-line-info) + (let ((head (pop lines))) + (helm-log "helm-output-filter" + "incomplete-line-info(1) = %S" it) + (helm-log "helm-output-filter" + "incomplete-line-info(2) = %S" head) + (push (concat it head) candidates) + ;; Previously we were setting incomplete-line-info to line + ;; and later to (concat incomplete-line-info line) to fix + ;; Bug#1187, it seems both were wrong. + (setcdr incomplete-line-info nil)) + (push (pop lines) candidates)))) + ;; Transform candidates. + (setq candidates (helm-transform-candidates + (nreverse candidates) source t)) + ;; Now insert each candidate in helm buffer. + (catch 'reach-limit + (dolist (candidate candidates) + (setq candidate (helm--maybe-process-filter-one-by-one-candidate + candidate source)) + (let ((start (point))) + (unless (or (not multiline) + (zerop (cdr (assq 'item-count source)))) + (helm-insert-candidate-separator)) + (helm-insert-match candidate 'insert-before-markers + (1+ (cdr (assq 'item-count source))) + source) + (when multiline + (put-text-property start (point) 'helm-multiline t))) + (cl-incf (cdr item-count-info)) + ;; Exit when we reach candidate-number-limit. + (when (>= (cdr item-count-info) (helm-candidate-number-limit source)) + (process-put process 'reach-limit t) + (helm-kill-async-process process #'kill-process) ; SIGKILL (9). + (helm-log-run-hook "helm-output-filter" + 'helm-async-outer-limit-hook) + (throw 'reach-limit nil)))))))) + (helm-output-filter--post-process))) + +(defun helm-output-filter--post-process () + (helm-aif (get-buffer-window helm-buffer 'visible) + (with-selected-window it + (helm-skip-noncandidate-line 'next) + (helm-mark-current-line nil 'nomouse) + (helm-follow-execute-persistent-action-maybe) + (helm-display-mode-line (helm-get-current-source)) + (helm-log-run-hook "helm-output-filter--post-process" + 'helm-after-update-hook) + (helm--reset-update-flag)))) + +(defun helm-kill-async-processes () + "Kill all asynchronous processes registered in `helm-async-processes'." + (cl-loop for (proc . _src) in helm-async-processes + do (helm-kill-async-process proc) + finally (setq helm-async-processes nil))) + +(defun helm-kill-async-process (process &optional kill-fn) + "Stop output from `helm-output-filter' and kill associated PROCESS." + (set-process-filter process t) + (funcall (or kill-fn #'delete-process) process)) + +(defun helm-process-deferred-sentinel-hook (process event file) + "Defer remote processes in sentinels. +Meant to be called at the beginning of a sentinel process +function." + (when (and (not (zerop helm-tramp-connection-min-time-diff)) + (string= event "finished\n") + (or (file-remote-p file) + ;; `helm-suspend-update-flag' + ;; is non-`nil' here only during a + ;; running process, this will never be called + ;; when user set it explicitly with `C-!'. + helm-suspend-update-flag)) + (setq helm-suspend-update-flag t) + ;; Kill the process but don't delete entry in + ;; `helm-async-processes'. + (helm-kill-async-process process) + ;; When tramp opens the same connection twice in less than 5 + ;; seconds, it throws 'suppress, which calls the real-handler on + ;; the main "Emacs". To avoid this [1] helm waits for 5 seconds + ;; before updates yet allows user input during this delay. [1] In + ;; recent Emacs versions, this has been fixed so tramp returns nil + ;; in such conditions. Note: `tramp-connection-min-time-diff' cannot + ;; have values less than 5 seconds otherwise the process dies. + (run-at-time helm-tramp-connection-min-time-diff + nil (lambda () + (when helm-alive-p ; Don't run timer fn after quit. + (setq helm-suspend-update-flag nil) + (helm-check-minibuffer-input)))))) + +;;; Actions +;; +(defun helm-execute-selection-action () + "Execute current action." + (helm-log-run-hook "helm-execute-selection-action" + 'helm-before-action-hook) + ;; Position can be change when `helm-current-buffer' + ;; is split, so jump to this position before executing action. + (helm-current-position 'restore) + (unwind-protect + (prog1 (helm-execute-selection-action-1) + (helm-log-run-hook "helm-execute-selection-action" + 'helm-after-action-hook)) + (setq helm--executing-helm-action nil))) + +(defun helm-execute-selection-action-1 (&optional + selection action + preserve-saved-action) + "Execute ACTION on current SELECTION. +If PRESERVE-SAVED-ACTION is non-nil, then save the action." + (helm-log "helm-execute-selection-action-1" "executing action") + (setq action (helm-get-default-action + (or action + helm-saved-action + (if (get-buffer helm-action-buffer) + (helm-get-selection helm-action-buffer) + (helm-get-actions-from-current-source))))) + (helm-aif (and (not helm-in-persistent-action) + (get-buffer helm-action-buffer)) + (kill-buffer it)) + (let ((source (or helm-saved-current-source + (helm-get-current-source))) + non-essential) + (setq selection (helm-coerce-selection + (or selection + helm-saved-selection + (helm-get-selection nil nil source) + (and (assq 'accept-empty source) "")) + source)) + (unless preserve-saved-action (setq helm-saved-action nil)) + (when (and selection action) (funcall action selection)))) + +(defun helm-coerce-selection (selection source) + "Apply coerce attribute function to SELECTION in SOURCE. +Coerce source with coerce function." + (helm-aif (assoc-default 'coerce source) + (helm-apply-functions-from-source source it selection) + selection)) + +(defun helm-get-default-action (action) + "Get the first ACTION value of action list in source." + (if (and (listp action) (not (functionp action))) + (cdar action) + action)) + +(defun helm--show-action-window-other-window-p () + "Decide if window layout is suitable for showing action buffer. +Note that the return value is meaningful only at some point in the code, +i.e. before displaying action menu." + (when helm-show-action-window-other-window + ;; We were previously checking helm-split-window-state (eq vertical) to + ;; decide to show action window, we now show it inconditionally in such case + ;; but 'below'. + (if (< (window-width (helm-window)) + (or split-width-threshold 160)) + 'below + helm-show-action-window-other-window))) + +(defun helm-select-action () + "Select an action for the currently selected candidate. +If action buffer is selected, back to the Helm buffer." + (interactive) + (with-helm-alive-p + (let ((src (helm-get-current-source))) + (helm-log-run-hook "helm-select-action" 'helm-select-action-hook) + (setq helm-saved-selection (helm-get-selection nil nil src)) + (with-selected-frame (with-helm-window (selected-frame)) + (prog1 + (helm-acond ((get-buffer-window helm-action-buffer 'visible) + (let ((delta (window-total-height it))) + (set-window-buffer it helm-buffer) + (helm--set-action-prompt 'restore) + ;; If `helm-show-action-window-other-window' is non nil + ;; we should have now two windows displaying + ;; helm-buffer, delete the one that was handling + ;; previously action buffer. + (when (helm--show-action-window-other-window-p) + (delete-window it)) + ;; Resize window on horizontal split, though for some + ;; reasons only 'above' needs to be resized. + (when (memq helm-show-action-window-other-window '(below above)) + (window-resize (get-buffer-window helm-buffer) delta)) + (kill-buffer helm-action-buffer) + (setq helm-saved-selection nil) + (helm-set-pattern helm-input 'noupdate) + ;; Maybe hide minibuffer if helm was showing + ;; minibuffer in header-line and we are just toggling + ;; menu [1]. + (helm-hide-minibuffer-maybe))) + (helm-saved-selection + (setq helm-saved-current-source src) + (let ((actions (helm-get-actions-from-current-source src)) + helm-onewindow-p) + (if (functionp actions) + (message "Sole action: %s" + ;; lambdas are no more represented as list in + ;; Emacs-29+ Bug#2666. + (if (or (not (symbolp actions)) + (byte-code-function-p actions) + (helm-subr-native-elisp-p actions)) + "Anonymous" actions)) + (helm-show-action-buffer actions) + ;; Be sure the minibuffer is entirely deleted + ;; (bug#907). Previously this was done from + ;; `helm--delete-minibuffer-contents-from' which + ;; was itself force updating, now do it explicitely + ;; from here. + (helm-set-pattern "" t) + (helm-force-update nil) + ;; Unhide minibuffer to make visible action prompt [1]. + (with-selected-window (minibuffer-window) + (remove-overlays) (setq cursor-type t)) + (helm--set-action-prompt) + (helm-check-minibuffer-input)))) + (t (message "No Actions available"))) + (helm-display-mode-line (helm-get-current-source)) + (run-hooks 'helm-window-configuration-hook)))))) +(put 'helm-select-action 'helm-only t) + +(defun helm-menu-select-action (_event) + "Popup action menu from mouse-3." + (interactive "e") + (if (get-buffer-window helm-action-buffer 'visible) + (helm-select-action) + (let ((src (helm-get-current-source))) + (helm-aif (helm-get-actions-from-current-source src) + (progn + (setq helm-saved-current-source src) + (if (functionp it) + (message "Sole action: %s" + ;; lambdas are no more represented as list in + ;; Emacs-29+ Bug#2666. + (if (or (not (symbolp it)) + (byte-code-function-p it) + (helm-subr-native-elisp-p it)) + "Anonymous" it)) + (setq helm-saved-action + (x-popup-menu + t (list "Available Actions" + (cons "" it)))) + (helm-maybe-exit-minibuffer)) + (message "No Actions available")))))) +(put 'helm-menu-select-action 'helm-only t) + +(defun helm--set-action-prompt (&optional restore) + (with-selected-window (minibuffer-window) + (let ((inhibit-read-only t) + (props '(face minibuffer-prompt + field t + read-only t + rear-nonsticky t + front-sticky t)) + (prt (if restore helm--prompt helm--action-prompt))) + (erase-buffer) + (insert (apply #'propertize prt props)) + ;; Restore minibuffer depth indicator if the mode is enabled. + (when minibuffer-depth-indicate-mode + (minibuffer-depth-setup))))) + +(defun helm-show-action-buffer (actions) + (with-current-buffer (get-buffer-create helm-action-buffer) + (erase-buffer) + (buffer-disable-undo) + (setq cursor-type nil) + ;; Maybe display action buffer 'below' if window isn't large enough + ;; (bug#2635). + (set-window-buffer (helm-aif (helm--show-action-window-other-window-p) + (split-window (get-buffer-window helm-buffer) nil it) + (get-buffer-window helm-buffer)) + helm-action-buffer) + (set (make-local-variable 'helm-sources) + (list + (helm-build-sync-source "Actions" + :volatile t + :nomark t + :persistent-action #'ignore + :persistent-help "DoNothing" + :keymap 'helm-map + :candidates actions + :mode-line '("Action(s)" "\\\\[helm-select-action]:BackToCands RET/f1/f2/fn:NthAct") + :candidate-transformer + (lambda (candidates) + (cl-loop for (i . j) in candidates + for count from 1 + collect + (cons (concat (cond ((> count 12) + " ") + ((< count 10) + (format "[f%s] " count)) + (t (format "[f%s] " count))) + (propertize i 'face 'helm-action)) + j))) + :candidate-number-limit nil))) + (set (make-local-variable 'helm-source-filter) nil) + (set (make-local-variable 'helm-selection-overlay) nil) + (helm-initialize-overlays helm-action-buffer))) + + +;; Selection of candidates + +(defun helm-display-source-at-screen-top-maybe (unit) + "Display source at the top of screen when UNIT value is \\='source. +Return nil for any other value of UNIT." + (when (and helm-display-source-at-screen-top (eq unit 'source)) + (set-window-start (selected-window) + (save-excursion (forward-line -1) (point))))) + +(defun helm-skip-noncandidate-line (direction) + "Skip source header or candidates separator when going in DIRECTION. +DIRECTION is either \\='next or \\='previous. +Same as `helm-skip-header-and-separator-line' but ensure point is +moved to the right place when at bob or eob." + (helm-skip-header-and-separator-line direction) + (and (bobp) (forward-line 1)) ; Skip first header. + (and (eobp) (forward-line -1))) ; Avoid last empty line. + +(defun helm-skip-header-and-separator-line (direction) + "Skip source header or candidate separator when going to next/previous line. +DIRECTION is either \\='next or \\='previous." + (let ((fn (cl-ecase direction + (next 'eobp) + (previous 'bobp)))) + (while (and (not (funcall fn)) + (or (helm-pos-header-line-p) + (helm-pos-candidate-separator-p))) + (forward-line (if (and (eq direction 'previous) + (not (eq (pos-bol) (point-min)))) + -1 1))))) + +(defun helm-display-mode-line (source &optional force) + "Set up mode-line and header-line for `helm-buffer'. + +SOURCE is a Helm source object. + +Optional argument FORCE forces redisplay of the Helm buffer's +mode and header lines." + (set (make-local-variable 'helm-mode-line-string) + (helm-interpret-value (or (and (listp source) ; Check if source is empty. + (assoc-default 'mode-line source)) + (default-value 'helm-mode-line-string)) + source)) + (let* ((src-name (assoc-default 'name source)) + (follow (and (or (helm-follow-mode-p source) + (and helm-follow-mode-persistent + (member src-name helm-source-names-using-follow))) + " (HF)")) + (marked (if (assoc-default 'all-marked source) + helm-marked-candidates + (cl-loop for c in helm-marked-candidates + for name = (assoc-default 'name (car c)) + when (string= name src-name) + collect c)))) + ;; Setup mode-line. + (if helm-mode-line-string + (setq mode-line-format + `(:propertize + (" " mode-line-buffer-identification " " + (:eval (format "L%-3d" (helm-candidate-number-at-point))) + ,follow + " " + (:eval ,(and marked + (propertize + (format "M%d" (length marked)) + 'face 'helm-visible-mark))) + (:eval (when ,helm--mode-line-display-prefarg + (let ((arg (prefix-numeric-value + (or prefix-arg current-prefix-arg)))) + (unless (= arg 1) + (propertize (format " [prefarg:%s]" arg) + 'face 'helm-prefarg))))) + " " + (:eval (with-helm-buffer + (helm-show-candidate-number + (car-safe helm-mode-line-string)))) + " " helm--mode-line-string-real " " + (:eval (make-string (window-width) ? ))) + keymap (keymap (mode-line keymap + (mouse-1 . ignore) + (down-mouse-1 . ignore) + (drag-mouse-1 . ignore) + (mouse-2 . ignore) + (down-mouse-2 . ignore) + (drag-mouse-2 . ignore) + (mouse-3 . ignore) + (down-mouse-3 . ignore) + (drag-mouse-3 . ignore)))) + helm--mode-line-string-real + (substitute-command-keys (if (listp helm-mode-line-string) + (cadr helm-mode-line-string) + helm-mode-line-string))) + (setq mode-line-format (default-value 'mode-line-format))) + ;; Setup header-line. + (cond (helm-echo-input-in-header-line + (setq force t) + (helm--set-header-line)) + (helm-display-header-line + (let ((hlstr (helm-interpret-value + (and (listp source) + (assoc-default 'header-line source)) + source)) + (endstr (make-string (window-width) ? ))) + (setq header-line-format + (propertize (concat " " hlstr endstr) + 'face 'helm-header)))))) + (when force (force-mode-line-update))) + +(defun helm--set-header-line (&optional update) + (with-selected-window (minibuffer-window) + (when helm-display-header-line + ;; Prevent cursor movement over the overlay displaying + ;; persistent-help in minibuffer (Bug#2108). + (setq-local disable-point-adjustment t)) + (let* ((beg (save-excursion (vertical-motion 0 (helm-window)) (point))) + (end (save-excursion (end-of-visual-line) (point))) + ;; The visual line where the cursor is. + (cont (buffer-substring beg end)) + (pref (propertize + " " + 'display (if (string-match-p (regexp-opt `(,helm--prompt + ,helm--action-prompt)) + cont) + `(space :width ,helm-header-line-space-before-prompt) + (propertize + "->" + 'face 'helm-header-line-left-margin)))) + (pos (- (point) beg))) + ;; Increment pos each time we find a "%" up to current-pos (bug#1648). + (cl-loop for c across (buffer-substring-no-properties beg (point)) + when (eql c ?%) do (cl-incf pos)) + ;; Increment pos when cursor is on a "%" to make it visible in header-line + ;; i.e "%%|" and not "%|%" (bug#1649). + (when (eql (char-after) ?%) (setq pos (1+ pos))) + (setq cont (replace-regexp-in-string "%" "%%" cont)) + (with-helm-buffer + (setq header-line-format (concat pref cont " ")) + (funcall helm-default-prompt-display-function pos) + (when update (force-mode-line-update)))))) + +(defun helm-set-default-prompt-display (pos) + (put-text-property + ;; Increment pos to handle the space before prompt (i.e `pref'). + (+ 1 pos) (+ 2 pos) + 'face + ;; Don't just use cursor face, this can hide the current character. + (list :inverse-video t + :foreground (face-background 'cursor) + :background (face-background 'default)) + header-line-format)) + +(defun helm-exchange-minibuffer-and-header-line () + "Display minibuffer in header-line and vice versa for current Helm session. + +This is a toggle command." + (interactive) + (cl-assert (not (eq (helm-get-attr 'echo-input-in-header-line) 'never)) + nil "echo-input-in-header-line not allowed in this source") + (with-helm-window + (add-hook 'helm-minibuffer-set-up-hook 'helm-hide-minibuffer-maybe) + (setq-local helm-echo-input-in-header-line + (not helm-echo-input-in-header-line)) + (with-selected-window (minibuffer-window) + (if (with-helm-buffer helm-echo-input-in-header-line) + (helm-hide-minibuffer-maybe) + (remove-overlays) + (setq cursor-type t))) + (helm-display-mode-line (helm-get-current-source) t))) +(put 'helm-exchange-minibuffer-and-header-line 'helm-only t) + +(defun helm--update-header-line () + ;; This is already called in `post-command-hook', + ;; so it should not be called elsewhere. + (when (with-helm-buffer helm-echo-input-in-header-line) + (helm--set-header-line t))) + +;; We were previously let-binding `resize-mini-windows' in +;; `helm-read-from-minibuffer', this to prevent minibuffer resizing when +;; inserting multiline string in fake minibuffer (header-line). +;; I seems it had no effect see bug#2638. +(defun helm-hide-minibuffer-maybe () + "Hide minibuffer contents in a Helm session. +This function should normally go to `helm-minibuffer-set-up-hook'. +It has no effect if `helm-echo-input-in-header-line' is nil." + (when (with-helm-buffer helm-echo-input-in-header-line) + (let ((ov (make-overlay (point-min) (point-max) nil nil t))) + (overlay-put ov 'window (selected-window)) + (helm-aif (and helm-display-header-line + (helm-get-attr 'persistent-help)) + (progn + (overlay-put ov 'display + (truncate-string-to-width + (substitute-command-keys + (concat "\\\\[helm-execute-persistent-action]: " + (format "%s (keeping session)" it))) + (- (window-width) 1))) + (overlay-put ov 'face 'helm-header)) + (overlay-put ov 'face (let ((bg-color (face-background 'default nil))) + `(:background ,bg-color :foreground ,bg-color)))) + + (setq cursor-type nil)))) + +(defun helm-show-candidate-number (&optional name) + "Used to display candidate number in mode-line. +You can specify NAME of candidates e.g. \"Buffers\" otherwise it +is \"Candidate(s)\" by default." + (when helm-alive-p + (unless (helm-empty-source-p) + ;; Build a fixed width string when candidate-number < 1000 + (let* ((cand-name (or name "Candidate(s)")) + (width (length (format "[999 %s]" cand-name)))) + (propertize + (format (concat "%-" (number-to-string width) "s") + (format "[%s %s]" + (helm-get-candidate-number 'in-current-source) + cand-name)) + 'face (if helm-suspend-update-flag + 'helm-candidate-number-suspended + 'helm-candidate-number)))))) + +(defun helm-move-selection-common (&rest args) + "Move the selection marker to a new position. +Position is determined by WHERE and DIRECTION. +When FOLLOW is specified execute `helm-follow-execute-persistent-action-maybe'. +Key arg WHERE can be one of: + - line + - page + - edge + - source +Key arg DIRECTION can be one of: + - previous + - next + - A source or a source name when used with :WHERE \\='source. + +\(fn &key WHERE DIRECTION FOLLOW)" + (apply #'helm-move-selection-common-1 + (mapcar (lambda (kw) + (plist-get args kw)) + '(:where :direction :follow)))) + +(defun helm-move-selection-common-1 (where direction follow) + (unless follow (setq follow t)) + (let ((move-func (cl-case where + (line (cl-ecase direction + (previous 'helm-move--previous-line-fn) + (next 'helm-move--next-line-fn))) + (page (cl-ecase direction + (previous 'helm-move--previous-page-fn) + (next 'helm-move--next-page-fn))) + (edge (cl-ecase direction + (previous 'helm-move--beginning-of-buffer-fn) + (next 'helm-move--end-of-buffer-fn))) + (source (cl-case direction + (previous 'helm-move--previous-source-fn) + (next 'helm-move--next-source-fn) + (t (lambda () ; A source is passed as DIRECTION arg. + (helm-move--goto-source-fn direction))))))) + source) + (unless (or (helm-empty-buffer-p (helm-buffer-get)) + (not (helm-window))) + (with-helm-window + (when helm-allow-mouse + (helm--mouse-reset-selection-help-echo)) + (helm-log-run-hook "helm-move-selection-common" + 'helm-move-selection-before-hook) + (funcall move-func) + (and (memq direction '(next previous)) + (helm-skip-noncandidate-line direction)) + (when (helm-pos-multiline-p) + (helm-move--beginning-of-multiline-candidate)) + (helm-display-source-at-screen-top-maybe where) + (helm-mark-current-line) + (when follow + (helm-follow-execute-persistent-action-maybe)) + (helm-display-mode-line (setq source (helm-get-current-source))) + (helm-log-run-hook "helm-move-selection-common" + 'helm-move-selection-after-hook) + (helm--set-minibuffer-completion-confirm source))))) + +(defun helm-move--beginning-of-multiline-candidate () + (let ((header-pos (helm-get-previous-header-pos)) + (separator-pos (helm-get-previous-candidate-separator-pos))) + (when header-pos + (goto-char (if (or (null separator-pos) + (< separator-pos header-pos)) + header-pos + separator-pos)) + (forward-line 1)))) + +(defun helm-move--previous-multi-line-fn () + (forward-line -1) + (unless (helm-pos-header-line-p) + (helm-skip-header-and-separator-line 'previous) + (helm-move--beginning-of-multiline-candidate))) + +(defun helm-move--previous-line-fn () + (if (not (helm-pos-multiline-p)) + (forward-line -1) + (helm-move--previous-multi-line-fn)) + (when (and helm-move-to-line-cycle-in-source + (helm-pos-header-line-p)) + (forward-line 1) + (helm-move--end-of-source) + ;; We are at end of helm-buffer + ;; check if last candidate is a multiline candidate + ;; and jump to it + (when (and (eobp) + (save-excursion (forward-line -1) (helm-pos-multiline-p))) + (helm-move--previous-multi-line-fn)))) + +(defun helm-move--next-multi-line-fn () + (let ((header-pos (helm-get-next-header-pos)) + (separator-pos (helm-get-next-candidate-separator-pos))) + (cond ((and separator-pos + (or (null header-pos) (< separator-pos header-pos))) + (goto-char separator-pos)) + (header-pos + (goto-char header-pos))))) + +(defun helm-move--next-line-fn () + (if (not (helm-pos-multiline-p)) + (forward-line 1) + (helm-move--next-multi-line-fn)) + (when (and helm-move-to-line-cycle-in-source + (or (save-excursion (and (helm-pos-multiline-p) + (goto-char (overlay-end + helm-selection-overlay)) + (helm-end-of-source-p t))) + (helm-end-of-source-p t))) + (helm-move--beginning-of-source) + (helm-display-source-at-screen-top-maybe 'source))) + +(defun helm-move--previous-page-fn () + (condition-case nil + (scroll-down helm-scroll-amount) + (beginning-of-buffer (goto-char (point-min))))) + +(defun helm-move--next-page-fn () + (condition-case nil + (scroll-up helm-scroll-amount) + (end-of-buffer (goto-char (point-max))))) + +(defun helm-move--beginning-of-buffer-fn () + (goto-char (point-min))) + +(defun helm-move--end-of-buffer-fn () + (goto-char (point-max))) + +(defun helm-move--end-of-source () + (helm-aif (helm-get-next-header-pos) + (progn (goto-char it) (forward-line -2)) + (goto-char (point-max)))) + +(defun helm-move--beginning-of-source () + (helm-aif (helm-get-previous-header-pos) + (progn (goto-char it) + (forward-line 1)) + (goto-char (point-min)))) + +(defun helm-move--previous-source-fn () + (forward-line -1) + (if (bobp) + (goto-char (point-max)) + (helm-skip-header-and-separator-line 'previous)) + (goto-char (helm-get-previous-header-pos)) + (forward-line 1)) + +(defun helm-move--next-source-fn () + (goto-char (or (and (not (save-excursion + (forward-line 1) (eobp))) + ;; Empty source at eob are just + ;; not displayed unless they are dummy. + ;; Bug#1117. + (helm-get-next-header-pos)) + (point-min)))) + +(defun helm-move--goto-source-fn (source-or-name) + (goto-char (point-min)) + (let ((name (if (stringp source-or-name) + source-or-name + (assoc-default 'name source-or-name)))) + (if (or (null name) (string= name "")) + (forward-line 1) + (condition-case err + (while (not (string= name (helm-current-line-contents))) + (goto-char (helm-get-next-header-pos))) + (error (helm-log "helm-move--goto-source-fn" "%S" err)))))) + +(defun helm-candidate-number-at-point () + (if helm-alive-p + (with-helm-buffer + (or (get-text-property (point) 'helm-cand-num) 1)) + (or (get-text-property (point) 'helm-cand-num) 1))) + +(defun helm--next-or-previous-line (direction &optional arg) + ;; Be sure to not use this in non--interactives calls. + (let ((helm-move-to-line-cycle-in-source + (and helm-move-to-line-cycle-in-source arg))) + (if (and arg (> arg 1)) + (cl-loop with pos = (helm-candidate-number-at-point) + with cand-num = (helm-get-candidate-number t) + with iter = (min arg (if (eq direction 'next) + (- cand-num pos) + (min arg (1- pos)))) + for count from 1 + while (<= count iter) + do + (helm-move-selection-common :where 'line :direction direction)) + (helm-move-selection-common :where 'line :direction direction)))) + +(defun helm-previous-line (&optional arg) + "Move selection to the ARG previous line(s). +Same behavior as `helm-next-line' when called with a numeric +prefix arg." + (interactive "p") + (with-helm-alive-p + (helm--next-or-previous-line 'previous arg))) +(put 'helm-previous-line 'helm-only t) + +(defun helm-next-line (&optional arg) + "Move selection to the next ARG line(s). +When numeric prefix arg is > than the number of candidates, then +move to the last candidate of current source (i.e. don't move to +next source)." + (interactive "p") + (with-helm-alive-p + (helm--next-or-previous-line 'next arg))) +(put 'helm-next-line 'helm-only t) + +(defun helm-scroll-up () + "Scroll up helm-buffer by `helm-scroll-amount' lines." + (interactive) + (with-helm-alive-p + (helm-move-selection-common :where 'page :direction 'previous))) +(put 'helm-scroll-up 'helm-only t) + +(defun helm-previous-page () + "Move selection back with a pageful." + (interactive) + (with-helm-alive-p + (let (helm-scroll-amount) + (helm-move-selection-common :where 'page :direction 'previous)))) +(put 'helm-previous-page 'helm-only t) + +(defun helm-scroll-down () + "Scroll down helm-buffer by `helm-scroll-amount' lines." + (interactive) + (with-helm-alive-p + (helm-move-selection-common :where 'page :direction 'next))) +(put 'helm-scroll-down 'helm-only t) + +(defun helm-next-page () + "Move selection forward with a pageful." + (interactive) + (with-helm-alive-p + (let (helm-scroll-amount) + (helm-move-selection-common :where 'page :direction 'next)))) +(put 'helm-next-page 'helm-only t) + +(defun helm-beginning-of-buffer () + "Move selection at the top." + (interactive) + (with-helm-alive-p + (helm-move-selection-common :where 'edge :direction 'previous))) +(put 'helm-beginning-of-buffer 'helm-only t) + +(defun helm-end-of-buffer () + "Move selection at the bottom." + (interactive) + (with-helm-alive-p + (helm-move-selection-common :where 'edge :direction 'next))) +(put 'helm-end-of-buffer 'helm-only t) + +(defun helm-previous-source () + "Move selection to the previous source." + (interactive) + (with-helm-alive-p + (helm-move-selection-common :where 'source :direction 'previous))) +(put 'helm-previous-source 'helm-only t) + +(defun helm-next-source () + "Move selection to the next source." + (interactive) + (with-helm-alive-p + (helm-move-selection-common :where 'source :direction 'next))) +(put 'helm-next-source 'helm-only t) + +(defun helm-goto-source (&optional source-or-name) + "Move the selection to the source named SOURCE-OR-NAME. + +If SOURCE-OR-NAME is empty string or nil go to the first +candidate of first source." + (helm-move-selection-common :where 'source :direction source-or-name)) + +(defvar helm-follow-action-white-list-commands + '(helm-ff-decrease-image-size-persistent + helm-ff-increase-image-size-persistent + helm-ff-rotate-left-persistent + helm-ff-rotate-right-persistent) + "Allow `helm-follow-action-forward/backward' switching to next file +when one of these commands is the `last-command'. + +For example when browsing files with `C-` and rotate the current file, +hitting `C-` again will not switch to next file but kill its buffer.") + +(defun helm--follow-action (arg) + (let ((helm--temp-follow-flag t) ; Needed in HFF. + (in-follow-mode (helm-follow-mode-p))) + ;; When follow-mode is already enabled, just go to next or + ;; previous line. + (when (or (eq last-command 'helm-follow-action-forward) + (eq last-command 'helm-follow-action-backward) + (eq last-command 'helm-execute-persistent-action) + (memq last-command helm-follow-action-white-list-commands) + in-follow-mode) + (if (> arg 0) + (helm-move-selection-common :where 'line + :direction 'next + :follow nil) + (helm-move-selection-common :where 'line + :direction 'previous + :follow nil))) + (unless in-follow-mode + (helm-execute-persistent-action)))) + +(defun helm-follow-action-forward () + "Go to next line and execute persistent action." + (interactive) + (with-helm-alive-p (helm--follow-action 1))) +(put 'helm-follow-action-forward 'helm-only t) + +(defun helm-follow-action-backward () + "Go to previous line and execute persistent action." + (interactive) + (with-helm-alive-p (helm--follow-action -1))) +(put 'helm-follow-action-backward 'helm-only t) + +(defun helm-mark-current-line (&optional resumep nomouse) + "Move `helm-selection-overlay' to current line. +When RESUMEP is non nil move overlay to `helm-selection-point'. +When NOMOUSE is specified do not set mouse bindings. + +Note that selection is unrelated to visible marks used for +marking candidates." + (with-helm-buffer + (when resumep + (goto-char helm-selection-point)) + (move-overlay + helm-selection-overlay (pos-bol) + (if (helm-pos-multiline-p) + (let ((header-pos (helm-get-next-header-pos)) + (separator-pos (helm-get-next-candidate-separator-pos))) + (or (and (null header-pos) separator-pos) + (and header-pos separator-pos + (< separator-pos header-pos) + separator-pos) + header-pos + (point-max))) + (1+ (pos-eol)))) + (setq helm-selection-point (overlay-start helm-selection-overlay)) + (when (and helm-allow-mouse (null nomouse) (not resumep)) + (helm--bind-mouse-for-selection helm-selection-point)))) + +(defun helm-confirm-and-exit-minibuffer () + "Maybe ask for confirmation when exiting helm. +It is similar to `minibuffer-complete-and-exit' adapted to Helm. +If `minibuffer-completion-confirm' value is \\='confirm, send +minibuffer confirm message and exit on next hit. If +`minibuffer-completion-confirm' value is t, don't exit and send +message \\='no match'." + (interactive) + (with-helm-alive-p + (if (and (helm--updating-p) + (null helm--reading-passwd-or-string)) + (progn (message "[Display not ready]") + (sit-for 0.5) (message nil) + (helm-update)) + (let* ((src (helm-get-current-source)) + (empty-buffer-p (with-current-buffer helm-buffer + (eq (point-min) (point-max)))) + (unknown (and (not empty-buffer-p) + ;; Now such candidates have a helm-new-file or an + ;; unknown text property (we were testing if string + ;; match [?] previously). + (helm-candidate-prefixed-p + (helm-get-selection nil 'withprop src))))) + (cond ((and (or empty-buffer-p unknown) + (memq minibuffer-completion-confirm + '(confirm confirm-after-completion))) + (setq helm-minibuffer-confirm-state + 'confirm) + (setq minibuffer-completion-confirm nil) + (minibuffer-message " [confirm]")) + ;; 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. + ;; When `minibuffer-completion-confirm' is set to 'noexit or + ;; 'exit, that's mean MUST-MATCH is a function and we use its + ;; return value to set `minibuffer-completion-confirm', this is + ;; done in `helm--set-minibuffer-completion-confirm'. + ((or (eq minibuffer-completion-confirm 'noexit) + (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))))))) +(put 'helm-confirm-and-exit-minibuffer 'helm-only t) + +(defun helm-confirm-and-exit-hook () + "Restore `minibuffer-completion-confirm' when helm update." + (unless (or (eq minibuffer-completion-confirm t) + (not helm-minibuffer-confirm-state)) + (setq minibuffer-completion-confirm + helm-minibuffer-confirm-state))) +(add-hook 'helm-after-update-hook 'helm-confirm-and-exit-hook) + +(defun helm--set-minibuffer-completion-confirm (src) + "Return the value of a REQUIRE-MATCH arg in a `completing-read'." + ;; Set `minibuffer-completion-confirm' to 'noexit,'exit or 'confirm according + ;; to MUST-MATCH value (possibly a function). + (with-helm-buffer + (setq minibuffer-completion-confirm + (helm-acase (helm-get-attr 'must-match src) + ((guard* (and (functionp it) + (helm-get-selection nil nil src))) + (helm-acase (funcall it guard) + ;; Alow using 'confirm as the output of a REQUIRE-MATCH fn even + ;; if this feature is not available in Emacs. + ((confirm confirm-after-completion) it) + ((guard* (eq nil it)) 'noexit) + (t 'exit))) + (t it))))) + +(defun helm-read-string (prompt &optional initial-input history + default-value inherit-input-method) + "Same as `read-string' but for reading string from a helm session." + (let ((helm--reading-passwd-or-string t)) + (read-string + prompt initial-input history default-value inherit-input-method))) + +(defun helm--updating-p () + ;; helm timer is between two cycles. + ;; IOW `helm-check-minibuffer-input' hasn't yet compared input + ;; and `helm-pattern'. + (or (not (equal (minibuffer-contents) helm-pattern)) + ;; `helm-check-minibuffer-input' has launched `helm-update'. + helm--in-update)) + +(defun helm-maybe-exit-minibuffer () + (interactive) + (with-helm-alive-p + (if (and (helm--updating-p) + (null helm--reading-passwd-or-string)) + (progn + (message "[Display not ready]") + (sit-for 0.5) (message nil) + (helm-update)) + (helm-exit-minibuffer)))) +(put 'helm-maybe-exit-minibuffer 'helm-only t) + +(defun helm-exit-minibuffer () + "Select the current candidate by exiting the minibuffer." + (unless helm-current-prefix-arg + (setq helm-current-prefix-arg current-prefix-arg)) + (setq helm-exit-status 0) + (helm-log-run-hook "helm-exit-minibuffer" + 'helm-exit-minibuffer-hook) + (exit-minibuffer)) + +(defun helm-keyboard-quit () + "Quit minibuffer in helm. +If action buffer is displayed, kill it." + (interactive) + (with-helm-alive-p + (when (get-buffer-window helm-action-buffer 'visible) + (kill-buffer helm-action-buffer)) + (setq helm-exit-status 1) + (abort-recursive-edit))) +(put 'helm-keyboard-quit 'helm-only t) + +(defun helm-get-next-header-pos () + "Return the position of the next header from point." + (next-single-property-change (point) 'helm-header)) + +(defun helm-get-previous-header-pos () + "Return the position of the previous header from point." + (previous-single-property-change (point) 'helm-header)) + +(defun helm-pos-multiline-p () + "Return non-`nil' if the current position is in the multiline source region." + (get-text-property (point) 'helm-multiline)) + +(defun helm-get-next-candidate-separator-pos () + "Return the position of the next candidate separator from point." + (let ((hp (helm-get-next-header-pos))) + (helm-aif (next-single-property-change (point) 'helm-candidate-separator) + (or + ;; Be sure we don't catch + ;; the separator of next source. + (and hp (< it hp) it) + ;; The separator found is in next source + ;; we are at last cand, so use the header pos. + (and hp (< hp it) hp) + ;; A single source, just try next separator. + it)))) + +(defun helm-get-previous-candidate-separator-pos () + "Return the position of the previous candidate separator from point." + (previous-single-property-change (point) 'helm-candidate-separator)) + +(defun helm-pos-header-line-p () + "Return t if the current line is a header line." + (or (get-text-property (pos-bol) 'helm-header) + (get-text-property (pos-bol) 'helm-header-separator))) + +(defun helm-pos-candidate-separator-p () + "Return t if the current line is a candidate separator." + (get-text-property (pos-bol) 'helm-candidate-separator)) + + +;;; Debugging +;; +;; +(defun helm-debug-output () + "Show all Helm locals variables and output of `helm-debug-function'." + (interactive) + (with-helm-alive-p + (helm-help-internal helm-debug-output-buffer 'helm-debug-output-function))) +(put 'helm-debug-output 'helm-only t) + +(defun helm-default-debug-function () + "Collect sources of helm current session. +This is the default function for `helm-debug-function'." + (with-helm-buffer helm-sources)) + +(defun helm-debug-output-function () + (let ((local-vars (buffer-local-variables (get-buffer helm-buffer))) + (count 1)) + (insert (format "* Helm debug from `%s' buffer\n\n" helm-buffer)) + (insert "** Helm local variables\n\n#+begin_src elisp\n" + (pp-to-string (remove (assq 'helm-sources local-vars) local-vars)) + "\n#+end_src\n") + (insert "** Minibuffer local variables\n\n#+begin_src elisp\n" + (pp-to-string (with-selected-window (minibuffer-window) + (buffer-local-variables))) + "\n#+end_src\n") + (dolist-with-progress-reporter (v (helm-interpret-value helm-debug-function)) + "Calculating all helm-related values..." + (insert (format "** Source%s value\n" count) + "#+begin_src elisp\n" (pp-to-string v) "\n#+end_src\n") + (cl-incf count)))) + +(defun helm-enable-or-switch-to-debug () + "First hit enable helm debugging, second hit switch to debug buffer." + (interactive) + (with-helm-alive-p + (if helm-debug + (helm-run-after-exit + #'helm-debug-open-last-log) + (setq helm-debug t) + (with-helm-buffer (setq truncate-lines nil)) + (message "Debugging enabled")))) +(put 'helm-enable-or-switch-to-debug 'helm-only t) + + +;; Misc + +(defun helm-preselect (candidate-or-regexp &optional source) + "Move selection to CANDIDATE-OR-REGEXP. + +CANDIDATE-OR-REGEXP can be a: + +- String +- Cons cell of two strings +- Nullary function, which moves to a candidate + +When CANDIDATE-OR-REGEXP is a cons cell, tries moving to first +element of the cons cell, then the second, and so on. This +allows selection of duplicate candidates after the first. + +When SOURCE is specified, move to it and search +CANDIDATE-OR-REGEXP from there." + (with-helm-buffer + (when candidate-or-regexp + (if source + (progn (helm-goto-source source) (forward-line 1)) + (goto-char (point-min)) + (forward-line 1)) + (if (functionp candidate-or-regexp) + (funcall candidate-or-regexp) + (let ((start (point)) mp) + (helm-awhile (if (consp candidate-or-regexp) + (and (re-search-forward (car candidate-or-regexp) nil t) + (re-search-forward (cdr candidate-or-regexp) nil t)) + (re-search-forward candidate-or-regexp nil t)) + ;; If search fall on an header line continue loop + ;; until it match or fail (Bug#1509). + (unless (helm-pos-header-line-p) (cl-return (setq mp it)))) + (goto-char (or mp start))))) + (forward-line 0) ; Avoid scrolling right on long lines. + (when (helm-pos-multiline-p) + (helm-move--beginning-of-multiline-candidate)) + (when (helm-pos-header-line-p) (forward-line 1)) + (when helm-allow-mouse + (helm--mouse-reset-selection-help-echo)) + (helm-mark-current-line) + (when helm--deleting-minibuffer-contents-from (recenter)) + (helm-display-mode-line (or source (helm-get-current-source))) + (helm-log-run-hook "helm-preselect" 'helm-after-preselection-hook))) + +(defun helm-delete-current-selection () + "Delete the currently selected item." + (with-helm-window + (cond ((helm-pos-multiline-p) + (helm-aif (helm-get-next-candidate-separator-pos) + (delete-region (pos-bol) + (1+ (progn (goto-char it) (pos-eol)))) + ;; last candidate + (goto-char (helm-get-previous-candidate-separator-pos)) + (delete-region (pos-bol) (point-max))) + (when (helm-end-of-source-p) + (goto-char (or (helm-get-previous-candidate-separator-pos) + (point-min))) + (forward-line 1))) + (t + (delete-region (pos-bol) (1+ (pos-eol))) + (when (helm-end-of-source-p t) + (let ((headp (save-excursion + (forward-line -1) + (not (helm-pos-header-line-p))))) + (and headp (forward-line -1)))))) + (unless (helm-end-of-source-p t) + (helm-mark-current-line)))) + +(defun helm-end-of-source-1 (n at-point) + (save-excursion + (if (and (helm-pos-multiline-p) (null at-point)) + (null (helm-get-next-candidate-separator-pos)) + (forward-line (if at-point 0 n)) + (or (eq (pos-bol) (pos-eol)) + (helm-pos-header-line-p) + (if (< n 0) (bobp) (eobp)))))) + +(defun helm-end-of-source-p (&optional at-point) + "Return non-nil if we are at EOB or end of source." + (helm-end-of-source-1 1 at-point)) + +(defun helm-beginning-of-source-p (&optional at-point) + "Return non-nil if we are at BOB or beginning of source." + (helm-end-of-source-1 -1 at-point)) + +(defun helm--edit-current-selection-internal (func) + (with-helm-window + (forward-line 0) + (let ((realvalue (get-text-property (point) 'helm-realvalue)) + (multiline (get-text-property (point) 'helm-multiline))) + (funcall func) + (forward-line 0) + (and realvalue + (put-text-property (point) (pos-eol) + 'helm-realvalue realvalue)) + (and multiline + (put-text-property (point) + (or (helm-get-next-candidate-separator-pos) + (point-max)) + 'helm-multiline multiline)) + (helm-mark-current-line)))) + +(defmacro helm-edit-current-selection (&rest forms) + "Evaluate FORMS at current selection in the helm buffer. +Used generally to modify current selection." + (declare (indent 0) (debug t)) + `(helm--edit-current-selection-internal + (lambda () ,@forms))) + +(defun helm--delete-minibuffer-contents-from (from-str &optional presel) + ;; Giving an empty string value to FROM-STR delete all. + (let ((input (minibuffer-contents)) + (src (and presel (helm-get-current-source))) + (helm--deleting-minibuffer-contents-from presel) + helm-move-to-line-cycle-in-source) + (helm-reset-yank-point) + (unless (zerop (length input)) + ;; minibuffer is not empty, delete contents from end + ;; or FROM-STR and update. + (helm-set-pattern from-str t) + (setq helm-input from-str) ; Needed by helm-fuzzy-matching-highlight-fn. + (helm-update presel src)))) + +(defun helm-delete-minibuffer-contents (&optional arg) + "Delete minibuffer contents. +When `helm-delete-minibuffer-contents-from-point' is non-nil, delete +minibuffer contents from point instead of deleting all. When at the end +of minibuffer, delete all but if a prefix ARG were given also preselect +current selection when updating if possible (selection may be beyond +candidate-number-limit, or display may have completely changed e.g. HFF)." + (interactive "P") + (with-helm-alive-p + (let ((str (if (or (eobp) (not helm-delete-minibuffer-contents-from-point)) + "" (helm-minibuffer-completion-contents))) + (presel (and arg + (concat "^" (regexp-quote (helm-get-selection nil t)) "$")))) + (helm--delete-minibuffer-contents-from str presel)))) +(put 'helm-delete-minibuffer-contents 'no-helm-mx t) + + +;;; helm-source-in-buffer. +;; +(defun helm-candidates-in-buffer (&optional source) + "The top level function used to store candidates with `helm-source-in-buffer'. + +Candidates are stored in a buffer generated internally by +`helm-candidate-buffer' function. Each candidate must be placed +in one line. + +The buffer is created and fed in the init attribute function of +Helm. + +E.g.: + + (helm-build-in-buffer-source \"test\" + :init (lambda () + (helm-init-candidates-in-buffer + \\='global \\='(foo foa fob bar baz)))) + +A shortcut can be used to simplify: + + (helm-build-in-buffer-source \"test\" + :data \\='(foo foa fob bar baz)) + +By default, Helm makes candidates by evaluating the candidates +function, then narrows them by `string-match' for each candidate. + +But this is slow for large number of candidates. The new way is +to store all candidates in a buffer and then narrow with +`re-search-forward'. Search function is customizable by search +attribute. The important point is that buffer processing is MUCH +FASTER than string list processing and is the Emacs way. + +The init function writes all candidates to a newly-created +candidate buffer. The candidates buffer is created or specified +by `helm-candidate-buffer'. Candidates are stored in a line. + +The candidates function narrows all candidates, IOW creates a +subset of candidates dynamically. + +Class `helm-source-in-buffer' is implemented with three attributes: + + (candidates . helm-candidates-in-buffer) + (volatile) + (match identity) + +The volatile attribute is needed because +`helm-candidates-in-buffer' creates candidates dynamically and +need to be called every time `helm-pattern' changes. + +Because `helm-candidates-in-buffer' plays the role of `match' +attribute function, specifying `(match identity)' makes the +source slightly faster. + +However if source contains `match-part' attribute, match is +computed only on part of candidate returned by the call of +function provided by this attribute. The function should have one +arg, candidate, and return only a specific part of candidate. + +To customize `helm-candidates-in-buffer' behaviour, use `search', +`get-line' and `match-part' attributes." + (let ((src (or source (helm-get-current-source)))) + (helm-candidates-in-buffer-1 + (helm-candidate-buffer) + helm-pattern + (or (assoc-default 'get-line src) + #'buffer-substring-no-properties) + (or (assoc-default 'search src) + '(helm-candidates-in-buffer-search-default-fn)) + ;; When candidate-transformer is specified in source ALL candidates should + ;; be computed with the candidate-transformer function (in contrast with + ;; filtered-candidate-transformer). This to be consistent with what sync + ;; sources do. The car of the cons is used for initial fetching of + ;; candidates whereas the cdr is used after when searching (in this case + ;; the candidate number limit is used). + (if (helm-get-attr 'candidate-transformer src) + (cons 99999999 (helm-candidate-number-limit src)) + (helm-candidate-number-limit src)) + (helm-get-attr 'match-part) + src))) + +(defun helm-candidates-in-buffer-search-default-fn (pattern) + "Search PATTERN with `re-search-forward' with bound and noerror args." + (condition-case _err + ;; Use helm-re-search-forward to avoid infloop (bug#2657). + (helm-re-search-forward pattern nil t) + (invalid-regexp nil))) + +(defun helm-candidates-in-buffer-1 (buffer pattern get-line-fn + search-fns limit + match-part-fn source) + "Return the list of candidates inserted in BUFFER matching PATTERN." + (with-suppressed-warnings ((obsolete inhibit-point-motion-hooks)) + ;; buffer == nil when candidates buffer does not exist. + (when buffer + (with-current-buffer buffer + (let ((inhibit-point-motion-hooks t) + (start-point (1- (point-min)))) + (goto-char start-point) + (if (string= pattern "") + (helm-initial-candidates-from-candidate-buffer + get-line-fn (if (consp limit) (car limit) limit)) + (helm-search-from-candidate-buffer + pattern get-line-fn search-fns + (if (consp limit) (cdr limit) limit) + start-point match-part-fn source))))))) + + +(defun helm-search-from-candidate-buffer (pattern get-line-fn search-fns + limit start-point match-part-fn source) + (let ((inhibit-read-only t) + (diacritics (assoc-default 'diacritics source))) + (helm--search-from-candidate-buffer-1 + (lambda () + (cl-loop with hash = (make-hash-table :test 'equal) + with allow-dups = (assq 'allow-dups source) + with case-fold-search = (helm-set-case-fold-search) + with count = 0 + for iter from 1 + for searcher in search-fns + do (progn + (goto-char start-point) + ;; The character at start-point is a newline, + ;; if pattern match it that's mean we are + ;; searching for newline in buffer, in this + ;; case skip this false line. + ;; See comment >>>[1] in + ;; `helm--search-from-candidate-buffer-1'. + (and (condition-case nil + (looking-at pattern) + (invalid-regexp nil)) + (forward-line 1))) + nconc + (cl-loop with pos-lst + ;; POS-LST is used as a flag to decide if we + ;; run `helm-search-match-part' even if + ;; MATCH-PART isn't specified on source. This + ;; happen when fuzzy matching or using a + ;; negation (!) in one of the patterns, in + ;; these case the searcher returns a list + ;; '(BEG END) instead of an integer like + ;; `re-search-forward'. + while (and (setq pos-lst (funcall searcher pattern)) + ;; We were previously forwarding line from + ;; searcher and checking then for eobp, as a + ;; result the last candidate was always + ;; skipped. See bug#2650. + (if (consp pos-lst) + ;; With negation the searcher is not + ;; forwarding line, we do it from here. + ;; If forward-line doesn't return zero, + ;; we are at eob. + (zerop (forward-line 1)) + (not (eobp))) + (< count limit)) + for cand = (apply get-line-fn + (if (and pos-lst (listp pos-lst)) + pos-lst + (list (pos-bol) (pos-eol)))) + when (and match-part-fn + (not (get-text-property 0 'match-part cand))) + do (setq cand + (propertize cand 'match-part (funcall match-part-fn cand))) + for dup = (gethash cand hash) + when (and (or (and allow-dups dup (= dup iter)) + (null dup)) + ;; Happens with (buffer-substring 1 1) when + ;; setting cand above (bug#2651) and create a + ;; ghost candidate on top. + (not (string= cand "")) + (or + ;; Always collect when cand is matched + ;; by searcher funcs and match-part attr + ;; is not present. + (and (not match-part-fn) + (not (consp pos-lst))) + ;; If match-part attr is present, or if SEARCHER fn + ;; returns a cons cell, collect PATTERN only if it + ;; matches the part of CAND specified by + ;; the match-part func. + (helm-search-match-part cand pattern diacritics))) + do (progn + (puthash cand iter hash) + (setq cand (helm--maybe-process-filter-one-by-one-candidate + cand source)) + (cl-incf count)) + and collect cand)))))) + +(defun helm-search-match-part (candidate pattern diacritics) + "Match PATTERN only on match-part property value of CANDIDATE. + +Because `helm-search-match-part' may be called even if +unspecified in source (negation or fuzzy), the part to match +falls back to the whole candidate even if match-part hasn't been +computed by match-part-fn and stored in the match-part property." + (let ((part (or (get-text-property 0 'match-part candidate) + candidate)) + (fuzzy-regexp (cadr (gethash 'helm-pattern helm--fuzzy-regexp-cache))) + (matchfn (cond (helm-migemo-mode 'helm-mm-migemo-string-match) + (diacritics 'helm-mm-diacritics-string-match) + (t 'string-match)))) + (condition-case _err + (if (string-match " " pattern) + ;; FIXME use helm-mm-3-match here. + (cl-loop for i in (helm-mm-split-pattern pattern) always + (if (string-match "\\`!" i) + (not (funcall matchfn (substring i 1) part)) + (funcall matchfn i part))) + ;; A pattern with no spaces that starts with "!". + (if (string-match "\\`!" pattern) + (if helm--in-fuzzy + ;; Fuzzy regexp have already been + ;; computed with substring 1 i.e. the leading "!" has been + ;; removed. + (not (string-match fuzzy-regexp part)) + (not (funcall matchfn (substring pattern 1) part))) + (funcall matchfn (if helm--in-fuzzy fuzzy-regexp pattern) part))) + (invalid-regexp nil)))) + +(defun helm-initial-candidates-from-candidate-buffer (get-line-fn limit) + (cl-loop repeat limit + until (eobp) + for line = (funcall get-line-fn (pos-bol) (pos-eol)) + when line collect line + do (forward-line 1))) + +(defun helm--search-from-candidate-buffer-1 (search-fn) + ;; We are adding a newline at bob and at eol + ;; and removing these newlines afterward. + ;; This is a bad hack that should be removed. + ;; To avoid matching the empty line at first line + ;; when searching with e.g occur and "^$" just + ;; forward-line before searching (See >>>[1] above). + (goto-char (point-min)) + (insert "\n") + (goto-char (point-max)) + (insert "\n") + (unwind-protect + (funcall search-fn) + (goto-char (point-min)) + (delete-char 1) + (goto-char (1- (point-max))) + (delete-char 1) + (set-buffer-modified-p nil))) + +(defun helm-candidate-buffer (&optional buffer-spec) + "Register and return a buffer storing candidates of current source. + +This is used to initialize a buffer for storing candidates for a +candidates-in-buffer source, candidates will be searched in this +buffer and displayed in `helm-buffer'. This should be used only +in init functions, don't relay on this in other places unless you +know what you are doing. + +This function is still in public API only for backward +compatibility, you should use instead +`helm-init-candidates-in-buffer' for initializing your sources. + +Internally, this function is called without argument and returns +the buffer corresponding to current source i.e. +`helm--source-name' which is available in only some places. + +Acceptable values of BUFFER-SPEC: + +- global (a symbol) + Create a new global candidates buffer, + named \" *helm candidates:SOURCE*\". + This is used by `helm-init-candidates-in-buffer' and it is + the most common usage of BUFFER-SPEC. + The buffer will be killed and recreated at each new + helm-session. + +- local (a symbol) + Create a new local candidates buffer, + named \" *helm candidates:SOURCE*HELM-CURRENT-BUFFER\". + You may want to use this when you want to have a different + buffer each time source is used from a different + `helm-current-buffer'. + The buffer is erased and refilled at each new session but not + killed. You probably don't want to use this value for + BUFFER-SPEC. + +- nil (omit) + Only return the candidates buffer of current source if found. + +- A buffer + Register a buffer as a candidates buffer. + The buffer needs to exists, it is not created. + This allow you to use the buffer as a cache, it is faster + because the buffer is already drawn, but be careful when using + this as you may mangle your buffer depending on what you write + in your init(s) function, IOW don't modify the contents of the + buffer in init(s) function but in a transformer. + The buffer is not erased nor deleted. + Generally it is safer to use a copy of buffer inserted + in a global or local buffer. + +If for some reasons a global buffer and a local buffer exist and +are belonging to the same source, the local buffer takes +precedence on the global one and is used instead. + +When forcing update only the global and local buffers are killed +before running again the init function." + (let ((global-bname (format " *helm candidates:%s*" + helm--source-name)) + (local-bname (format " *helm candidates:%s*%s" + helm--source-name + (buffer-name helm-current-buffer)))) + (when buffer-spec + ;; Register buffer in `helm--candidate-buffer-alist'. + ;; This is used only to retrieve buffer associated to current source + ;; when using named buffer as value of BUFFER-SPEC. + (setq helm--candidate-buffer-alist + (cons (cons helm--source-name buffer-spec) + (delete (assoc helm--source-name + helm--candidate-buffer-alist) + helm--candidate-buffer-alist))) + ;; When using global or local as value of BUFFER-SPEC + ;; create the buffer global-bname or local-bname, otherwise + ;; reuse the buffer named BUFFER-SPEC. + (unless (bufferp buffer-spec) + ;; Global buffers are killed and recreated. + (and (eq buffer-spec 'global) + (buffer-live-p (get-buffer global-bname)) + (kill-buffer global-bname)) + ;; Create global or local buffer. + ;; Local buffer, once created are reused and a new one + ;; is created when `helm-current-buffer' change across sessions. + (with-current-buffer (get-buffer-create + (helm-acase buffer-spec + (global global-bname) + (local local-bname) + (t (and (stringp buffer-spec) + buffer-spec)))) + ;; We need a buffer not read-only to perhaps insert later + ;; text coming from read-only buffers (Bug#1176). + (set (make-local-variable 'buffer-read-only) nil) + ;; Undo is automatically disabled in buffer names starting + ;; with a space, so no need to disable it. + (erase-buffer) + (font-lock-mode -1)))) + ;; Finally return the candidates buffer. + (helm-acond ((get-buffer local-bname)) + ((get-buffer global-bname)) + ((assoc-default helm--source-name helm--candidate-buffer-alist) + (and (or (stringp it) (bufferp it)) + (buffer-live-p (get-buffer it)) + it))))) + +(defvar helm-candidate-buffer-longest-len 0 + "May store the longest length of candidates in a in-buffer source. +It is a local variable set from `helm-init-candidates-in-buffer' in +`helm-candidate-buffer'. +Allow getting the longest length of initial candidates in transformers +without looping again through the whole list. +It is useful to align extra informations after candidates in `helm-buffer'.") + +(defsubst helm-in-buffer-get-longest-candidate () + "Return the longest candidate recorded in `helm-candidate-buffer'." + (helm-aif (helm-candidate-buffer) + (buffer-local-value + 'helm-candidate-buffer-longest-len + (get-buffer it)) + 0)) + +(defun helm-make-separator (cand &optional longest) + "Create a separator to align candidates. +Longest candidate should have been calculated at initialization +of `helm-source-in-buffer' by `helm-init-candidates-in-buffer' , otherwise +LONGEST can be used to specify longest candidate." + (let ((lgst (or longest (helm-in-buffer-get-longest-candidate))) + (len (length cand))) + (if (zerop lgst) + " -- " ; For emacs style. + (make-string (1+ (if (>= lgst len) + (- lgst len) + 0)) + ? )))) + +(defun helm-init-candidates-in-buffer (buffer-spec data &optional force-longest) + "Register BUFFER-SPEC with DATA for a helm candidates-in-buffer session. + +Arg BUFFER-SPEC can be a `buffer-name' (stringp), a buffer-spec +object (bufferp), or a symbol, either \\='local or \\='global which is +passed to `helm-candidate-buffer'. +The most common usage of BUFFER-SPEC is \\='global. + +Arg DATA can be either a list or a plain string. +Returns the resulting buffer. + +Use this in your init function to register a buffer for a +`helm-source-in-buffer' session and feed it with DATA. You +probably don't want to bother with this and use the :data slot +when initializing a source with `helm-source-in-buffer' class. + +When inserting DATA in `helm-candidate-buffer', if DATA is a list the longest +candidate will be recorded in `helm-candidate-buffer-longest-len' local +variable. If DATA is a string, it is inserted directly in +`helm-candidate-buffer' and `helm-candidate-buffer-longest-len' is not computed +unless FORCE-LONGEST is non nil." + (declare (indent 1)) + (let ((caching (and (or (stringp buffer-spec) + (bufferp buffer-spec)) + (buffer-live-p (get-buffer buffer-spec)))) + (buf (helm-candidate-buffer buffer-spec))) + (unless caching + (with-current-buffer buf + (erase-buffer) + (cond ((listp data) + (insert (mapconcat (lambda (elm) + (let ((cand + (helm-acase elm + ((guard* (symbolp it)) + (symbol-name it)) + ((guard* (numberp it)) + (number-to-string it)) + ((dst* (disp . real)) + (propertize disp 'helm-realvalue real)) + (t it)))) + (setq-local helm-candidate-buffer-longest-len + (max helm-candidate-buffer-longest-len + (length cand))) + cand)) + data "\n"))) + ((stringp data) + (insert data) + (when force-longest + (setq-local helm-candidate-buffer-longest-len + (helm--get-longest-len-in-buffer)))))) + buf))) + +(defun helm--get-longest-len-in-buffer () + "Return length of the longest line in buffer." + (save-excursion + (goto-char (point-min)) + (let ((max 0) + len) + (while (not (eobp)) + (setq len (- (pos-eol) (pos-bol))) + (when (> len max) + (setq max len)) + (forward-line 1)) + max))) + + +;;; Actions on helm window +;; +;; +(defvar helm--resplit-window-iterator nil) +(defun helm-resplit-window-clockwise () + "Change the window split to move Helm window clockwise w.r.t the main window. +See `helm-resplit-window-1'." + (interactive) + (helm-resplit-window-1 1)) +(put 'helm-resplit-window-clockwise 'helm-only t) + +(defun helm-resplit-window-counterclockwise () + "Change the window split to move Helm window counterclockwise. +See `helm-resplit-window-1'." + (interactive) + (helm-resplit-window-1 -1)) +(put 'helm-resplit-window-counterclockwise 'helm-only t) + +(defun helm-resplit-window-1 (arg) + "Change the window split to move Helm window. + +At each call of this function, change the window split w.r.t the main +window to left, above, right or below direction remembering your +previous movement, this when there is only two windows. Split direction +is clockwise if ARG is positive and counterclockwise if +negative. Otherwise when there is more than two windows and the helm +buffer is displayed in one of those windows i.e. `helm-always-two-windows' is +nil, the helm buffer is moved in the next or previous window according to ARG +value." + (with-helm-alive-p + (cond ((> (length (window-list nil 1)) 2) + (helm-swap-windows arg)) + ((and (= (length (window-list nil 1)) 2) + (not (window-dedicated-p + (get-buffer-window helm-current-buffer)))) + (when helm-prevent-escaping-from-minibuffer + (helm-prevent-switching-other-window :enabled nil)) + (unwind-protect + (with-helm-window + (cond ((or helm-full-frame (one-window-p t)) + (user-error "Attempt to resplit a single window")) + ((helm-action-window) + (user-error "Can't resplit while selecting actions")) + ((window-parameter + (get-buffer-window helm-current-buffer) 'window-slot) + (user-error "Can't resplit a side window")) + (t (helm--resplit-window arg)))) + (when helm-prevent-escaping-from-minibuffer + (helm-prevent-switching-other-window :enabled t)))) + (t (error "current window configuration not suitable for splitting"))))) + +(defun helm--resplit-window (arg) + (let ((current-state (helm--get-window-side-state)) + new-state) + (unless (and (eq last-command this-command) + (eq current-state helm--window-side-state)) + (setq helm--resplit-window-iterator + (helm-iter-circular (helm--resplit-window-sides + current-state arg)))) + (setq new-state (helm-iter-next helm--resplit-window-iterator) + helm-split-window-state (helm-acase new-state + ((right left) 'horizontal) + ((below above) 'vertical))) + (delete-window) + (set-window-buffer + (select-window + (split-window (selected-window) nil new-state)) + helm-buffer) + (setq helm--window-side-state (helm--get-window-side-state)))) + +(defun helm--resplit-window-sides (state arg) + (let ((clockwise (helm-acase state + (right '(below left above)) + (left '(above right below)) + (below '(left above right)) + (above '(right below left))))) + (append (if (< arg 0) (reverse clockwise) clockwise) + (list state)))) + +;; Resize helm window. +(defun helm-enlarge-window-1 (n) + "Enlarge or narrow helm window. +If N is positive enlarge, if negative narrow." + (unless helm-full-frame + (let ((horizontal-p (eq helm-split-window-state 'horizontal))) + (with-helm-window + (enlarge-window n horizontal-p))))) + +(defun helm-narrow-window () + "Narrow helm window." + (interactive) + (with-helm-alive-p + (helm-enlarge-window-1 -1))) +(put 'helm-narrow-window 'helm-only t) + +(defun helm-enlarge-window () + "Enlarge helm window." + (interactive) + (with-helm-alive-p + (helm-enlarge-window-1 1))) +(put 'helm-enlarge-window 'helm-only t) + +(defun helm-toggle-full-frame (&optional arg) + "Toggle `helm-buffer' full-frame view." + (interactive "p") + (cl-assert (null (helm-action-window)) + nil "Unable to toggle full frame from action window") + (when arg ; Called interactively + (cl-assert (null helm--buffer-in-new-frame-p) + nil "Can't toggle full frame when using helm own frame")) + (if (or helm-onewindow-p + (buffer-local-value 'helm-full-frame (get-buffer helm-buffer))) + (with-helm-window + (setq-local helm-full-frame nil) + (setq helm-onewindow-p nil) + (let ((split-window-preferred-function + helm-split-window-preferred-function)) + (switch-to-buffer helm-current-buffer) + (helm-display-buffer helm-buffer) + (select-window (minibuffer-window)))) + (with-helm-window + (delete-other-windows) + (setq-local helm-full-frame t) + (setq helm-onewindow-p t)))) +(put 'helm-toggle-full-frame 'helm-only t) + +(defun helm-swap-windows (&optional arg) + "Swap window holding `helm-buffer' with other windows. +Start swapping in the same order of windows as window-list." + (interactive "p") + (with-helm-alive-p + (cond ((and helm-full-frame (one-window-p t)) + (user-error "Can't swap windows in a single window")) + ((helm-action-window) + (user-error "Can't swap windows while selecting actions")) + ((window-parameter (get-buffer-window helm-current-buffer) 'window-slot) + (user-error "Can't swap with a side window")) + (t + (let* ((w1 (helm-window)) + (split-state (eq helm-split-window-state 'horizontal)) + (w1size (window-total-size w1 split-state)) + (b1 (window-buffer w1)) ; helm-buffer + (s1 (window-start w1)) + (cur-frame (window-frame w1)) + (w2 (with-selected-window (helm-window) + ;; Don't try to display helm-buffer + ;; in a dedicated window. + (helm--get-window-with-predicate + (lambda (w) (not (window-dedicated-p w))) + 1 cur-frame nil arg))) + (w2size (window-total-size w2 split-state)) + (b2 (window-buffer w2)) ; probably helm-current-buffer + (s2 (window-start w2)) + resize) + (with-selected-frame (window-frame w1) + (helm-replace-buffer-in-window w1 b1 b2) + (helm-replace-buffer-in-window w2 b2 b1) + (setq resize + (cond (;; helm-window is smaller than other window. + (< w1size w2size) + (- (- (max w2size w1size) + (min w2size w1size)))) + (;; helm-window is larger than other window. + (> w1size w2size) + (- (max w2size w1size) + (min w2size w1size))) + (;; windows have probably same size. + t nil))) + ;; Maybe resize the window holding helm-buffer. + (and resize (window-resize w2 resize split-state)) + (set-window-start w1 s2 t) + (set-window-start w2 s1 t)) + (setq helm--window-side-state (helm--get-window-side-state) + helm--resplit-window-iterator nil)))))) +(put 'helm-swap-windows 'helm-only t) + +(defun helm--get-window-with-predicate (predicate &optional minibuf all-frames default arg) + "Same as `get-window-with-predicate' but allow changing direction with ARG." + (catch 'found + (dolist (window (window-list-1 + (if (< arg 0) + (previous-window nil minibuf all-frames) + (next-window nil minibuf all-frames)) + minibuf all-frames)) + (when (funcall predicate window) + (throw 'found window))) + default)) + +(defun helm--get-window-side-state () + "Return the position of `helm-window' w.r.t main window. +Main window can be the window handling `helm-current-buffer' but also the +persistent action window. +Possible values are \\='left \\='right \\='below or \\='above." + (let ((side-list '(left right below above))) + (cl-loop for side in side-list + thereis (and (equal (helm-window) + (window-in-direction + side (or (get-buffer-window helm-current-buffer t) + (helm-persistent-action-display-window)) + t)) + side)))) + +(defun helm-replace-buffer-in-window (window buffer1 buffer2) + "Replace BUFFER1 by BUFFER2 in WINDOW registering BUFFER1." + (when (get-buffer-window buffer1) + (unrecord-window-buffer window buffer1) + (set-window-buffer window buffer2))) + +;; select another action by key +(defun helm-select-nth-action (n) + "Select the N nth action for the currently selected candidate." + (let ((src (helm-get-current-source))) + (setq helm-saved-selection (helm-get-selection nil nil src)) + (unless helm-saved-selection + (error "Nothing is selected")) + (setq helm-saved-action + (helm-get-nth-action + n + (if (get-buffer-window helm-action-buffer 'visible) + (assoc-default 'candidates src) + (helm-get-actions-from-current-source src)))) + (helm-maybe-exit-minibuffer))) + +(defun helm-get-nth-action (n action) + "Return the nth N action from ACTION. +Argument ACTION can be a symbol or a list of actions." + (cond ((and (zerop n) (functionp action)) + action) + ((listp action) + (or (cdr (elt action n)) + (error "No such action"))) + ((and (functionp action) (> n 0)) + (error "Sole action")) + (t + (error "Error in `helm-select-nth-action'")))) + +(defun helm-execute-selection-action-at-nth (linum) + "Execute default action on candidate at LINUM lines from selection." + (let ((prefarg current-prefix-arg)) + (if (>= linum 0) + (helm-next-line linum) + (helm-previous-line (lognot (1- linum)))) + (setq current-prefix-arg prefarg) + (helm-exit-minibuffer))) + +;;; Persistent Action +;; +(defun helm-initialize-persistent-action () + (set (make-local-variable 'helm-persistent-action-display-window) nil)) + +(defun helm-execute-persistent-action (&optional attr split) + "Perform the associated action ATTR without quitting helm. + +Arg ATTR default will be `persistent-action' or +`persistent-action-if' if unspecified depending on what's found +in source, but it can be anything else. +In this case you have to add this new attribute to your source. +See `persistent-action' and `persistent-action-if' slot +documentation in `helm-source'. + +When `helm-full-frame' is non-nil, and `helm-buffer' is displayed +in only one window, the helm window is split to display +`helm-select-persistent-action-window' in other window to +maintain visibility. The argument SPLIT can be used to force +splitting inconditionally, it is unused currently." + (interactive) + (catch 'ignore + (with-suppressed-warnings ((obsolete special-display-regexps) + (obsolete special-display-buffer-names)) + (with-helm-alive-p + (let ((source (helm-get-current-source))) + (unless attr + (setq attr (or (car (assq 'persistent-action source)) + (car (assq 'persistent-action-if source))))) + (helm-log "helm-execute-persistent-action" "executing persistent-action") + (let* ((selection (and source (helm-get-selection nil nil source))) + (attr-val (if (eq attr 'persistent-action-if) + (funcall (assoc-default attr source) selection) + (assoc-default attr source))) + ;; If attr value is a cons, use its car as persistent function. + (fn (if (and (consp attr-val) + ;; maybe a lambda. + (not (functionp attr-val))) + (car attr-val) attr-val)) + ;; And its cdr to decide if helm window should be splitted. + (no-split (and (consp attr-val) + (not (functionp attr-val)) + (cdr attr-val))) + ;; Is next-window (from helm-window) a suitable window for PA? + (no-suitable-win + (helm-aand (not helm--buffer-in-new-frame-p) + (get-buffer-window helm-current-buffer) + (or (window-dedicated-p it) + (window-parameter it 'window-side)))) + (cursor-in-echo-area t) + mode-line-in-non-selected-windows) + (progn + (when (and helm-onewindow-p (null no-split) + (null helm--buffer-in-new-frame-p)) + (helm-toggle-full-frame)) + (when (eq fn 'ignore) + (throw 'ignore nil)) + (when source + (with-helm-window + (save-selected-window + ;; FIXME: Simplify SPLIT behavior, it is a mess currently. + (if no-split + (helm-select-persistent-action-window :split 'never) + (helm-select-persistent-action-window + :split (or split helm-onewindow-p no-suitable-win))) + (helm-log "helm-execute-persistent-action" + "current-buffer = %S" (current-buffer)) + (let ((helm-in-persistent-action t) + (display-buffer-alist '((".*" (display-buffer-same-window)))) + display-buffer-function pop-up-windows pop-up-frames + special-display-regexps special-display-buffer-names) + (helm-execute-selection-action-1 + selection (or fn (helm-get-actions-from-current-source source)) t) + (unless (helm-action-window) + (helm-log-run-hook "helm-execute-persistent-action" + 'helm-after-persistent-action-hook))) + ;; A typical case is when a persistent action delete + ;; the buffer already displayed in + ;; `helm-persistent-action-display-window' and `helm-full-frame' + ;; is enabled, we end up with the `helm-buffer' + ;; displayed in two windows. + (when (and helm-onewindow-p + (> (length (window-list)) 1) + (equal (buffer-name + (window-buffer + helm-persistent-action-display-window)) + (helm-buffer-get))) + (delete-other-windows)))))))))))) +(put 'helm-execute-persistent-action 'helm-only t) + +(cl-defun helm-persistent-action-display-window (&key split) + "Return the window that will be used for persistent action. +If SPLIT is t window is split in persistent action, if it has the +special symbol `never' don't split, if it is nil don't split either. +The symbol `never' is kept for backward compatibility." + (with-helm-window + (setq helm-persistent-action-display-window + (cond ((and (window-live-p helm-persistent-action-display-window) + (not (member helm-persistent-action-display-window + (get-buffer-window-list helm-buffer)))) + helm-persistent-action-display-window) + ((and helm--buffer-in-new-frame-p helm-initial-frame) + (with-selected-frame helm-initial-frame + (let ((win (selected-window))) + (if (or (window-dedicated-p win) + (window-parameter win 'window-side)) + (next-window win 1) + win)))) + ((and split (not (eq split 'never))) + (split-window)) + ((get-buffer-window helm-current-buffer)) + (t (previous-window (selected-window) 1)))))) + +(cl-defun helm-select-persistent-action-window (&key split) + "Select the window that will be used for persistent action. +See `helm-persistent-action-display-window' for how to use SPLIT." + (select-window (get-buffer-window (helm-buffer-get))) + (prog1 + (select-window + (setq minibuffer-scroll-window + (helm-persistent-action-display-window :split split)) + 'norecord) + (helm-log "helm-select-persistent-action-window" + "Selected window is %S" minibuffer-scroll-window))) + +;;; Scrolling - recentering +;; +;; +(defun helm-other-window-base (command &optional arg) + (let ((minibuffer-scroll-window + (helm-persistent-action-display-window))) + (funcall command (or arg helm-scroll-amount)))) + +(defun helm-scroll-other-window (&optional arg) + "Scroll other window upward ARG many lines. +When arg is not provided scroll `helm-scroll-amount' lines. +See `scroll-other-window'." + (interactive "P") + (with-helm-alive-p (helm-other-window-base 'scroll-other-window arg))) +(put 'helm-scroll-other-window 'helm-only t) + +(defun helm-scroll-other-window-down (&optional arg) + "Scroll other window downward ARG many lines. +When arg is not provided scroll `helm-scroll-amount' lines. +See `scroll-other-window-down'." + (interactive "P") + (with-helm-alive-p (helm-other-window-base 'scroll-other-window-down arg))) +(put 'helm-scroll-other-window-down 'helm-only t) + +(defun helm-recenter-top-bottom-other-window (&optional arg) + "Run `recenter-top-bottom' in other window. +Meaning of prefix ARG is the same as in `recenter-top-bottom'." + (interactive "P") + (with-helm-alive-p + (with-helm-window + (with-selected-window (helm-persistent-action-display-window) + (recenter-top-bottom arg))))) +(put 'helm-recenter-top-bottom-other-window 'helm-only t) + +(defun helm-reposition-window-other-window (&optional arg) + "Run `reposition-window' in other window. +Meaning of prefix ARG is the same as in `reposition-window'." + (interactive "P") + (with-helm-alive-p + (with-helm-window + (with-selected-window (helm-persistent-action-display-window) + (reposition-window arg))))) +(put 'helm-reposition-window-other-window 'helm-only t) + + +;; Visible Mark + +(defun helm-clear-visible-mark () + (with-current-buffer (helm-buffer-get) + (mapc 'delete-overlay helm-visible-mark-overlays) + (set (make-local-variable 'helm-visible-mark-overlays) nil))) + +(defun helm-this-visible-mark () + (cl-loop for o in (overlays-at (point)) + when (overlay-get o 'visible-mark) + return o)) + +(defun helm-delete-visible-mark (overlay) + (let ((src (helm-get-current-source))) + (setq helm-marked-candidates + (remove + (cons src (helm-get-selection nil nil src)) + helm-marked-candidates)) + (delete-overlay overlay) + (setq helm-visible-mark-overlays + (delq overlay helm-visible-mark-overlays)))) + +(defun helm-make-visible-mark (&optional src selection) + (let* ((source (or src (helm-get-current-source))) + (sel (or selection (helm-get-selection + nil (helm-get-attr 'marked-with-props source) + source))) + (selection-end (if (helm-pos-multiline-p) + ;; Stays within source + (or (helm-get-next-candidate-separator-pos) + (helm-get-next-header-pos) + (point-max)) + ;; Not multiline + (1+ (pos-eol)))) + (o (make-overlay (pos-bol) selection-end))) + (overlay-put o 'priority 0) + (overlay-put o 'face 'helm-visible-mark) + (overlay-put o 'source source) + (overlay-put o 'string (buffer-substring (overlay-start o) (overlay-end o))) + (overlay-put o 'real sel) + (overlay-put o 'before-string (propertize " " 'display + `((margin left-margin) + ,(propertize + helm-visible-mark-prefix + 'face 'helm-mark-prefix)))) + (overlay-put o 'visible-mark t) + (overlay-put o 'evaporate t) + (cl-pushnew o helm-visible-mark-overlays) + (push (cons source sel) helm-marked-candidates))) + +(defun helm-toggle-visible-mark (arg) + "Toggle Helm visible mark at point ARG times. +If ARG is negative toggle backward." + (interactive "p") + (with-helm-alive-p + (with-helm-window + (let* ((src (helm-get-current-source)) + (nomark (assq 'nomark src)) + (next-fns (if (< arg 0) + '(helm-beginning-of-source-p . helm-previous-line) + '(helm-end-of-source-p . helm-next-line)))) + (if nomark + (message "Marking not allowed in this source") + (cl-loop with n = (if (< arg 0) (* arg -1) arg) + repeat n do + (progn + (helm-aif (helm-this-visible-mark) + (helm-delete-visible-mark it) + (helm-make-visible-mark)) + (if (funcall (car next-fns)) + (progn + (helm-display-mode-line src) + (cl-return nil)) + (funcall (cdr next-fns))))) + (set-window-margins (selected-window) + (if helm-visible-mark-overlays + (+ (string-width helm-visible-mark-prefix) + helm-left-margin-width) + helm-left-margin-width))))))) +(put 'helm-toggle-visible-mark 'helm-only t) + +(defun helm-toggle-visible-mark-forward (&optional arg) + "Toggle visible mark forward ARG times." + (interactive "p") + (helm-toggle-visible-mark arg)) + +(defun helm-toggle-visible-mark-backward (&optional arg) + "Toggle visible mark backward ARG times." + (interactive "p") + (helm-toggle-visible-mark (- arg))) + +(defun helm-file-completion-source-p (&optional source) + "Return non-nil if current source is a file completion source." + (or helm--completing-file-name ; helm-read-file-name + (let ((cur-source (cdr (assq 'name + (or source (helm-get-current-source)))))) + (cl-loop for i in helm--file-completion-sources + thereis (string= cur-source i))))) + +(defun helm-mark-all (&optional all) + "Mark all visible unmarked candidates in current source. + +With a prefix arg mark all visible unmarked candidates in all +sources." + (interactive "P") + (with-helm-alive-p + (with-helm-window ; Using `with-helm-buffer' for some unknow + ; reasons infloop. + (set-window-margins (selected-window) + (+ (string-width helm-visible-mark-prefix) + helm-left-margin-width)) + (if (null all) + (helm-mark-all-1 t) + (let ((pos (point))) + (goto-char (point-min)) + (helm-awhile (helm-get-next-header-pos) + (goto-char it) + (forward-line 1) + (helm-mark-current-line) + (helm-mark-all-1)) + ;; `save-excursion' seems confused if used in addition of + ;; the one used in `helm-mark-all-1', so save POS and back + ;; to it when loop is finished. + (goto-char pos) + (helm-mark-current-line) + (helm-display-mode-line (helm-get-current-source) t)))))) +(put 'helm-mark-all 'helm-only t) + +(defun helm-mark-all-1 (&optional ensure-beg-of-source) + "Mark all visible unmarked candidates in current source. +Need to be wrapped in `with-helm-window'. +Arg ENSURE-BEG-OF-SOURCE ensure we are at beginning of source +when starting to mark candidates, if handled elsewhere before +starting it is not needed." + (let* ((src (helm-get-current-source)) + (follow (if (helm-follow-mode-p src) 1 -1)) + (nomark (assq 'nomark src)) + (src-name (assoc-default 'name src)) + (filecomp-p (or (helm-file-completion-source-p src) + (string= src-name "Files from Current Directory")))) + (helm-follow-mode -1) + (unwind-protect + (if nomark + (user-error "Marking not allowed in this source") + (save-excursion + (when ensure-beg-of-source + (goto-char (helm-get-previous-header-pos)) + (forward-line 1)) + (let* ((next-head (helm-get-next-header-pos)) + (end (and next-head + (save-excursion + (goto-char next-head) + (forward-line -1) + (point)))) + (maxpoint (or end (point-max)))) + (while (< (point) maxpoint) + (helm-mark-current-line) + (let* ((prefix (or (get-text-property (pos-bol) 'helm-new-file) + (get-text-property (pos-bol) 'unknown))) + (cand (helm-get-selection + nil (helm-get-attr 'marked-with-props src) + src)) + (bn (and filecomp-p (helm-basename cand)))) + ;; Don't mark possibles directories ending with . or .. + ;; autosave files/links and non--existent files. + (unless + (or (helm-this-visible-mark) + ;; Non existing files in HFF and + ;; RFN. Display may be an image. See + ;; https://github.com/yyoncho/helm-treemacs-icons/issues/5 + ;; and also Bug#2296. + prefix + (and filecomp-p (member bn '("." "..")))) + (helm-make-visible-mark src cand))) + (when (helm-pos-multiline-p) + (goto-char + (or (helm-get-next-candidate-separator-pos) + (point-max)))) + (forward-line 1)))) + (helm-mark-current-line)) + (helm-follow-mode follow)))) + +(defun helm-unmark-all () + "Unmark all candidates in all sources of current helm session." + (interactive) + (with-helm-alive-p + (with-helm-window + (save-excursion + (helm-clear-visible-mark)) + (setq helm-marked-candidates nil) + (helm-mark-current-line) + (helm-display-mode-line (helm-get-current-source)) + (set-window-margins (selected-window) helm-left-margin-width)))) +(put 'helm-unmark-all 'helm-only t) + +(defun helm-toggle-all-marks (&optional all) + "Toggle all marks. + +Mark all visible candidates of current source or unmark all +candidates visible or invisible in all sources of current Helm +session. + +With a prefix argument mark all candidates in all sources." + (interactive "P") + (with-helm-alive-p + (let ((marked (helm-marked-candidates))) + (if (and (>= (length marked) 1) + (with-helm-window helm-visible-mark-overlays)) + (helm-unmark-all) + (helm-mark-all all))))) +(put 'helm-toggle-all-marks 'helm-only t) + +(defun helm--compute-marked (real source &optional wildcard) + (let* ((coerced (helm-coerce-selection real source)) + (wilds (and wildcard + (condition-case nil + (helm-file-expand-wildcards + coerced t) + (error nil))))) + ;; Avoid returning a not expanded wildcard fname. + ;; e.g assuming "/tmp" doesn't contain "*.el" + ;; return nil when coerced is "/tmp/*.el". + (unless (or wilds (null wildcard) + (string-match-p helm--url-regexp coerced) + (file-exists-p coerced) + (and (stringp coerced) + (null (string-match-p "[[*?]" coerced)))) + (setq coerced nil)) + (or wilds (and coerced (list coerced))))) + +(cl-defun helm-marked-candidates (&key with-wildcard all-sources) + "Return marked candidates of current source, if any. + +Otherwise return one element list consisting of the current +selection. When key WITH-WILDCARD is specified, expand it. When +ALL-SOURCES key value is non-nil returns marked candidates of all +sources." + (with-current-buffer helm-buffer + (let* ((current-src (helm-get-current-source)) + (src-name (assq 'name current-src)) + (dummy (equal (helm-get-attr 'candidates current-src) '("dummy"))) + (candidates + (cl-loop for (source . real) in (reverse helm-marked-candidates) + for use-wc = (and with-wildcard + (string-match-p "[[*?]" real) + (null (file-exists-p real))) + when (or all-sources + (and + ;; Dummy sources use a unique candidate, two same + ;; dummy sources (or more) should share their + ;; (unique) marked candidate only when + ;; :all-marked is non nil. + (not dummy) + (equal (assq 'name source) src-name))) + nconc (helm--compute-marked real source use-wc) into mkds + finally return + (if (and with-wildcard all-sources) + (helm-fast-remove-dups mkds :test 'equal) + mkds))) + sel) + (unless candidates + (setq sel (helm-get-selection + nil (helm-get-attr 'marked-with-props current-src) + current-src)) + (setq candidates + (helm--compute-marked + sel current-src + (and with-wildcard (null (file-exists-p sel)))))) + (helm-log "helm-marked-candidates" + "Marked candidates = %S" candidates) + candidates))) + +(defun helm--remove-marked-and-update-mode-line (elm) + (with-helm-buffer + (setq helm-marked-candidates + (delete (rassoc elm helm-marked-candidates) + helm-marked-candidates)) + (helm-display-mode-line (helm-get-current-source)))) + +(defun helm-current-source-name= (name) + (save-excursion + (goto-char (helm-get-previous-header-pos)) + (equal name (helm-current-line-contents)))) + +(defun helm-revive-visible-mark () + "Restore marked candidates when helm updates display." + (with-current-buffer helm-buffer + (save-excursion + (dolist (o helm-visible-mark-overlays) + (let* ((source (overlay-get o 'source)) + (ov-src-name (assoc-default 'name source)) + (ov-str (overlay-get o 'string)) + (ov-real (overlay-get o 'real)) + (ov-ml-str (helm-aif (helm-get-attr 'multiline source) + (if (numberp it) + ;; Assume display have been computed + ;; against real e.g. kill-ring. + (helm--multiline-get-truncated-candidate + ov-real it) + ov-str) + ov-str)) + beg end) + ;; Move point to end of source header line. + (goto-char (point-min)) + (search-forward ov-src-name nil t) + (while (and (search-forward ov-ml-str nil t) + (cl-loop for ov in (overlays-at (pos-bol 0)) + never (overlay-get ov 'visible-mark)) + (helm-current-source-name= ov-src-name)) + (setq beg (match-beginning 0) + end (if (string= ov-ml-str ov-str) + (match-end 0) (1+ (match-end 0)))) + ;; Calculate real value of candidate. + ;; It can be nil if candidate have only a display value. + (let ((real (get-text-property (pos-bol 0) 'helm-realvalue))) + (if real + ;; Check if real value of current candidate is the same + ;; than the one stored in overlay. + ;; This is needed when some cands have same display names. + ;; Using equal allow testing any type of value for real cand. + ;; bug#706. + (and (equal ov-real real) + (move-overlay o beg end)) + (and (equal ov-str (buffer-substring beg end)) + (move-overlay o beg end)))))))))) +(add-hook 'helm-after-update-hook 'helm-revive-visible-mark) + +(defun helm-next-point-in-list (curpos points &optional prev) + (cond + ;; rule out special cases. + ((null points) curpos) + ((and prev (<= curpos (car points))) + (nth (1- (length points)) points)) + ((< (car (last points)) curpos) + (if prev (car (last points)) (nth 0 points))) + ((and (not prev) (>= curpos (car (last points)))) + (nth 0 points)) + (t + (nth (if prev + (cl-loop for pt in points + for i from 0 + if (<= curpos pt) return (1- i)) + (cl-loop for pt in points + for i from 0 + if (< curpos pt) return i)) + points)))) + +(defun helm-next-visible-mark (&optional prev) + "Move next Helm visible mark. +If PREV is non-nil move to precedent." + (interactive) + (with-helm-alive-p + (with-helm-window + (ignore-errors + (goto-char (helm-next-point-in-list + (point) + (sort (mapcar 'overlay-start helm-visible-mark-overlays) '<) + prev))) + (helm-mark-current-line)))) +(put 'helm-next-visible-mark 'helm-only t) + +(defun helm-prev-visible-mark () + "Move previous helm visible mark." + (interactive) + (with-helm-alive-p + (helm-next-visible-mark t))) +(put 'helm-prev-visible-mark 'helm-only t) + +;;; Kill/yank selection +;; +(defun helm-yank-selection (arg) + "Set minibuffer contents to current display selection. +With a prefix arg set to real value of current selection." + (interactive "P") + (with-helm-alive-p + (let ((str (format "%s" (helm-get-selection nil (not arg))))) + (kill-new str) + (helm-set-pattern str)))) +(put 'helm-yank-selection 'helm-only t) + +(defun helm-kill-selection-and-quit (arg) + "Store display value of current selection to kill ring. +Kill \\='display or \\='real value of candidate according to the value of +`helm-kill-real-or-display-selection'. A prefix arg reverse the behavior of +this variable." + (interactive "P") + (with-helm-alive-p + (helm-run-after-exit + (lambda (sel) + (kill-new sel) + ;; Return nil to force `helm-mode--keyboard-quit' + ;; in `helm-comp-read' otherwise the message itself + ;; is used as exit value for `helm-comp-read'. + (prog1 nil (message "Saved to kill-ring: %s" sel) (sit-for 1))) + (format "%s" (helm-get-selection + nil (helm-acase helm-kill-real-or-display-selection + (real arg) + (display (and (not arg) 'noicon)))))))) +(put 'helm-kill-selection-and-quit 'helm-only t) + +(defun helm-insert-or-copy (&optional arg) + "Insert selection or marked candidates in current buffer. + +With a prefix arg copy marked candidates to kill-ring. +The real value of each candidate is used." + (interactive "P") + (with-helm-alive-p + (helm-run-after-exit + (lambda (cands) + (with-helm-current-buffer + (let ((sels (mapconcat (lambda (c) + (format "%s" c)) + cands "\n"))) + (if arg (kill-new sels) (insert sels))))) + (helm-marked-candidates)))) +(put 'helm-insert-or-copy 'helm-only t) + + +;;; Follow-mode: Automatic execution of persistent-action +;; +;; +(defun helm-follow-mode (&optional arg) + "Execute persistent action every time the cursor is moved. + +This mode is source local, i.e. It applies on current source only. +\\ +This mode can be enabled or disabled interactively at anytime during +a helm session with \\[helm-follow-mode]. + +When enabling interactively `helm-follow-mode' in a source, you +can keep it enabled for next Emacs sessions by setting +`helm-follow-mode-persistent' to a non-nil value. + +When `helm-follow-mode' is called with a prefix arg and +`helm-follow-mode-persistent' is non-nil `helm-follow-mode' will +be persistent only for this Emacs session, but not for the next +Emacs sessions, i.e. the current source will not be saved to +`helm-source-names-using-follow'. + +A prefix arg with `helm-follow-mode' already enabled will have no +effect. + +Note that you can use instead of this mode the commands +`helm-follow-action-forward' and `helm-follow-action-backward' at +anytime in all Helm sessions. + +They are bound by default to \\[helm-follow-action-forward] and +\\[helm-follow-action-backward]." + (interactive (list (helm-aif (and current-prefix-arg + (prefix-numeric-value current-prefix-arg)) + (unless (helm-follow-mode-p) it)))) + (with-helm-alive-p + (with-current-buffer helm-buffer + (let* ((src (helm-get-current-source)) + (name (assoc-default 'name src)) + (fol-attr (assq 'follow src)) + (enabled (or (helm-follow-mode-p src) + (and helm-follow-mode-persistent + (member (assoc-default 'name src) + helm-source-names-using-follow)))) + ;; No messages when called non interactively. + (set-message-function (lambda (msg) + (if (and (not current-prefix-arg) arg) + 1 msg)))) + (if src + (progn + (if (eq (cdr fol-attr) 'never) + (message "helm-follow-mode not allowed in this source") + ;; Make follow attr persistent for this emacs session. + (helm-follow-mode-set-source + (if (or enabled (and (numberp arg) (< arg 0))) -1 1) + src) + ;; When called from lisp (non--interactive) src-name + ;; will never be saved. + ;; When arg is nil assume the call is interactive and save + ;; src-name to `helm-source-names-using-follow'. + ;; However if user call helm-follow-mode with a prefix arg, + ;; behave like a non--interactive call and + ;; DONT save src-name to `helm-source-names-using-follow'. + (when (and helm-follow-mode-persistent (null arg)) + (if (null enabled) + (unless (member name helm-source-names-using-follow) + (push name helm-source-names-using-follow) + (customize-save-variable 'helm-source-names-using-follow + helm-source-names-using-follow)) + (when (member name helm-source-names-using-follow) + (setq helm-source-names-using-follow + (delete name helm-source-names-using-follow)) + (customize-save-variable 'helm-source-names-using-follow + helm-source-names-using-follow)))) + (message "helm-follow-mode is %s" + (if (helm-follow-mode-p src) + "enabled" "disabled")) + (helm-display-mode-line src t))) + (message "Not enough candidates for helm-follow-mode")))))) +(put 'helm-follow-mode 'helm-only t) + +(defun helm-follow-execute-persistent-action-maybe (&optional delay) + "Execute persistent action in mode `helm-follow-mode'. + +This happen after: DELAY or the \\='follow-attr value of current +source or `helm-follow-input-idle-delay'." + (let* ((src (helm-get-current-source)) + (suspend (and helm--in-update + ;; Specific to helm-find-files. + (assoc-default 'suspend-follow-in-update src)))) + (when (and (not suspend) + (not (get-buffer-window helm-action-buffer 'visible)) + (not (helm-pos-header-line-p)) + (or (helm-follow-mode-p src) + (and helm-follow-mode-persistent + (member (assoc-default 'name src) + helm-source-names-using-follow))) + (null (eq (assoc-default 'follow src) 'never)) + (helm-get-selection nil nil src)) + (helm-follow-mode-set-source 1 src) + (helm--execute-persistent-action-when-idle delay src)))) + +;; We could use a simple idle timer here as before with a delay fixed at minimum +;; 0.5, the effect is the same but it creates a timer at each call, with this +;; code a new timer is created only after being idle 0.5 and restarting +;; scrolling. That's mean that when hitting C-n continuously no new timer is +;; created, we reuse `helm--execute-persistent-action-timer' until it is not +;; consumed i.e. the PA is executed because we are idle. +(defvar helm--execute-persistent-action-timer nil) +(defun helm--execute-persistent-action-when-idle (&optional delay src) + "Call persistent action only once idle DELAY that many seconds. +SRC is used to check if there is a delay specified for this source. +Also avoid creating needlessly a timer at each call." + ;; More or less similar to what the debounce fn in timeout package does, + ;; except the timer is stored in a global var instead of beeing stored in a + ;; closure and there is no default output, we just execute + ;; helm-execute-persistent-action once emacs is idle. + (when helm-alive-p + (let ((at (or delay + (assoc-default 'follow-delay src) + helm-follow-input-idle-delay))) + (unless (timerp helm--execute-persistent-action-timer) + (setq helm--execute-persistent-action-timer + (run-with-idle-timer + at nil + (lambda () + (cancel-timer helm--execute-persistent-action-timer) + (setq helm--execute-persistent-action-timer nil) + (helm-execute-persistent-action)))))))) + +(defun helm-follow-mode-p (&optional source) + (with-helm-buffer + (eq (helm-get-attr 'follow (or source (helm-get-current-source))) 1))) + +(defun helm-follow-mode-set-source (value &optional source) + (with-helm-buffer + (helm-set-attr 'follow value (or source (helm-get-current-source))))) + +;;; Auto-resize mode +;; +(defun helm--autoresize-hook (&optional max-height min-height) + (when (if (helm--show-action-window-other-window-p) + (and (helm-window) + (not (get-buffer-window helm-action-buffer 'visible))) + (helm-window)) + (with-helm-window + (fit-window-to-buffer nil + (/ (* (frame-height) + (or max-height helm-autoresize-max-height)) + 100) + (/ (* (frame-height) + (or min-height helm-autoresize-min-height)) + 100))))) + +(define-minor-mode helm-autoresize-mode + "Auto resize helm window when enabled. +Helm window is re-sized according to `helm-autoresize-max-height' +and `helm-autoresize-min-height'. Note that when this mode is +enabled, Helm behaves as if `helm-always-two-windows' is enabled. + +See `fit-window-to-buffer' for more infos." + :group 'helm + :global t + (if helm-autoresize-mode + (progn (add-hook 'helm-after-update-hook 'helm--autoresize-hook) + (add-hook 'helm-window-configuration-hook 'helm--autoresize-hook)) + (remove-hook 'helm-after-update-hook 'helm--autoresize-hook) + (remove-hook 'helm-window-configuration-hook 'helm--autoresize-hook))) + +(defun helm-help () + "Generate Helm's help according to `help-message' attribute. + +If `helm-buffer' is empty, provide completions on `helm-sources' +to choose its local documentation. +If source doesn't have any `help-message' attribute, a generic +message explaining this is added instead. +The global `helm-help-message' is always added after this local +help." + (interactive) + (require 'helm-mode nil t) ; for helm-comp-read. + (with-helm-alive-p + (let ((source (or (helm-get-current-source) ; nil when helm-buffer is empty. + (and (fboundp 'helm-comp-read) + (helm-comp-read + "Help for: " + (cl-loop for src in (with-helm-buffer helm-sources) + collect `(,(assoc-default 'name src) . + ,src)) + :allow-nest t + :exec-when-only-one t)) + ;; No completion on sources when only helm-core package is + ;; used. + (car helm-sources)))) + (save-selected-window + (helm-help-internal + helm-help-buffer-name + (lambda () + (helm-aif (assoc-default 'help-message source) + (insert (substitute-command-keys + (helm-interpret-value it))) + (insert "* No specific help for this source available.")) + (insert "\n\n" + (substitute-command-keys + (helm-interpret-value helm-help-message))))))))) +(put 'helm-help 'helm-only t) + +(defun helm-toggle-truncate-line () + "Toggle `truncate-lines' value in `helm-buffer'" + (interactive) + (with-helm-alive-p + (with-helm-buffer + (setq truncate-lines (not truncate-lines)) + (when (helm-get-previous-header-pos) + (helm-update (regexp-quote (helm-get-selection nil t)))) + (message "%sisplaying continuation lines" + (if truncate-lines "Not D" "D"))))) +(put 'helm-toggle-truncate-line 'helm-only t) + +;;;###autoload +(defun helm-other-buffer (sources buffer) + "Simplified Helm interface with other `helm-buffer'. +Call `helm' only with SOURCES and BUFFER as args." + (helm :sources sources :buffer buffer)) +(make-obsolete 'helm-other-buffer 'helm "4.0.1") + +(provide 'helm-core) +;;; helm-core.el ends here diff --git a/elpa/helm-core-20260424.1357/helm-lib.el b/elpa/helm-core-20260424.1357/helm-lib.el new file mode 100644 index 00000000..34398405 --- /dev/null +++ b/elpa/helm-core-20260424.1357/helm-lib.el @@ -0,0 +1,2365 @@ +;;; helm-lib.el --- Helm routines. -*- lexical-binding: t -*- + +;; Copyright (C) 2015 ~ 2026 Thierry Volpiatto + +;; Author: Thierry Volpiatto +;; URL: http://github.com/emacs-helm/helm + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: +;; All helm functions that don't require specific helm code should go here. + +;;; Code: + +(require 'cl-lib) + +(declare-function ansi-color--find-face "ansi-color.el") +(declare-function ansi-color-apply-sequence "ansi-color.el") +(declare-function dired-current-directory "dired.el") +(declare-function ffap-file-remote-p "ffap.el") +(declare-function ffap-url-p "ffap.el") +(declare-function helm-get-attr "helm-core.el") +(declare-function helm-set-attr "helm-core.el") +(declare-function helm-follow-mode-p "helm-core.el") +(declare-function helm-get-current-source "helm-core.el") +(declare-function helm-get-selection "helm-core.el") +(declare-function helm-get-sources "helm-core.el") +(declare-function helm-interpret-value "helm-core.el") +(declare-function helm-log-run-hook "helm-core.el") +(declare-function helm-next-line "helm-core.el") +(declare-function helm-get-next-header-pos "helm-core.el") +(declare-function helm-mark-current-line "helm-core.el") +(declare-function helm-marked-candidates "helm-core.el") +(declare-function helm-set-case-fold-search "helm-core.el") +(declare-function helm-get-previous-header-pos "helm-core.el") +(declare-function helm-source--cl--print-table "helm-source.el") +(declare-function helm-update "helm-core.el") +(declare-function org-content "org.el") +(declare-function org-mark-ring-goto "org.el") +(declare-function org-mark-ring-push "org.el") +(declare-function org-table-p "org-compat.el") +(declare-function org-table-align "org-table.el") +(declare-function org-table-end "org-table.el") +(declare-function org-open-at-point "org.el") +(declare-function helm-read-file-name "helm-mode.el") +(declare-function find-function-library "find-func.el") +(declare-function find-library-name "find-func.el") +(declare-function cl--describe-class-slots "cl-extra.el") +(declare-function cl--find-class "cl-macs.el") + +(defvar helm-sources) +(defvar helm-initial-frame) +(defvar helm-current-position) +(defvar helm-persistent-action-display-window) +(defvar helm--buffer-in-new-frame-p) +(defvar helm-completion-style) +(defvar helm-completion-styles-alist) +(defvar helm-persistent-action-window-buffer) +(defvar helm-help-buffer-name) +(defvar completion-flex-nospace) +(defvar find-function-source-path) +(defvar ffap-machine-p-unknown) +(defvar ffap-machine-p-local) +(defvar ffap-machine-p-known) +(defvar helm-debug-output-buffer) + +;;; User vars. +;; +(defcustom helm-file-globstar t + "Same as globstar bash shopt option. +When non-nil a pattern beginning with two stars will expand +recursively. +Directories expansion is not supported yet." + :group 'helm + :type 'boolean) + +(defcustom helm-yank-text-at-point-function nil + "The function used to forward point with `helm-yank-text-at-point'. +With a nil value, fallback to default `forward-word'. +The function should take one arg, an integer like `forward-word'. +NOTE: Using `forward-symbol' here is not very useful as it is +already provided by \\\\[next-history-element]." + :type 'function + :group 'helm) + +(defcustom helm-scroll-amount nil + "Scroll amount when scrolling helm window or other window in a helm session. +It is used by `helm-scroll-other-window', `helm-scroll-up', `helm-scroll-down' +and `helm-scroll-other-window-down'. + +If you prefer scrolling line by line, set this value to 1." + :group 'helm + :type 'integer) + +(defcustom helm-help-full-frame t + "Display help window in full frame when non nil. + +Even when nil probably the same result (full frame) can be +reached by tweaking `display-buffer-alist', but it is much more +convenient to use a simple boolean value here." + :type 'boolean + :group 'helm-help) + +(defvar helm-ff--boring-regexp nil) +(defun helm-ff--setup-boring-regex (var val) + (set var val) + (setq helm-ff--boring-regexp + (cl-loop for r on val + if (cdr r) + concat (concat (car r) "\\|") + else concat (car r)))) + +(defcustom helm-boring-file-regexp-list + (mapcar (lambda (f) + (let ((rgx (regexp-quote f))) + (if (string-match-p "[^/]$" f) + ;; files: e.g .o => \\.o$ + (concat rgx "$") + ;; To not ignore files with same prefix as directory names + ;; (bug#2009) use e.g. .git/ => \.git\?$. + ;; See also PR in bug#2012. + (concat rgx "?$")))) + completion-ignored-extensions) + "A list of regexps matching boring files. + +This list is build by default on `completion-ignored-extensions'. +The directory names should end with \"/?$\" e.g. \"\\.git/?$\" and +the file names should end with \"$\" e.g. \"\\.o$\". + +These regexps may be used to match the entire path, not just the +file name, so for example to ignore files with a prefix +\".bak.\", use \"\\.bak\\..*$\" as the regexp. + +NOTE: When modifying this, be sure to use customize interface or +the customize functions e.g. `customize-set-variable' and NOT +`setq'." + :group 'helm-files + :type '(repeat (choice regexp)) + :set 'helm-ff--setup-boring-regex) + +(defcustom helm-describe-function-function 'describe-function + "Function used to describe functions in Helm." + :group 'helm-elisp + :type 'function) + +(defcustom helm-describe-variable-function 'describe-variable + "Function used to describe variables in Helm." + :group 'helm-elisp + :type 'function) + +(defcustom helm-current-directory-alist + '((dired-mode . dired-current-directory) + (mu4e-main-mode . mu4e-root-maildir) + (gnus-group-mode . gnus-directory) + (gnus-summary-mode . gnus-directory) + (gnus-article-mode . gnus-directory)) + "Tell `helm-current-directory' what to use according to `major-mode'. +Each element of alist is (MAJOR-MODE . SYMBOL) where SYMBOL is either a variable +or a function." + :type '(alist :key-type symbol :value-type sexp) + :group 'helm-files) + +;;; Internal vars +;; +(defvar helm-yank-point nil) +(defvar helm-pattern "" + "The input pattern used to update the helm buffer.") +(defvar helm-buffer "*helm*" + "Buffer showing completions.") +(defvar helm-current-buffer nil + "Current buffer when `helm' is invoked.") +(defvar helm-suspend-update-flag nil) +(defvar helm-action-buffer "*helm action*" + "Buffer showing actions.") +(defvar helm-current-prefix-arg nil + "Record `current-prefix-arg' when exiting minibuffer.") +(defvar helm-current-error nil + "Same as `compilation-current-error' but for helm-occur and helm-grep.") + +;;; Compatibility +;; +(defun helm-add-face-text-properties (beg end face &optional append object) + "Add the face property to the text from START to END. +It is a compatibility function which behaves exactly like +`add-face-text-property' if available, otherwise like +`add-text-properties'. When only `add-text-properties' is +available APPEND is ignored." + (if (fboundp 'add-face-text-property) + (add-face-text-property beg end face append object) + (add-text-properties beg end `(face ,face) object))) + +;;; Override `push-mark' +;; +;; Fix duplicates in `mark-ring' and `global-mark-ring' and update +;; buffers in `global-mark-ring' to recentest mark. +(defun helm--advice-push-mark (&optional location nomsg activate) + (unless (null (mark t)) + (let ((marker (copy-marker (mark-marker)))) + (setq mark-ring (cons marker (delete marker mark-ring)))) + (when (> (length mark-ring) mark-ring-max) + ;; Move marker to nowhere. + (set-marker (car (nthcdr mark-ring-max mark-ring)) nil) + (setcdr (nthcdr (1- mark-ring-max) mark-ring) nil))) + (set-marker (mark-marker) (or location (point)) (current-buffer)) + ;; Now push the mark on the global mark ring. + (setq global-mark-ring (cons (copy-marker (mark-marker)) + ;; Avoid having multiple entries + ;; for same buffer in `global-mark-ring'. + (cl-loop with mb = (current-buffer) + for m in global-mark-ring + for nmb = (marker-buffer m) + unless (eq mb nmb) + collect m))) + (when (> (length global-mark-ring) global-mark-ring-max) + (set-marker (car (nthcdr global-mark-ring-max global-mark-ring)) nil) + (setcdr (nthcdr (1- global-mark-ring-max) global-mark-ring) nil)) + (or nomsg executing-kbd-macro (> (minibuffer-depth) 0) + (message "Mark set")) + (when (or activate (not transient-mark-mode)) + (set-mark (mark t))) + nil) + +(defcustom helm-advice-push-mark t + "Override `push-mark' with a version avoiding duplicates when non-nil." + :group 'helm + :type 'boolean + :set (lambda (var val) + (set var val) + (if val + (advice-add 'push-mark :override #'helm--advice-push-mark '((depth . 100))) + (advice-remove 'push-mark #'helm--advice-push-mark)))) + +;; This the version of Emacs-27 written by Stefan +(defun helm-advice--ffap-read-file-or-url (prompt guess) + (or guess (setq guess default-directory)) + (if (ffap-url-p guess) + (read-string prompt guess nil nil t) + (unless (ffap-file-remote-p guess) + (setq guess (abbreviate-file-name (expand-file-name guess)))) + (read-file-name prompt (file-name-directory guess) nil nil + (file-name-nondirectory guess)))) + +;; The native-comp branch of emacs "is a modified Emacs capable of compiling +;; and running Emacs Lisp as native code in form of re-loadable elf files." +;; (https://akrl.sdf.org/gccemacs.html). The function subr-native-elisp-p is a +;; native function available only in this branch and evaluates to true if the +;; argument supplied is a natively compiled lisp function. Use this function +;; if it's available, otherwise return nil. Helm needs to distinguish compiled +;; functions from other symbols in a various places. +(defun helm-subr-native-elisp-p (object) + (when (fboundp 'subr-native-elisp-p) + (subr-native-elisp-p object))) + +;; Available only in Emacs-28+ +(unless (fboundp 'file-modes-number-to-symbolic) + (defun file-modes-number-to-symbolic (mode &optional filetype) + "Return a string describing a file's MODE. +For instance, if MODE is #o700, then it produces `-rwx------'. +FILETYPE if provided should be a character denoting the type of file, +such as `?d' for a directory, or `?l' for a symbolic link and will override +the leading `-' char." + (string + (or filetype + (pcase (ash mode -12) + ;; POSIX specifies that the file type is included in st_mode + ;; and provides names for the file types but values only for + ;; the permissions (e.g., S_IWOTH=2). + + ;; (#o017 ??) ;; #define S_IFMT 00170000 + (#o014 ?s) ;; #define S_IFSOCK 0140000 + (#o012 ?l) ;; #define S_IFLNK 0120000 + ;; (8 ??) ;; #define S_IFREG 0100000 + (#o006 ?b) ;; #define S_IFBLK 0060000 + (#o004 ?d) ;; #define S_IFDIR 0040000 + (#o002 ?c) ;; #define S_IFCHR 0020000 + (#o001 ?p) ;; #define S_IFIFO 0010000 + (_ ?-))) + (if (zerop (logand 256 mode)) ?- ?r) + (if (zerop (logand 128 mode)) ?- ?w) + (if (zerop (logand 64 mode)) + (if (zerop (logand 2048 mode)) ?- ?S) + (if (zerop (logand 2048 mode)) ?x ?s)) + (if (zerop (logand 32 mode)) ?- ?r) + (if (zerop (logand 16 mode)) ?- ?w) + (if (zerop (logand 8 mode)) + (if (zerop (logand 1024 mode)) ?- ?S) + (if (zerop (logand 1024 mode)) ?x ?s)) + (if (zerop (logand 4 mode)) ?- ?r) + (if (zerop (logand 2 mode)) ?- ?w) + (if (zerop (logand 512 mode)) + (if (zerop (logand 1 mode)) ?- ?x) + (if (zerop (logand 1 mode)) ?T ?t))))) + +(unless (and (fboundp 'pos-bol) (fboundp 'pos-eol)) + (defalias 'pos-bol 'line-beginning-position) + (defalias 'pos-eol 'line-end-position)) + +;;; Compatibility with < Emacs-29 +;; Needed by helm-packages.el and affixations functions for helm-mode (27) +;; waiting package.el moves on Elpa. Slightly modified to fit with +;; Emacs-27/28. +(when (eval-when-compile (< emacs-major-version 29)) ; Avoid warnings. + (progn + (require 'package) + (eval-and-compile + (defun package--archives-initialize () + "Make sure the list of installed and remote packages are initialized." + (unless package--initialized + (package-initialize t)) + (unless package-archive-contents + (package-refresh-contents))) + + (defun package-get-descriptor (pkg-name) + "Return the `package-desc' of PKG-NAME." + (unless package--initialized (package-initialize 'no-activate)) + (or (cadr (assq pkg-name package-alist)) + (cadr (assq pkg-name package-archive-contents)))) + + (defun package-upgrade (name) + "Upgrade package NAME if a newer version exists." + (let* ((package (if (symbolp name) + name + (intern name))) + (pkg-desc (cadr (assq package package-alist)))) + ;; `pkg-desc' will be nil when the package is an "active built-in". + (when pkg-desc + (package-delete pkg-desc 'force 'dont-unselect)) + (package-install package + ;; An active built-in has never been "selected" + ;; before. Mark it as installed explicitly. + (and pkg-desc 'dont-select)))) + + (defun package-recompile (pkg) + "Byte-compile package PKG again. +PKG should be either a symbol, the package name, or a `package-desc' +object." + (let ((pkg-desc (if (package-desc-p pkg) + pkg + (cadr (assq pkg package-alist))))) + ;; Delete the old .elc files to ensure that we don't inadvertently + ;; load them (in case they contain byte code/macros that are now + ;; invalid). + (dolist (elc (directory-files-recursively + (package-desc-dir pkg-desc) "\\.elc\\'")) + (delete-file elc)) + (package--compile pkg-desc)))))) + +;;; Provide `help--symbol-class' not available in emacs-27 +;; +(unless (fboundp 'help--symbol-class) + (defun help--symbol-class (s) + "Return symbol class characters for symbol S." + (when (stringp s) + (setq s (intern-soft s))) + (concat + (when (fboundp s) + (concat + (cond + ((commandp s) "c") + ((eq (car-safe (symbol-function s)) 'macro) "m") + (t "f")) + (and (let ((flist (indirect-function s))) + (advice--p (if (eq 'macro (car-safe flist)) (cdr flist) flist))) + "!") + (and (get s 'byte-obsolete-info) "-"))) + (when (boundp s) + (concat + (if (custom-variable-p s) "u" "v") + (and (local-variable-if-set-p s) "'") + (and (ignore-errors (not (equal (symbol-value s) (default-value s)))) "*") + (and (get s 'byte-obsolete-variable) "-"))) + (and (facep s) "a") + (and (fboundp 'cl-find-class) (cl-find-class s) "t")))) + +;; Inline `kmacro--to-vector' from E29 to fix compatibility of +;; `helm-kbd-macro-concat-macros' with E29 and E28. +(unless (fboundp 'kmacro--to-vector) + (defun kmacro--to-vector (object) + "Normalize an old-style key sequence to the vector form." + (if (not (stringp object)) + object + (let ((vec (string-to-vector object))) + (unless (multibyte-string-p object) + (dotimes (i (length vec)) + (let ((k (aref vec i))) + (when (> k 127) + (setf (aref vec i) (+ k ?\M-\C-@ -128)))))) + vec)))) + +(defun helm-proper-list-p (obj) + "Compatibility function for `proper-list-p'." + (if (fboundp 'proper-list-p) + (proper-list-p obj) ; 27+ + (and (listp obj) (not (cdr (last obj)))))) + +;;; Macros helper. +;; +(defmacro helm-with-gensyms (symbols &rest body) + "Bind the SYMBOLS to fresh uninterned symbols and eval BODY." + (declare (indent 1)) + `(let ,(mapcar (lambda (s) + ;; Use cl-gensym here instead of make-symbol + ;; to ensure a symbol that have a live that go + ;; beyond the live of its macro have different name. + ;; i.e symbols created with `with-helm-temp-hook' + ;; should have random names. + `(,s (cl-gensym (symbol-name ',s)))) + symbols) + ,@body)) + +;;; Command loop helper +;; +(defconst helm-this-command-black-list + '(helm-maybe-exit-minibuffer + helm-confirm-and-exit-minibuffer + helm-exit-minibuffer + exit-minibuffer + helm-M-x)) + +(defconst helm-this-command-functions '(read-multiple-choice--long-answers) + "The functions that should be returned by `helm-this-command' when found.") + +(defun helm-this-command () + "Return the actual command in action. +Like `this-command' but return the real command, and not +`exit-minibuffer' or other unwanted functions." + (cl-loop for count from 1 to 50 + for btf = (backtrace-frame count) + for fn = (cl-second btf) + ;; Some commands like `kill-buffer' may call another function + ;; involving a completing-read, in this case we want to stop at this + ;; function and not go up to the initial interactive call (in this + ;; case kill-buffer) See Issue#2634. + if (or (memq fn helm-this-command-functions) + (and + ;; In some cases we may have in the way an + ;; advice compiled resulting in byte-code, + ;; ignore it (Bug#691). + (symbolp fn) + (commandp fn) + (not (memq fn helm-this-command-black-list)))) + return fn + else + if (and (eq fn 'call-interactively) + (> (length btf) 2)) + return (cadr (cdr btf)))) + + +;;; Iterators +;; +(defun helm-iter-list (seq &optional cycle) + "Return an iterator object from SEQ. +The iterator dies and returns nil when it reaches end of SEQ. +When CYCLE is specified the iterator never ends." + (let ((lis seq)) + (lambda () + (let ((elm (car lis))) + (setq lis (if cycle + (or (cdr lis) seq) + (cdr lis))) + elm)))) + +(defun helm-iter-circular (seq) + "Infinite iteration on SEQ." + (helm-iter-list seq 'cycle)) + +(cl-defun helm-iter-sub-next-circular (seq elm &key (test 'eq)) + "Infinite iteration of SEQ starting at ELM." + (let* ((pos (1+ (helm-position elm seq :test test))) + (sub (append (nthcdr pos seq) (helm-take seq pos))) + (iterator (helm-iter-circular sub))) + (lambda () + (helm-iter-next iterator)))) + +(defun helm-iter-next (iterator) + "Return next elm of ITERATOR." + (and iterator (funcall iterator))) + + +;;; Anaphoric macros. +;; +(defmacro helm-aif (test-form then-form &rest else-forms) + "Anaphoric version of `if'. +Like `if' but set the result of TEST-FORM in a temporary variable +called `it'. THEN-FORM and ELSE-FORMS are then executed just like +in `if'." + (declare (indent 2) (debug t)) + `(let ((it ,test-form)) + (if it ,then-form ,@else-forms))) + +(defmacro helm-awhile (sexp &rest body) + "Anaphoric version of `while'. +Same usage as `while' except that SEXP is bound to a temporary +variable called `it' at each turn. +An implicit nil block is bound to the loop so usage of +`cl-return' is possible to exit the loop." + (declare (indent 1) (debug t)) + (helm-with-gensyms (flag) + `(let ((,flag t)) + (cl-block nil + (while ,flag + (helm-aif ,sexp + (progn ,@body) + (setq ,flag nil))))))) + +(defmacro helm-acond (&rest clauses) + "Anaphoric version of `cond'. +In each clause of CLAUSES, the result of the car of clause is +stored in a temporary variable called `it' and usable in the cdr +of this same clause. Each `it' variable is independent of its +clause. The usage is the same as `cond'." + (declare (debug cond)) + (unless (null clauses) + (helm-with-gensyms (sym) + (let ((clause1 (car clauses))) + `(let ((,sym ,(car clause1))) + (helm-aif ,sym + (if (cdr ',clause1) + (progn ,@(cdr clause1)) + it) + (helm-acond ,@(cdr clauses)))))))) + +(defmacro helm-aand (&rest conditions) + "Anaphoric version of `and'. +Each condition is bound to a temporary variable called `it' which +is usable in next condition." + (declare (debug (&rest form))) + (cond ((null conditions) t) + ((null (cdr conditions)) (car conditions)) + (t `(helm-aif ,(car conditions) + (helm-aand ,@(cdr conditions)))))) + +(defmacro helm-acase (expr &rest clauses) + "Check if EXPR match KEYLIST and then execute BODY. + +`helm-acase' is a small macro mixing the features of `cl-case' +and `cond'. + +KEYLIST can be any object that will be compared with `equal' or +an expression starting with special symbol `guard*' which is then +evaluated. Once evaluated the symbol `guard' is bound to the +returned value that can be used in the cdr of clause. When +KEYLIST match EXPR or `guard*' sexp evaluation is non-nil, BODY +is executed and `helm-acase' exits with its value. +Note: +`guard*' sexp should not be a single symbol to eval, e.g. (guard* foo) +in such cases you should use (guard* (progn foo)). + +KEYLIST can also be a list starting with special symbol `dst*' +followed by an expression suitable for `cl-destructuring-bind'. +In this case all elements of `it' are bound to the elements of +this expression e.g. + + (helm-acase \\='(1 2 3 4 5) + ((dst* (l &rest args)) args)) + => (2 3 4 5) + +If KEYLIST is a list, it is compared with EXPR, also each +elements of the list are checked with `member' to see if one +matches EXPR, ensure to not use special symbols `guard*' and +`dst*' at start of such KEYLIST to avoid confusing helm-acase +even if this is partially supported. + +The last clause can use `t' or \\='otherwise as KEYLIST to specify a +fallback clause when previous clauses didn't match, if such a clause +starting with `t' or \\='otherwise is specified before last clause it +will override all next clauses, if you want to match an EXPR value equal +to `t' in any clauses quote it, i.e. `'t' or use an explicit +\(guard* (eq it t)). + +EXPR is bound to a temporary variable called `it' which is +usable in all clauses to refer to EXPR. + +\(fn EXPR (KEYLIST BODY...)...)" + (declare (indent 1) (debug (form &rest ([&or (symbolp form) sexp] body)))) + (unless (null clauses) + (let* ((clause1 (car clauses)) + (key (car clause1)) + (sexp (car-safe (cdr-safe key))) + (sp-sym (car-safe key)) + ;; Ensure dst* and guard* are not treated as special symbols when + ;; they are not followed by one sexp and nothing else, however if the + ;; following sexp is not meant to be evaluated but just compared we + ;; fail miserably, is it worth fixing it? + (issexp (and (consp sexp) (= (length key) 2))) + (isguard (and (eq 'guard* sp-sym) issexp)) + (isdst (and (eq 'dst* sp-sym) issexp)) + (special (or isguard isdst)) + (guard-sexp (and isguard sexp)) + (dst-sexp (and isdst sexp))) + `(let* ((it ,expr) + (guard ,guard-sexp) + (dst (and (consp it) ',dst-sexp))) + (cond ((or guard + (and ,(not special) + (or (equal it ',key) + (and (listp ',key) (member it ',key)))) + (and (symbolp ',key) + (or (eq ',key t) (eq ',key 'otherwise)))) + ;; When this branch is expanded the compiler complains about not + ;; referenced variables (the ones in `dst' that will be used in + ;; next branch) so prevent warnings instead of using a progn + ;; Merci Stefan! + (with-no-warnings ,@(cdr clause1))) + ((and dst + (condition-case nil + (cl-destructuring-bind ,dst-sexp it + ,@(cdr clause1)) + (wrong-number-of-arguments nil)))) + (t + (helm-acase it ,@(cdr clauses)))))))) + +;;; Fuzzy matching routines +;; +(defsubst helm--mapconcat-pattern (pattern) + "Transform string PATTERN in regexp for further fuzzy matching. +E.g.: helm.el$ + => \"[^h]*h[^e]*e[^l]*l[^m]*m[^.]*\\\\.[^e]*e[^l]*l$\" + ^helm.el$ + => \"helm\\\\.el$\"." + (let ((ls (split-string-and-unquote pattern ""))) + (if (string= "^" (car ls)) + ;; Exact match. + (mapconcat (lambda (c) + (if (and (string= c "$") + (string-match "$\\'" pattern)) + c (regexp-quote c))) + (cdr ls) "") + ;; Fuzzy match. + (mapconcat (lambda (c) + (if (and (string= c "$") + (string-match "$\\'" pattern)) + c (format "[^%s]*%s" c (regexp-quote c)))) + ls "")))) + +(defsubst helm--collect-pairs-in-string (string) + ;; We want to collect e.g. + ;; in "abcd" -> (("a" "b") ("b" "c") ("c" "d")) + ;; and not (("a" "b") ("c" "d")) so we use by #'cdr which is the default. + ;; If the last pair have no cdr i.e. (s1 nil) ignore it. + (cl-loop for (s1 s2) on (split-string string "" t) + when s2 collect (list s1 s2))) + +;;; Help routines. +;; +(defvar helm-help--iter-org-state nil) + +(defvar helm-help-mode-before-hook nil + "A hook that runs before helm-help starts.") + +(defvar helm-help-mode-after-hook nil + "A hook that runs when helm-help exits.") + +(defcustom helm-help-default-prompt + "[SPC,C-v,next:ScrollUp b,M-v,prior:ScrollDown TAB:Cycle M-TAB:All C-s/r:Isearch q:Quit]" + "The prompt used in `helm-help'." + :type 'string + :group 'helm) + +(defcustom helm-help-hkmap + '(("C-v" . helm-help-scroll-up) + ("SPC" . helm-help-scroll-up) + ("" . helm-help-scroll-up) + ("M-v" . helm-help-scroll-down) + ("b" . helm-help-scroll-down) + ("" . helm-help-scroll-down) + ("C-s" . isearch-forward) + ("C-r" . isearch-backward) + ("C-a" . move-beginning-of-line) + ("C-e" . move-end-of-line) + ("C-f" . forward-char) + ("" . forward-char) + ("C-b" . backward-char) + ("" . backward-char) + ("C-n" . helm-help-next-line) + ("C-p" . helm-help-previous-line) + ("" . helm-help-next-line) + ("" . helm-help-previous-line) + ("M-a" . backward-sentence) + ("M-e" . forward-sentence) + ("M-f" . forward-word) + ("M-b" . backward-word) + ("M->" . end-of-buffer) + ("C-M-f" . forward-sexp) + ("C-M-b" . backward-sexp) + ("M-<" . beginning-of-buffer) + ("C-SPC" . helm-help-toggle-mark) + ("C-M-SPC" . mark-sexp) + ("TAB" . org-cycle) + ("C-m" . helm-help-org-open-at-point) + ("C-&" . helm-help-org-mark-ring-goto) + ("C-%" . org-mark-ring-push) + ("M-TAB" . helm-help-org-cycle) + ("M-w" . helm-help-copy-region-as-kill) + ("q" . helm-help-quit)) + "Alist of (KEY . FUNCTION) for `helm-help'. + +This is not a standard keymap, just an alist where it is possible to +define a simple KEY (a string with no spaces) associated with a +FUNCTION. More complex key like \"C-x C-x\" are not supported. +Interactive functions will be called interactively whereas other +functions will be called with funcall except commands that are in +`helm-help-not-interactive-command'. +For convenience you can add bindings here with `helm-help-define-key'." + :type '(alist :key-type string :key-value symbol) + :group 'helm) + +(defvar helm-help-not-interactive-command '(isearch-forward isearch-backward) + "Commands that we don't want to call interactively in `helm-help'.") + +(defun helm-help-internal (bufname insert-content-fn) + "Show long message during Helm session in BUFNAME. +INSERT-CONTENT-FN is the function that inserts text to be +displayed in BUFNAME." + (let ((winconf (current-frame-configuration)) + (hframe (selected-frame))) + (helm-log-run-hook "helm-help-internal" 'helm-help-mode-before-hook) + (with-selected-frame helm-initial-frame + (select-frame-set-input-focus helm-initial-frame) + (unwind-protect + (progn + (setq helm-suspend-update-flag t) + (set-buffer (get-buffer-create bufname)) + (switch-to-buffer bufname) + (when helm-help-full-frame (delete-other-windows)) + (delete-region (point-min) (point-max)) + (org-mode) + (save-excursion + (funcall insert-content-fn) + (goto-char (point-min)) + (while (re-search-forward "^[|]" nil t) + (when (org-table-p t) + (org-table-align) + (goto-char (org-table-end))))) + (org-mark-ring-push) ; Put mark at bob + (buffer-disable-undo) + (helm-help-event-loop)) + (raise-frame hframe) + (helm-log-run-hook "helm-help-internal" 'helm-help-mode-after-hook) + (setq helm-suspend-update-flag nil) + (set-frame-configuration winconf))))) + +(cl-defun helm-help-scroll-up (&optional (amount helm-scroll-amount)) + "Scroll up in `helm-help'." + (condition-case _err + (scroll-up-command amount) + (beginning-of-buffer nil) + (end-of-buffer nil))) + +(cl-defun helm-help-scroll-down (&optional (amount helm-scroll-amount)) + "Scroll down in `helm-help'." + (condition-case _err + (scroll-down-command amount) + (beginning-of-buffer nil) + (end-of-buffer nil))) + +(defun helm-help-next-line () + "Next line function for `helm-help'." + (condition-case _err + (call-interactively #'next-line) + (beginning-of-buffer nil) + (end-of-buffer nil))) + +(defun helm-help-previous-line () + "Previous line function for `helm-help'." + (condition-case _err + (call-interactively #'previous-line) + (beginning-of-buffer nil) + (end-of-buffer nil))) + +(defun helm-help-toggle-mark () + "Toggle mark in `helm-help'." + (if (region-active-p) + (deactivate-mark) + (push-mark nil nil t))) + +(defun helm-help-org-cycle () + "Runs `org-cycle' in `helm-help'." + (helm-acase (helm-iter-next helm-help--iter-org-state) + ((guard* (numberp it)) (org-content)) + ;; See `helm--help-org-prefargs' about `org-cycle' ARG. + (t (org-cycle it)))) + +(defun helm-help-copy-region-as-kill () + "Copy region function for `helm-help'" + (copy-region-as-kill + (region-beginning) (region-end)) + (deactivate-mark)) + +(defun helm-help-quit () + "Quit `helm-help'." + (if (or (get-buffer-window helm-help-buffer-name 'visible) + (get-buffer-window helm-debug-output-buffer 'visible)) + (throw 'helm-help-quit nil) + (quit-window))) + +(defun helm-help-org-open-at-point () + "Calls `org-open-at-point' ignoring errors." + (ignore-errors + (org-open-at-point))) + +(defun helm-help-org-mark-ring-goto () + "Calls `org-mark-ring-goto' ignoring errors." + (ignore-errors + (org-mark-ring-goto))) + +(defvar helm--help-org-prefargs + (if (> emacs-major-version 28) + '(1 (4) (16)) '(1 (16) (64))) + "`org-cycle' ARG have not the same meaning across Emacs versions.") + +(defun helm-help-event-loop () + "The loop in charge of scanning keybindings in `helm-help'." + (let ((prompt (propertize + helm-help-default-prompt + 'face 'helm-helper)) + scroll-error-top-bottom + (helm-help--iter-org-state (helm-iter-circular helm--help-org-prefargs))) + (catch 'helm-help-quit + (helm-awhile (read-key prompt) + (let ((fun (cl-loop for (k . v) in helm-help-hkmap + when (eql (aref (kbd k) 0) it) + return v))) + (when fun + (if (and (commandp fun) + (not (memq fun helm-help-not-interactive-command))) + ;; For movement of cursor in help buffer we need to + ;; call interactively commands for impaired people + ;; using a synthetizer (Bug#1347). + (call-interactively fun) + (funcall fun)))))))) + +(defun helm-help-define-key (key function &optional override) + "Add KEY bound to fUNCTION in `helm-help-hkmap'. + +If OVERRIDE is non nil, all bindings associated with FUNCTION are +removed and only (KEY . FUNCTION) is kept. +If FUNCTION is nil (KEY . FUNCTION) is not added and removed from +alist if already present. +See `helm-help-hkmap' for supported keys and functions." + (cl-assert (not (cdr (split-string key))) nil + (format "Error: Unsuported key `%s'" key)) + (when override + (helm-awhile (rassoc function helm-help-hkmap) + (setq helm-help-hkmap (delete it helm-help-hkmap)))) + (helm-aif (and (null function) (assoc key helm-help-hkmap)) + (setq helm-help-hkmap (delete it helm-help-hkmap)) + (and function (add-to-list 'helm-help-hkmap `(,key . ,function))))) + +;;; Multiline transformer +;; +(defun helm-multiline-transformer (candidates _source) + (cl-loop with offset = (helm-interpret-value + (assoc-default 'multiline (helm-get-current-source))) + for cand in candidates + for disp = (or (car-safe cand) cand) + for real = (or (cdr-safe cand) cand) + if (numberp offset) + collect (cons (helm--multiline-get-truncated-candidate disp offset) + real) + else collect (cons disp real))) + +(defun helm--multiline-get-truncated-candidate (candidate offset) + "Truncate CANDIDATE when its length is > than OFFSET." + (with-temp-buffer + (insert candidate) + (goto-char (point-min)) + (if (and offset + (> (buffer-size) offset)) + (let ((end-str "[...]")) + (concat + (buffer-substring + (point) + (save-excursion + (forward-char offset) + (setq end-str (if (looking-at "\n") + end-str (concat "\n" end-str))) + (point))) + end-str)) + (buffer-string)))) + +;;; List processing +;; +(defun helm-flatten-list (seq) + "Return a list of all single elements of sublists in SEQ. + + Example: + (helm-flatten-list \\='(1 (2 . 3) nil (4 5 (6) 7) 8 (9 . 10))) + => (1 2 3 4 5 6 7 8 9 10)" + (let (result) + (cl-labels ((flatten + (seq) + (cl-loop for elm in seq + if (consp elm) + do (flatten + (if (atom (cdr elm)) + (list (car elm) (cdr elm)) + elm)) + else do (and elm (push elm result))))) + (flatten seq)) + (nreverse result))) + +(defun helm-mklist (obj) + "Return OBJ as a proper list. +Otherwise make a proper list with one element OBJ. +Anonymous functions (lambdas) are treated as single elements." + (if (and (helm-proper-list-p obj) (not (functionp obj))) + obj + (list obj))) + +(cl-defun helm-fast-remove-dups (seq &key (test 'eq)) + "Remove duplicates elements in list SEQ. + +This is same as `remove-duplicates' but with memoisation. +It is much faster, especially in large lists. +A test function can be provided with TEST argument key. +Default is `eq'. +NOTE: Comparison of special Elisp objects (e.g., markers etc.) +fails because their printed representations which are stored in +hash-table can't be compared with with the real object in SEQ. +This is a bug in `puthash' which store the printable +representation of object instead of storing the object itself, +this to provide at the end a printable representation of +hashtable itself." + (let ((table (make-hash-table :test test))) + (mapcan (lambda (x) + (unless (gethash x table) + (list (puthash x x table)))) + seq))) + +(defsubst helm--string-join (strings &optional separator) + "Join all STRINGS using SEPARATOR." + (mapconcat 'identity strings separator)) + +(defun helm--concat-regexps (regexp-list) + "Return a regexp which matches any of the regexps in REGEXP-LIST." + (if regexp-list + (concat "\\(?:" (helm--string-join regexp-list "\\)\\|\\(?:") "\\)") + "\\`\\'")) ; Match nothing + +(defun helm-skip-entries (seq black-regexp-list &optional white-regexp-list) + "Remove entries which match one of REGEXP-LIST from SEQ." + (let ((black-regexp (helm--concat-regexps black-regexp-list)) + (white-regexp (helm--concat-regexps white-regexp-list))) + (cl-loop for i in seq + unless (and (stringp i) + (string-match-p black-regexp i) + (null + (string-match-p white-regexp i))) + collect i))) + +(defun helm-boring-directory-p (directory black-list) + "Check if one regexp in BLACK-LIST matches DIRECTORY." + (helm-awhile (helm-basedir (directory-file-name + (expand-file-name directory))) + ;; Break at root to avoid infloop, root is / or on Windows + ;; C:/ i.e. :/ (Bug#2308). + (when (string-match-p "\\`[A-Za-z]?:?/\\'" it) + (cl-return nil)) + (when (cl-loop for r in black-list + thereis (string-match-p + r (directory-file-name directory))) + (cl-return t)) + (setq directory it))) + +(defun helm-shadow-entries (seq regexp-list) + "Put shadow property on entries in SEQ matching a regexp in REGEXP-LIST." + (let ((face 'italic)) + (cl-loop for i in seq + if (cl-loop for regexp in regexp-list + thereis (and (stringp i) + (string-match regexp i))) + collect (propertize i 'face face) + else collect i))) + +(defun helm-remove-if-not-match (regexp seq) + "Remove all elements of SEQ that don't match REGEXP." + (cl-loop for s in seq + for str = (cond ((symbolp s) + (symbol-name s)) + ((consp s) + (car s)) + (t s)) + when (string-match-p regexp str) + collect s)) + +(defun helm-remove-if-match (regexp seq) + "Remove all elements of SEQ that match REGEXP." + (cl-loop for s in seq + for str = (cond ((symbolp s) + (symbol-name s)) + ((consp s) + (car s)) + (t s)) + unless (string-match-p regexp str) + collect s)) + +(defun helm-transform-mapcar (fn seq) + "Apply function FN on all elements of list SEQ. +When SEQ is a list of cons cells apply FN on the cdr of each element, +keeping their car unmodified. + +Examples: + + (helm-transform-mapcar \\='upcase \\='(\"foo\" \"bar\")) + => (\"FOO\" \"BAR\") + (helm-transform-mapcar \\='upcase \\='((\"1st\" . \"foo\") (\"2nd\" . \"bar\"))) + => ((\"1st\" . \"FOO\") (\"2nd\" . \"BAR\")) +" + (cl-loop for elm in seq + if (consp elm) + collect (cons (car elm) (funcall fn (cdr elm))) + else + collect (funcall fn elm))) + +(defun helm-append-at-nth (seq elm index) + "Append ELM at INDEX in SEQ. +When INDEX is > to the SEQ length ELM is added at end of SEQ. +When INDEX is 0 or negative, ELM is added at beginning of SEQ. + +Examples: + + (helm-append-at-nth \\='(a b c d) \\='(z) 2) + =>(a b z c d) + + (helm-append-at-nth \\='(a b c d) \\='((x . 1) (y . 2)) 2) + =>(a b (x . 1) (y . 2) c d) + + (helm-append-at-nth \\='((a . 1) (b . 2) (c . 3)) \\='(x . 1) 1) + =>((a . 1) (x . 1) (b . 2) (c . 3)) +" + (setq index (min (max index 0) (length seq)) + elm (helm-mklist elm)) + (if (zerop index) + (append elm seq) + (let* ((end-part (nthcdr index seq)) + (len (length end-part)) + (beg-part (butlast seq len))) + (append beg-part elm end-part)))) + +;;;###autoload +(defun helm-add-to-list (var elm index &optional replace) + "Add or move ELM to the value of VAR at INDEX unless already here. + +If ELM is member of var value and at index INDEX, return var value +unchanged, if INDEX value is different move ELM at this `nth' INDEX value. +If ELM is not present in list add it at `nth' INDEX. + +If REPLACE is non nil replace element at INDEX by ELM. + +Do not use this function in helm code, use `helm-append-at-nth' +instead. It is meant to be used in config files only." + (cl-assert (boundp var) nil "Unbound variable `%s'" var) + (let ((val (symbol-value var)) + flag) + (cond ((and (member elm val) (equal elm (nth index val)))) + ((member elm val) + (setq val (delete elm val) flag t)) + ((and replace (not (< index 0)) (not (> index (length val)))) + (setq val (delete (nth index val) val) flag t)) + (t (setq flag t))) + (if flag + (set var (helm-append-at-nth val elm index)) + val))) + +(cl-defgeneric helm-take (seq n) + "Return the first N elements of SEQ if SEQ is longer than N. +It is used for narrowing list of candidates to the +`helm-candidate-number-limit'." + (if (> (length seq) n) (cl-subseq seq 0 n) seq)) + +(cl-defmethod helm-take ((seq list) n) + "`helm-take' optimized for lists." + (let ((store '())) + (if (> n (length seq)) + seq + (while (> (1+ (cl-decf n)) 0) + (push (pop seq) store)) + (nreverse store)))) + +(defalias 'helm-take-first-elements 'helm-take) +(make-obsolete 'helm-take-first-elements 'helm-take "3.9.1") + +(defun helm-source-by-name (name &optional sources) + "Get a Helm source in SOURCES by NAME. + +Optional argument SOURCES is a list of Helm sources which default +to `helm-sources'." + (cl-loop with src-list = (if sources + (cl-loop for src in sources + collect (if (listp src) + src + (symbol-value src))) + helm-sources) + for source in src-list + thereis (and (string= name (assoc-default 'name source)) source))) + +(defun helm-make-actions (&rest args) + "Build an alist with (NAME . ACTION) elements with each pairs in ARGS. +Where NAME is a string or a function returning a string or nil +and ACTION a function. +If NAME returns nil the pair is skipped. + +\(fn NAME ACTION ...)" + (cl-loop for (name fn) on args by #'cddr + when (functionp name) + do (setq name (funcall name)) + when name + collect (cons name fn))) + +(defun helm-closest-number-in-list (num list) + "Return closest number to NUM found in LIST. +LIST is a list of numbers and NUM a number." + (cl-loop for i in list + for diff = (if (> num i) (- num i) (- i num)) + collect (cons diff i) into res + minimize diff into min + finally return (cdr (assq min res)))) + +(defun helm-group-candidates-by (candidates function &optional selection separate) + "Group similar items in CANDIDATES according to FUNCTION. +Items not matching FUNCTION are grouped as well in a separate group. + +Example: + + (setq B \\='(1 2 3 4 5 6 7 8 9)) + + (helm-group-candidates-by B #\\='cl-oddp 2 \\='separate) + => ((2 4 6 8) (1 3 5 7 9)) + +SELECTION specify where to start in CANDIDATES. +Similar candidates to SELECTION will be listed on top. + +If SEPARATE is non-nil returns a list of groups i.e. a list of lists, +otherwise a plain list is returned." + (cl-loop with sel = (or selection (helm-get-selection) "") + with lst = (copy-sequence candidates) + while lst + for group = (cl-loop for c in lst + when (equal (funcall function c) + (funcall function sel)) + collect c into grp + and do (setq lst (delete c lst)) + finally return (prog1 grp + (setq sel (car lst)))) + if separate collect group + else append group)) + +(defun helm-reorganize-sequence-from-elm (sequence elm &optional reverse) + "Reorganize SEQUENCE from ELM. + +Examples: + + (helm-reorganize-sequence-from-elm \\='(a b c d e f g h i j k l) \\='e) + => (f g h i j k l a b c d e) + (helm-reorganize-sequence-from-elm \\='(a b c d e f g h i j k l) \\='e t) + => (d c b a l k j i h g f e) +" + (let* ((new-seq (if reverse + (reverse sequence) + sequence)) + (pos (1+ (helm-position elm new-seq :test 'equal)))) + (append (nthcdr pos new-seq) (helm-take new-seq pos)))) + +(cl-defun helm-position (elm seq &key (test 'eq) from-end) + "Return position of ELM in SEQ. +Comparison is tested with keyword TEST which default to `eq'. +If keyword FROM-END is non nil search from end." + (let ((count (if from-end (1- (length seq)) 0))) + (while (if from-end + (not (zerop count)) + (<= count (1- (length seq)))) + (when (funcall test (if (listp seq) + (car (nthcdr count seq)) + (aref seq count)) + elm) + (cl-return-from helm-position count)) + (setq count (funcall (if from-end #'1- #'1+) count))))) + +(defsubst helm-copy-sequence (seq) + "Return a copy of SEQ. +When the elements of SEQ are strings, they are +copied; they are not shared with the original. +Otherwise returns SEQ unchanged, the elements are not copied." + (cl-loop for elm in seq collect + (if (stringp elm) + (copy-sequence elm) + elm))) + +;;; Strings processing. +;; +(defun helm-stringify (elm) + "Return the representation of ELM as a string. +ELM can be a string, a number or a symbol." + (helm-acase elm + ((guard* (stringp it)) it) + ((guard* (numberp it)) (number-to-string it)) + ((guard* (symbolp it)) (symbol-name it)))) + +(defun helm-substring (str width) + "Return the substring of string STR from 0 to WIDTH. +Handle multibyte characters by moving by columns." + (with-temp-buffer + (save-excursion + (insert str)) + (move-to-column width) + (buffer-substring (pos-bol) (point)))) + +(defun helm-substring-by-width (str width &optional endstr) + "Truncate string STR to end at column WIDTH. +Similar to `truncate-string-to-width'. +Add ENDSTR at end of truncated STR. +Add spaces at end if needed to reach WIDTH when STR is shorter +than WIDTH." + (cl-loop for ini-str = str + then (substring ini-str 0 (1- (length ini-str))) + for sw = (string-width ini-str) + when (<= sw width) return + (concat ini-str endstr (make-string (- width sw) ? )))) + +(defun helm-string-multibyte-p (str) + "Check if string STR contains multibyte characters." + (cl-loop for c across str + thereis (> (char-width c) 1))) + +(defun helm-get-pid-from-process-name (process-name) + "Get pid from running process PROCESS-NAME." + ;; Protect system processes calls (Issue #2497) + ;; Ensure `list-system-processes' and `process-attributes' don't run + ;; on remote (only Emacs-28/29+). + (cl-loop with default-directory = temporary-file-directory + with process-list = (list-system-processes) + for pid in process-list + for process = (assoc-default 'comm (process-attributes pid)) + when (and process (string-match process-name process)) + return pid)) + +(defun helm-ff-find-printers () + "Return a list of available printers on Unix systems." + (when (executable-find "lpstat") + (let ((printer-list (with-temp-buffer + (call-process "lpstat" nil t nil "-a") + (split-string (buffer-string) "\n")))) + (cl-loop for p in printer-list + for printer = (car (split-string p)) + when printer + collect printer)))) + +(defun helm-region-active-p () + (and transient-mark-mode mark-active (/= (mark) (point)))) + +(defun helm-quote-whitespace (candidate) + "Quote whitespace, if some, in string CANDIDATE." + (replace-regexp-in-string " " "\\\\ " candidate)) + +(defun helm-current-line-contents () + "Current line string without properties." + (buffer-substring-no-properties (pos-bol) (pos-eol))) + +(defun helm--replace-regexp-in-buffer-string (regexp rep str &optional fixedcase literal subexp start) + "Replace REGEXP by REP in string STR. + +Same as `replace-regexp-in-string' but handle properly REP as +function with SUBEXP specified. + +E.g.: + + (helm--replace-regexp-in-buffer-string + \"e\\\\(m\\\\)acs\" \\='upcase \"emacs\" t nil 1) + => \"eMacs\" + + (replace-regexp-in-string + \"e\\\\(m\\\\)acs\" \\='upcase \"emacs\" t nil 1) + => \"eEMACSacs\" + +Also START argument behaves as expected unlike +`replace-regexp-in-string'. + +E.g.: + + (helm--replace-regexp-in-buffer-string \"f\" \"r\" \"foofoo\" t nil nil 3) + => \"fooroo\" + + (replace-regexp-in-string \"f\" \"r\" \"foofoo\" t nil nil 3) + => \"roo\" + +Unlike `replace-regexp-in-string' this function is buffer-based +implemented i.e. replacement is computed inside a temp buffer, so +REGEXP should be used differently than with +`replace-regexp-in-string'. + +NOTE: This function is used internally for +`helm-ff-query-replace-on-filenames' and builded for this. +You should use `replace-regexp-in-string' instead unless the +behaviour of this function is really needed." + (with-temp-buffer + (insert str) + (goto-char (or start (point-min))) + (while (re-search-forward regexp nil t) + (replace-match (cond ((and (functionp rep) subexp) + (funcall rep (match-string subexp))) + ((functionp rep) + (funcall rep str)) + (t rep)) + fixedcase literal nil subexp)) + (buffer-string))) + +(defun helm-url-unhex-string (str) + "Same as `url-unhex-string' but ensure STR is completely decoded." + (setq str (or str "")) + (with-temp-buffer + (save-excursion (insert str)) + (while (re-search-forward "%[A-Za-z0-9]\\{2\\}" nil t) + (replace-match (byte-to-string (string-to-number + (substring (match-string 0) 1) + 16)) + t t) + ;; Restart from beginning until string is completely decoded. + (goto-char (point-min))) + (decode-coding-string (buffer-string) 'utf-8))) + +(cl-defun helm-read-answer (prompt answer-list + &optional (help 'helm-read-answer-default-help-fn)) + "Prompt user for an answer. +Arg PROMPT is the prompt to present user the different possible +answers, ANSWER-LIST is a list of strings. +If user enters an answer which is one of ANSWER-LIST return this +answer, otherwise keep prompting for a valid answer. +Note that answer should be a single char, only short answer are +accepted. +When HELP is provided, it is a string or a function that returns a string +which will be displayed in a buffer when \"h\" +is pressed (don't forget to add \"h\" in prompt). + +Example: + + (helm-acase (helm-read-answer + \"answer [y,n,!,q,h]: \" + \\='(\"y\" \"n\" \"!\" \"q\")) + (\"y\" \"yes\") + (\"n\" \"no\") + (\"!\" \"all\") + (\"q\" \"quit\")) + +" + (unwind-protect + (helm-awhile (read-key (propertize + prompt 'face 'minibuffer-prompt)) + (let ((str (and (characterp it) (string it))) + (choices (remove "h" answer-list))) + (cond ((and str (member str choices)) + (cl-return str)) + ((and help (string= str "h")) + (helm-aif (get-buffer-window "*choices help*" 'visible) + (quit-window t it) + (with-current-buffer-window "*choices help*" + '(display-buffer-at-bottom + (window-height . fit-window-to-buffer) + (preserve-size . (nil . t))) + nil (progn + (insert (if (functionp help) + (funcall help) help)) + (setq-local cursor-type nil))))) + (t (message "Please answer by %s" + (mapconcat 'identity choices ", ")) + (sit-for 1))))) + (helm-aand help (get-buffer-window "*choices help*") (quit-window t it)))) + +(defun helm-read-answer-default-help-fn () + "Return a string suitable for `helm-read-answer' help." + (with-temp-buffer + (save-excursion + (insert "y: yes\n" + "n: no\n" + "!: yes for all\n" + "q: quit\n" + "h: toggle this help")) + (while (re-search-forward "^\\(.\\):" nil t) + (helm-add-face-text-properties (match-beginning 1) (match-end 1) + 'font-lock-variable-name-face)) + (buffer-string))) + +(defun helm-read-answer-dolist-with-action (prompt list action + &optional + prompt-formater + help-function) + "Read answer with PROMPT and execute ACTION on each element of LIST. + +Argument PROMPT is a format spec string e.g. \"Do this on %s?\" +which take each elements of LIST as argument, no need to provide +the help part i.e. [y,n,!,q] it will be already added. + +While looping through LIST, ACTION is executed on each elements +differently depending of answer: + +- y Execute ACTION on element. +- n Skip element. +- ! Don't ask anymore and execute ACTION on remaining elements. +- q Skip all remaining elements. + +PROMPT-FORMATER may be a function or a list containing strings and +functions. Functions either in list or alone are called on each element +in LIST to be displayed in PROMPT." + (let (dont-ask) + (catch 'break + (dolist (elm list) + (if dont-ask + (funcall action elm) + (helm-acase (helm-read-answer + (apply #'format + (concat prompt "[y,n,!,q,h]") + (helm-acase prompt-formater + ((guard* (consp it)) + (mapcar (lambda (x) + (if (functionp x) + (funcall x elm) + x)) + it)) + ((guard* (functionp it)) + (list (funcall it elm))) + (t (list elm)))) + '("y" "n" "!" "q") + (or help-function #'helm-read-answer-default-help-fn)) + ("y" (funcall action elm)) + ("n" (ignore)) + ("!" (prog1 + (funcall action elm) + (setq dont-ask t))) + ("q" (throw 'break nil)))))))) + +(defsubst helm-string-numberp (str) + "Return non nil if string STR represent a number." + (cl-assert (stringp str) t) + (cl-loop with chars = '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9) + for c across str always (memql c chars))) + +(defsubst helm-re-search-forward (regexp &optional bound noerror count) + "Same as `re-search-forward' but return nil when point doesn't move. +This avoid possible infloop when a wrong regexp is entered in minibuffer." + ;; See Issue#2652 and Issue#2653. + (let ((pos (point))) + (helm-acase (re-search-forward regexp bound noerror count) + ((guard* (eql it pos)) nil) + (t it)))) + +;;; Symbols routines +;; +(defun helm-symbolify (str-or-sym) + "Get symbol of STR-OR-SYM." + (helm-acase str-or-sym + ((guard* (symbolp it)) it) + ("" nil) + (t (intern it)))) + +(defun helm-symbol-name (obj) + "Return name of OBJ. +If object is a lambda, return \"Anonymous\"." + ;; lambdas are no more represented as list in + ;; Emacs-29+ Bug#2666. + (if (or (and (not (symbolp obj)) (functionp obj)) + (byte-code-function-p obj) + (helm-subr-native-elisp-p obj)) + "Anonymous" + (symbol-name obj))) + +(defun helm-describe-class (class) + "Display documentation of Eieio CLASS, a symbol or a string." + (cl-letf (((symbol-function 'cl--print-table) + #'helm-source--cl--print-table)) + (if (fboundp 'cl-describe-type) + (cl-describe-type (helm-symbolify class)) + (let ((helm-describe-function-function 'describe-function)) + (helm-describe-function (helm-symbolify class)))))) + +(defun helm-elisp-collect-slots-in-class (class) + (with-temp-buffer + (cl-letf (((symbol-function 'cl--print-table) + #'helm-source--cl--print-table)) + (cl--describe-class-slots (cl--find-class class)) + (goto-char (point-min)) + (cl-loop while (re-search-forward "^\\* \\(.*\\)" nil t) + for name = (match-string 1) + for doc = (save-excursion + (forward-line 1) + (let ((beg (point)) + (end (when (re-search-forward "^\\*" nil t) + (1- (match-beginning 0))))) + (when (and beg end) + (buffer-substring beg end)))) + collect (cons name (concat "* " name "\n" doc)))))) + +(defun helm-describe-function (func) + "Display documentation of FUNC, a symbol or string." + (cl-letf (((symbol-function 'message) #'ignore)) + (funcall helm-describe-function-function (helm-symbolify func)))) + +(defun helm-describe-variable (var) + "Display documentation of VAR, a symbol or a string." + (cl-letf (((symbol-function 'message) #'ignore)) + (funcall helm-describe-variable-function (helm-symbolify var)))) + +(defun helm-describe-symbol (sym) + "Display documentation of SYM, a symbol or a string." + (cl-letf (((symbol-function 'message) #'ignore)) + (let ((helm-describe-function-function 'describe-symbol)) + (funcall helm-describe-function-function (helm-symbolify sym))))) + +(defun helm-describe-face (face) + "Display documentation of FACE, a symbol or a string." + (let ((faces (helm-marked-candidates))) + (cl-letf (((symbol-function 'message) #'ignore)) + (describe-face (if (cdr faces) + (mapcar 'helm-symbolify faces) + (helm-symbolify face)))))) + +(defun helm-describe-re-char-classes-1 (exp) + (helm-acase exp + (":xdigit:" + (format "%s +This matches the hexadecimal digits. +‘0’ through ‘9’, ‘a’ through ‘f’ and ‘A’ through ‘F’." it)) + (":word:" + (format "%s +This matches any character that has word syntax. +Note that the syntax of a character, and thus which characters are considered +“word-constituent”, depends on the major mode." it)) + (":upper:" + (format "%s +This matches any upper-case letter. +It is determined by the current case table. +If ‘case-fold-search’ is non-‘nil’, this +also matches any lower-case letter. Note that a buffer can have +its own local case table different from the default one." it)) + (":unibyte:" + (format "%s +This matches any unibyte character." it)) + (":space:" + (format "%s +This matches any character that has whitespace syntax. +Note that the syntax of a character, and thus +which characters are considered “whitespace”, depends on the major mode." it)) + (":punct:" + (format "%s +This matches any punctuation character. +At present, for multibyte characters, it matches anything that has non-word syntax, +and thus its exact definition can vary from one major mode to another, since +the syntax of a character depends on the major mode.)" it)) + (":print:" + (format "%s +This matches any printing character. +Either spaces or graphic characters matched by ‘[:graph:]’." it)) + (":nonascii:" + (format "%s +This matches any non-ASCII character." it)) + (":multibyte:" + (format "%s +This matches any multibyte character." it)) + (":lower:" + (format "%s +This matches any lower-case letter. +It is determined by the current case table. +If ‘case-fold-search’ is non-‘nil’, this also matches +any upper-case letter. Note that a buffer can have its own local +case table different from the default one." it)) + (":graph:" + (format "%s +This matches graphic characters. +Everything except spaces, ASCII and +non-ASCII control characters, surrogates, and codepoints unassigned +by Unicode, as indicated by the Unicode ‘general-category’ property." it)) + (":digit:" + (format "%s +This matches ‘0’ through ‘9’. +Thus, ‘[-+[:digit:]]’ matches any digit,as well as ‘+’ and ‘-’." it)) + (":cntrl:" + (format "%s +This matches any cntrl character. +That is any character whose code is in the range 0–31." it)) + (":blank:" + (format "%s +This matches horizontal whitespace. +It is defined by Annex C of the Unicode Technical Standard #18. +In particular, it matches spaces,tabs, +and other characters whose Unicode ‘general-category’ +property indicates they are spacing separators." it)) + (":alpha:" + (format "%s +This matches any letter. +For multibyte characters, it matches characters +whose Unicode ‘general-category’ property indicates +they are alphabetic characters." it)) + (":alnum:" + (format "%s +This matches any letter or digit. +For multibyte characters, it matches characters +whose Unicode ‘general-category’ property +indicates they are alphabetic or decimal number characters." it)) + (":ascii:" + (format "%s +This matches any ASCII character (codes 0–127)." it)))) + +(defun helm-describe-re-char-classes (exp) + "Describe Char Classes for regexps." + (with-output-to-temp-buffer "*help*" + (princ (helm-describe-re-char-classes-1 exp)))) + +(defun helm-elisp--persistent-help (candidate fun &optional name) + "Used to build persistent actions describing CANDIDATE with FUN. +Argument NAME is used internally to know which command to use +when symbol CANDIDATE refers at the same time to a variable and a +function. +See `helm-elisp-show-help'." + (let ((hbuf (get-buffer (help-buffer)))) + (cond ((helm-follow-mode-p) + (if name + (funcall fun candidate name) + (funcall fun candidate))) + ((or (and (helm-get-attr 'help-running-p) + (string= candidate (helm-get-attr 'help-current-symbol)))) + (progn + ;; When started from a help buffer, + ;; Don't kill this buffer as it is helm-current-buffer. + (unless (equal hbuf helm-current-buffer) + (kill-buffer hbuf) + (set-window-buffer (get-buffer-window hbuf) + ;; It is generally + ;; helm-current-buffer but it may + ;; be another buffer when helm have + ;; been started from a dedicated window. + (if helm--buffer-in-new-frame-p + helm-current-buffer + helm-persistent-action-window-buffer))) + (helm-set-attr 'help-running-p nil)) + ;; Force running update hook to may be delete + ;; helm-persistent-action-display-window, this is done in + ;; helm-persistent-action-display-window (the function). + (unless helm--buffer-in-new-frame-p + (helm-update (regexp-quote (helm-get-selection))))) + (t + (if name + (funcall fun candidate name) + (funcall fun candidate)) + (helm-set-attr 'help-running-p t))) + (helm-set-attr 'help-current-symbol candidate))) + +(defcustom helm-find-function-default-project nil + "Default directories to search symbols definitions from `helm-apropos'. +A list of directories or a single directory name. +Helm will allow you selecting one of those directories with `M-n' when +using a prefix arg with the `find-function' action in `helm-apropos'. +This is a good idea to add the directory names of the projects you are +working on to quickly jump to the definitions in the project source +files instead of jumping to the loaded files located in `load-path'." + :type '(choice (repeat string) + string) + :group 'helm-elisp) + +(defun helm-find-function-noselect (func &optional root-dir type) + "Find FUNC definition without selecting buffer. +FUNC can be a symbol or a string. +Instead of looking in LOAD-PATH to find library, this function +search in all subdirs of ROOT-DIR, if ROOT-DIR is unspecified ask for +it with completion. +TYPE when nil specify function, for other values see +`find-function-regexp-alist'." + (require 'find-func) + (let* ((sym (helm-symbolify func)) + (dir (or root-dir (helm-read-file-name + "Project directory: " + :test 'file-directory-p + :default (helm-mklist helm-find-function-default-project) + :must-match t))) + (find-function-source-path + (cons dir (helm-walk-directory dir + :directories 'only + :path 'full))) + (symbol-lib (helm-acase type + ((defvar defface) + (or (symbol-file sym it) + (help-C-file-name sym 'var))) + ;; Sometimes e.g. with prefix key symbols + ;; `find-function-library' returns a list of only one + ;; element, the symbol itself i.e. no library. + (t (cdr (find-function-library sym))))) + (library (and symbol-lib + (find-library-name + (helm-basename symbol-lib t))))) + (if library + (find-function-search-for-symbol sym type library) + (error "Don't know where `%s' is defined" sym)))) + +(defun helm-find-function (func) + "Try to jump to FUNC definition. +With a prefix arg ask for the project directory to search in instead of +using LOAD-PATH." + (if (not helm-current-prefix-arg) + (find-function (helm-symbolify func)) + (let ((place (helm-find-function-noselect func))) + (if (cdr place) + (progn + (switch-to-buffer (car place)) (goto-char (cdr place))) + (helm-aif (car place) + (message "Couldn't find Function `%s' in `%s'" + func (buffer-name it)) + (message "Couldn't find Function `%s'" func)))))) + +(defun helm-find-variable (var) + "Try to jump to VAR definition. +With a prefix arg ask for the project directory to search in instead of +using LOAD-PATH." + (if (not helm-current-prefix-arg) + (find-variable (helm-symbolify var)) + (let ((place (helm-find-function-noselect var nil 'defvar))) + (when place + (switch-to-buffer (car place)) (goto-char (cdr place)))))) + +(defun helm-find-face-definition (face) + "Try to jump to FACE definition. +With a prefix arg ask for the project directory to search in instead of +using LOAD-PATH." + (if (not helm-current-prefix-arg) + (find-face-definition (helm-symbolify face)) + (let ((place (helm-find-function-noselect face nil 'defface))) + (when place + (switch-to-buffer (car place)) (goto-char (cdr place)))))) + +(defun helm-kill-new (candidate &optional replace) + "CANDIDATE is symbol or string. +See `kill-new' for argument REPLACE." + (kill-new (helm-stringify candidate) replace)) + +(defun helm-group-p (symbol) + "Return non nil when SYMBOL is a group." + (or (and (get symbol 'custom-loads) + (not (get symbol 'custom-autoload))) + (get symbol 'custom-group))) + + +;;; Modes +;; +(defun helm-same-major-mode-p (start-buffer alist) + "Decide if current-buffer is related to START-BUFFER. +Argument ALIST is an alist of associated major modes." + ;; START-BUFFER is the current-buffer where we start searching. + ;; Determine the major-mode of START-BUFFER as `cur-maj-mode'. + ;; Each time the loop go in another buffer we try from this buffer + ;; to determine if its `major-mode' is: + ;; - same as the `cur-maj-mode' + ;; - derived from `cur-maj-mode' and from + ;; START-BUFFER if its mode is derived from the one in START-BUFFER. + ;; - have an assoc entry (major-mode . cur-maj-mode) + ;; - have an rassoc entry (cur-maj-mode . major-mode) + ;; - check if one of these entries inherit from another one in + ;; `alist'. + (let* ((cur-maj-mode (with-current-buffer start-buffer major-mode)) + (maj-mode major-mode) + (c-assoc-mode (assq cur-maj-mode alist)) + (c-rassoc-mode (rassq cur-maj-mode alist)) + (o-assoc-mode (assq major-mode alist)) + (o-rassoc-mode (rassq major-mode alist)) + (cdr-c-assoc-mode (cdr c-assoc-mode)) + (cdr-o-assoc-mode (cdr o-assoc-mode))) + (or (eq major-mode cur-maj-mode) + (derived-mode-p cur-maj-mode) + (with-current-buffer start-buffer + (derived-mode-p maj-mode)) + (or (eq cdr-c-assoc-mode major-mode) + (eq (car c-rassoc-mode) major-mode) + (eq (cdr (assq cdr-c-assoc-mode alist)) + major-mode) + (eq (car (rassq cdr-c-assoc-mode alist)) + major-mode)) + (or (eq cdr-o-assoc-mode cur-maj-mode) + (eq (car o-rassoc-mode) cur-maj-mode) + (eq (cdr (assq cdr-o-assoc-mode alist)) + cur-maj-mode) + (eq (car (rassq cdr-o-assoc-mode alist)) + cur-maj-mode))))) + +;;; Source processing +;; +(defun helm-map-candidates-in-source (src fn pred) + "Map over all candidates in SRC and execute FN if PRED returns non nil. +Arg FN and PRED are functions called with current display part of +candidate as arg." + (declare (indent 1)) + (save-excursion + (goto-char (helm-get-previous-header-pos)) + (helm-next-line) + (let* ((next-head (helm-get-next-header-pos)) + (end (and next-head + (save-excursion + (goto-char next-head) + (forward-line -1) + (point)))) + (maxpoint (or end (point-max)))) + (while (< (point) maxpoint) + (helm-mark-current-line) + (let ((cand (helm-get-selection nil 'withprop src))) + (when (funcall pred cand) + (funcall fn cand))) + (forward-line 1) (end-of-line))))) + +;;; Files routines +;; +(defun helm-file-name-sans-extension (filename) + "Same as `file-name-sans-extension' but remove all extensions." + (helm-aif (file-name-sans-extension filename) + ;; Start searching at index 1 for files beginning with a dot + ;; (bug#1335). + (if (string-match "\\." (helm-basename it) 1) + (helm-file-name-sans-extension it) + it))) + +(defsubst helm-file-name-extension (file) + "Returns FILE extension if it is not a number." + (helm-aif (file-name-extension file) + (and (not (helm-string-numberp it)) it))) + +(defun helm-basename (fname &optional ext) + "Print FNAME with any leading directory components removed. +If specified, also remove filename extension EXT. +If FNAME is a directory EXT arg is ignored. + +Arg EXT can be specified as a string, a number or `t' . +When specified as a string, this string is stripped from end of FNAME. +e.g. (helm-basename \"tutorial.el.gz\" \".el.gz\") => tutorial. +When `t' no checking of `file-name-extension' is done and the first +extension is removed unconditionally with `file-name-sans-extension'. +e.g. (helm-basename \"tutorial.el.gz\" t) => tutorial.el. +When a number, remove that many times extensions from FNAME until FNAME ends +with its real extension which is by default \".el\". +e.g. (helm-basename \"tutorial.el.gz\" 2) => tutorial +To specify the extension where to stop use a cons cell where the cdr is a regexp +matching extension e.g. (2 . \\\\.py$). +e.g. (helm-basename \"~/ucs-utils-6.0-delta.py.gz\" \\='(2 . \"\\\\.py\\\\\\='\")) +=>ucs-utils-6.0-delta." + (let ((non-essential t) + (ext-regexp (cond ((consp ext) (cdr ext)) + ((numberp ext) "\\.el\\'") + (t ext))) + result) + (cond ((or (null ext) (file-directory-p fname)) + (file-name-nondirectory (directory-file-name fname))) + ((or (numberp ext) (consp ext)) + (cl-dotimes (_ (if (consp ext) (car ext) ext)) + (let ((bn (file-name-nondirectory (or result fname)))) + (helm-aif (file-name-sans-extension bn) + (if (string-match-p ext-regexp bn) + (cl-return (setq result (file-name-sans-extension bn))) + (setq result (file-name-sans-extension bn)))))) + result) + ((eq t ext) + (file-name-sans-extension (file-name-nondirectory fname))) + ((stringp ext) + (replace-regexp-in-string (concat (regexp-quote ext) "\\'") "" + (file-name-nondirectory fname)))))) + +(defun helm-basedir (fname &optional parent) + "Return the base directory of FNAME ending by a slash. +If PARENT is non nil and FNAME is a directory return the parent +directory of FNAME, if PARENT is a number return the parent directory up to +PARENT level. +If PARENT is not specified but FNAME doesn't end by a slash, the returned value +is same as with PARENT." + (helm-aif (and fname + (or (and (string= fname "~") "~") + (file-name-directory + (helm-acase parent + ((guard* (numberp it)) + (cl-loop repeat it + for bd = (helm-basedir (or bd fname) t) + finally return bd)) + ((guard* (eq it t)) + (directory-file-name fname)) + (t fname))))) + (file-name-as-directory it))) + +(defun helm-current-directory () + "Return current-directory name at point. +It is done according to `helm-current-directory-alist'." + (expand-file-name + (helm-acase major-mode + ((guard* (assoc-default it helm-current-directory-alist)) + (helm-interpret-value guard)) + (t default-directory)))) + +(defun helm-shadow-boring-files (files) + "Files matching `helm-boring-file-regexp' will be +displayed with the `file-name-shadow' face if available." + (helm-shadow-entries files helm-boring-file-regexp-list)) + +(defun helm-skip-boring-files (files) + "Files matching `helm-boring-file-regexp' will be skipped." + (helm-skip-entries files helm-boring-file-regexp-list)) + +(defun helm-skip-current-file (files) + "Current file will be skipped." + (remove (buffer-file-name helm-current-buffer) files)) + +(defun helm-w32-pathname-transformer (args) + "Change undesirable features of windows pathnames to ones more acceptable to +other candidate transformers." + (if (eq system-type 'windows-nt) + (helm-transform-mapcar + (lambda (x) + (replace-regexp-in-string + "/cygdrive/\\(.\\)" "\\1:" + (replace-regexp-in-string "\\\\" "/" x))) + args) + args)) + +(defun helm-w32-prepare-filename (file) + "Convert filename FILE to something usable by external w32 executables." + (replace-regexp-in-string ; For UNC paths + "/" "\\" + (replace-regexp-in-string ; Strip cygdrive paths + "/cygdrive/\\(.\\)" "\\1:" + file nil nil) nil t)) + +(defun helm-w32-shell-execute-open-file (file) + (with-no-warnings + (w32-shell-execute "open" (helm-w32-prepare-filename file)))) + +;; Same as `vc-directory-exclusion-list'. +(defvar helm-walk-ignore-directories + '("SCCS/" "RCS/" "CVS/" "MCVS/" ".svn/" ".git/" ".hg/" ".bzr/" + "_MTN/" "_darcs/" "{arch}/" ".gvfs/")) + +(defsubst helm--dir-file-name (file dir) + (expand-file-name + (substring file 0 (1- (length file))) dir)) + +(defsubst helm--dir-name-p (str) + (char-equal (aref str (1- (length str))) ?/)) + +(cl-defun helm-walk-directory (directory &key (path 'basename) + directories + match skip-subdirs + noerror) + "Walk through DIRECTORY tree. + +Argument PATH can be one of basename, relative, full, or a +function called on file name, default to basename. + +Argument DIRECTORIES when t return also directories names, +otherwise skip directories names, with a value of `only' returns +only subdirectories, i.e. files are skipped. + +Argument MATCH is a regexp matching files or directories. + +Argument SKIP-SUBDIRS when t will skip +`helm-walk-ignore-directories', otherwise if it is given as a +list of directories, this list will be used instead of +`helm-walk-ignore-directories'. + +Argument NOERROR when t will skip directories which are not +accessible." + (let ((fn (cl-case path + (basename 'file-name-nondirectory) + (relative 'file-relative-name) + (full 'identity) + (t path)))) ; A function. + (setq skip-subdirs (if (listp skip-subdirs) + skip-subdirs + helm-walk-ignore-directories)) + (cl-labels ((ls-rec (dir) + (unless (file-symlink-p dir) + (cl-loop for f in (sort (file-name-all-completions "" dir) + 'string-lessp) + unless (member f '("./" "../")) + ;; A directory. + ;; Use `helm--dir-file-name' to remove the final slash. + ;; Needed to avoid infloop on directory symlinks. + if (and (helm--dir-name-p f) + (helm--dir-file-name f dir)) + nconc + (unless (or (member f skip-subdirs) + (and noerror + (not (file-accessible-directory-p it)))) + (if (and directories + (or (null match) + (string-match match f))) + (nconc (list (concat (funcall fn it) "/")) + (ls-rec it)) + (ls-rec it))) + ;; A regular file. + else nconc + (when (and (null (eq directories 'only)) + (or (null match) (string-match match f))) + (list (funcall fn (expand-file-name f dir)))))))) + (ls-rec directory)))) + +(defun helm-file-expand-wildcards (pattern &optional full) + "Same as `file-expand-wildcards' but allow recursion. +Recursion happens when PATTERN starts with two stars. +Directories expansion is not supported." + (let ((bn (helm-basename pattern)) + (case-fold-search nil)) + (if (and helm-file-globstar + (string-match "\\`\\*\\{2\\}\\(.*\\)" bn)) + (helm-walk-directory (helm-basedir pattern) + :path (cl-case full + (full 'full) + (relative 'relative) + ((basename nil) 'basename) + (t 'full)) + :directories nil + :match (or (helm-wildcard-to-regexp bn) + (wildcard-to-regexp bn)) + :skip-subdirs t) + (helm-aif (helm-wildcard-to-regexp bn) + (directory-files (helm-basedir pattern) full it) + ;; `file-expand-wildcards' fails to expand weird directories + ;; like "[ foo.zz ] bar.*.avi", fallback to `directory-files' + ;; in such cases. + (or (file-expand-wildcards pattern full) + (directory-files (helm-basedir pattern) + full (wildcard-to-regexp bn))))))) + +(defun helm-wildcard-to-regexp (wc) + "Transform wilcard WC like \"**.{jpg,jpeg}\" in REGEXP." + (when (string-match ".*\\(\\*\\{1,2\\}\\)\\.[{]\\(.*\\)[}]\\'" wc) + (format ".*\\.\\(%s\\)$" + (replace-regexp-in-string + "," "\\\\|" (match-string 2 wc))))) + +(defun helm-locate-lib-get-summary (file) + "Extract library description from FILE." + (with-temp-buffer + (let (desc) + (cl-letf (((symbol-function 'message) #'ignore)) + (insert-file-contents file nil 0 128)) + (goto-char (point-min)) + (when (re-search-forward "^;;;?\\(.*\\) ---? \\(.*\\)" (pos-eol) t) + (setq desc (match-string-no-properties 2))) + (if (or (null desc) (string= "" desc) + ;; Fix issue#2716 with an header line like + ;; ";; foo --- -*-[...]" i.e. desc is not provided. + (string-match "\\`-\\*-" desc)) + "Not documented" + (car (split-string desc "-\\*-" nil "[ \t\n\r-]+")))))) + +(defun helm-local-directory-files (directory &rest args) + "Run `directory-files' without tramp file name handlers. +Take same args as `directory-files'." + (require 'tramp) + (let ((file-name-handler-alist + (cl-loop for (re . sym) in file-name-handler-alist + unless (and (symbolp sym) + (string-prefix-p "tramp-" (symbol-name sym))) + collect `(,re . ,sym))) + tramp-mode) + ;; Avoid error with 5nth arg COUNT which is not available in previous Emacs, + ;; at least 27.1, see bug#2662. + (apply #'directory-files directory args))) + +(defun helm-common-str-1 (files &optional dirp) + "Find the common string or directory in FILES. +When DIRP is non nil return the common part which is a directory." + (if (cdr files) + (cl-loop with base = (car files) + with others = nil + for file in files + for cpart = (if dirp + (helm-acase (fill-common-string-prefix base file) + ((guard* (and it (file-directory-p it))) it) + (t (and it (file-name-directory it)))) + (fill-common-string-prefix base file)) + if cpart + do (setq base cpart) + else do (push file others) + finally return (if (and others base) + (nconc (list (directory-file-name base)) + (helm-common-str-1 others)) + (list (and base (directory-file-name base))))) + (and files (list (directory-file-name + (file-name-directory (car files))))))) + +(defun helm-common-dir (files) + "Return the longest common directory path of FILES list. +If FILES are not all common to the same drive (Windows) a list of +common directory is returned." + (let ((result (helm-common-str-1 files t))) + (if (cdr result) result (car result)))) + +;; Tests: +;; (helm-common-dir '("c:/foo" "c:/foo/bar/baz" +;; "f:/foo" "e:/foo" "f:/foo/bar" +;; "d:/foo" "d:/foo/bar/baz" +;; "e:/foo/bar/baz")) +;; ("c:/foo" "e:/foo" "f:/foo" "d:/foo") + + +;; (helm-common-dir '("/home/you/download/foo/" +;; "/home/you/download/foo/bar/baz" +;; "/home/you/tmp/foo")) +;; "/home/you" + + +;;; helm internals +;; +(defun helm-set-pattern (pattern &optional noupdate) + "Set minibuffer contents to PATTERN. +If optional NOUPDATE is non-nil, the Helm buffer is not changed." + (with-selected-window (or (active-minibuffer-window) (minibuffer-window)) + ;; Minibuffer may have a read-only string when using completion-in-region, + ;; which prevent inserting in minibuffer. see + ;; `helm-mode--completion-in-region-initial-input'. + (let ((inhibit-read-only t)) + (delete-minibuffer-contents) + (insert pattern))) + (when noupdate + (setq helm-pattern pattern))) + +(defun helm-minibuffer-completion-contents () + "Return the user input in a minibuffer before point as a string. +That is what completion commands operate on." + (buffer-substring (field-beginning) (point))) + +(defmacro with-helm-buffer (&rest body) + "Eval BODY inside `helm-buffer'." + (declare (indent 0) (debug t)) + `(with-current-buffer (helm-buffer-get) + ,@body)) + +(defmacro with-helm-current-buffer (&rest body) + "Eval BODY inside `helm-current-buffer'." + (declare (indent 0) (debug t)) + `(with-current-buffer (or (and (buffer-live-p helm-current-buffer) + helm-current-buffer) + (setq helm-current-buffer + (current-buffer))) + ,@body)) + +(defun helm-buffer-get () + "Return `helm-action-buffer' if shown otherwise `helm-buffer'." + (if (helm-action-window) + helm-action-buffer + helm-buffer)) + +(defun helm-window () + "Window of `helm-buffer'." + (get-buffer-window (helm-buffer-get) 0)) + +(defun helm-action-window () + "Window of `helm-action-buffer'." + (get-buffer-window helm-action-buffer 'visible)) + +(defmacro with-helm-window (&rest body) + "Be sure BODY is excuted in the helm window." + (declare (indent 0) (debug t)) + `(with-selected-window (helm-window) + ,@body)) + +(defmacro helm-without-follow (&rest body) + "Ensure BODY runs without following. +I.e. when using `helm-next-line' and friends in BODY." + (declare (indent 0) (debug t)) + `(cl-letf (((symbol-function 'helm-follow-mode-p) + (lambda (&optional _) nil))) + (let (helm-follow-mode-persistent) + (progn ,@body)))) + +(defun helm-candidate-prefixed-p (candidate) + "Return non nil when CANDIDATE is prefixed. + +Candidates files are prefixed with [+] or a specific icon when candidate is a +non existing file, in other places candidates may be prefixed with an unknown +symbol [?], these candidate have the text property or +property." + (or (get-text-property 0 'helm-new-file candidate) + (get-text-property 0 'unknown candidate))) + +;; 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-flex 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))) + +(defvar helm-blacklist-completion-styles '(emacs21 emacs22)) +(defun helm--prepare-completion-styles (&optional com-or-mode styles) + "Return a suitable list of styles for `completion-styles'. + +When `helm-completion-style' is not `emacs' the Emacs vanilla +default `completion-styles' is used except for +`helm-dynamic-completion' which uses inconditionally `emacs' as +value for `helm-completion-style'. + +If styles are specified in `helm-completion-styles-alist' for a +particular mode, use these styles for the corresponding mode. +If COM-OR-MODE (a mode or a command) is specified it is used to find the +corresponding styles in `helm-completion-styles-alist'. + +If STYLES is specified as a list of styles suitable for +`completion-styles' these styles are used in the given order. +Otherwise helm style is added to `completion-styles' always after +flex or helm-flex completion style if present." + ;; For `helm-completion-style' and `helm-completion-styles-alist'. + (require 'helm-mode) + (let ((from (if com-or-mode com-or-mode major-mode))) + (if (memq helm-completion-style '(helm helm-fuzzy)) + ;; Keep default settings, but probably nil is fine as well. + '(basic partial-completion emacs22) + (or + styles + (helm-acase (cdr (assq from helm-completion-styles-alist)) + ((dst* (_l &rest args)) args)) + ;; 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 (and (memq wflex completion-styles) + (list wflex)) + (cl-loop for s in completion-styles + unless (or (memq s helm-blacklist-completion-styles) + (memq wflex completion-styles)) + collect s)))) + (helm-append-at-nth + styles '(helm) + (if (memq wflex completion-styles) + 1 0))))))) + +(defun helm-guess-filename-at-point () + (with-helm-current-buffer + ;; Ensure to disable the evil `ffap-machine-at-point' which may run here as + ;; `file-name-at-point-functions' contains by default + ;; `ffap-guess-file-name-at-point' See bug#2574. + ;; Use same value as in Emacs-29 for next 3 vars to ensure `ffap-machine-p' + ;; never ping. + (let ((ffap-machine-p-known 'accept) + (ffap-machine-p-local 'reject) + (ffap-machine-p-unknown 'reject)) + (run-hook-with-args-until-success 'file-name-at-point-functions)))) + +;; Yank text at point. +;; +;; +(defun helm-yank-text-at-point (arg) + "Yank text at point in `helm-current-buffer' into minibuffer." + (interactive "p") + (with-helm-current-buffer + (let ((fwd-fn (or helm-yank-text-at-point-function #'forward-word)) + diff) + ;; Start to initial point if C-w have never been hit. + (unless helm-yank-point + (setq helm-yank-point (car helm-current-position))) + (save-excursion + (goto-char helm-yank-point) + (helm-set-pattern + (if (< arg 0) + (with-temp-buffer + (insert helm-pattern) + (let ((end (point-max))) + (goto-char end) + (funcall fwd-fn -1) + (setq diff (- end (point))) + (delete-region (point) end) + (buffer-string))) + (funcall fwd-fn arg) + (concat + ;; Allow yankink beyond eol allow inserting e.g long + ;; urls in mail buffers. + helm-pattern (replace-regexp-in-string + "\\`\n" "" + (buffer-substring-no-properties + helm-yank-point (point)))))) + (setq helm-yank-point (if diff (- (point) diff) (point))))))) +(put 'helm-yank-text-at-point 'helm-only t) + +(defun helm-undo-yank-text-at-point () + "Undo last entry added by `helm-yank-text-at-point'." + (interactive) + (helm-yank-text-at-point -1)) +(put 'helm-undo-yank-text-at-point 'helm-only t) + +(defun helm-reset-yank-point () + (setq helm-yank-point nil)) + +(add-hook 'helm-cleanup-hook 'helm-reset-yank-point) +(add-hook 'helm-after-initialize-hook 'helm-reset-yank-point) + + +;;; Ansi +;; +;; +(defvar helm--ansi-color-regexp + "\033\\[\\(K\\|[0-9;]*m\\)") +(defvar helm--ansi-color-drop-regexp + "\033\\[\\([ABCDsuK]\\|[12][JK]\\|=[0-9]+[hI]\\|[0-9;]*[Hf]\\)") +(with-suppressed-warnings ((obsolete ansi-color-apply-sequence)) + (defun helm--ansi-color-apply (string) + "A version of `ansi-color-apply' immune to upstream changes. + +Similar to the emacs-24.5 version without support to +`ansi-color-context' which is buggy in Emacs. + +Modify also `ansi-color-regexp' by using own variable +`helm--ansi-color-regexp' that matches whole STRING. + +This is needed to provide compatibility for both emacs-25 and +emacs-24.5 as emacs-25 version of `ansi-color-apply' is partially +broken." + (require 'ansi-color) + (let ((start 0) + codes end escape-sequence + result colorized-substring) + ;; Find the next escape sequence. + (while (setq end (string-match helm--ansi-color-regexp string start)) + (setq escape-sequence (match-string 1 string)) + ;; Colorize the old block from start to end using old face. + (when codes + (put-text-property + start end 'font-lock-face (ansi-color--find-face codes) string)) + (setq colorized-substring (substring string start end) + start (match-end 0)) + ;; Eliminate unrecognized ANSI sequences. + (while (string-match helm--ansi-color-drop-regexp colorized-substring) + (setq colorized-substring + (replace-match "" nil nil colorized-substring))) + (push colorized-substring result) + ;; Create new face, by applying escape sequence parameters. + (setq codes (ansi-color-apply-sequence escape-sequence codes))) + ;; If the rest of the string should have a face, put it there. + (when codes + (put-text-property + start (length string) + 'font-lock-face (ansi-color--find-face codes) string)) + ;; Save the remainder of the string to the result. + (if (string-match "\033" string start) + (push (substring string start (match-beginning 0)) result) + (push (substring string start) result)) + (apply 'concat (nreverse result))))) + +(when (< emacs-major-version 26) + (advice-add 'ansi-color-apply :override #'helm--ansi-color-apply)) + + +(provide 'helm-lib) + +;;; helm-lib.el ends here diff --git a/elpa/helm-core-20260424.1357/helm-multi-match.el b/elpa/helm-core-20260424.1357/helm-multi-match.el new file mode 100644 index 00000000..7bde6d39 --- /dev/null +++ b/elpa/helm-core-20260424.1357/helm-multi-match.el @@ -0,0 +1,439 @@ +;;; helm-multi-match.el --- Multiple regexp matching methods for helm -*- lexical-binding: t -*- + +;; Original Author: rubikitch + +;; Copyright (C) 2008 ~ 2011 rubikitch +;; Copyright (C) 2011 ~ 2026 Thierry Volpiatto + +;; Author: Thierry Volpiatto +;; URL: http://github.com/emacs-helm/helm + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Code: + +(require 'cl-lib) +(require 'helm-lib) + + +(defgroup helm-multi-match nil + "Helm multi match." + :group 'helm) + +(defvar helm-mm-matching-method 'multi3 + "Matching method for helm match plugin. +You can set here different methods to match candidates in helm. +Here are the possible value of this symbol and their meaning: +- multi1: Respect order, prefix of pattern must match. +- multi2: Same but with partial match. +- multi3: The best, multiple regexp match, allow negation. +- multi3f: Same as multi3 but for files only (HFF and friends). +- multi3p: Same but prefix must match. + +Default is multi3, you should keep this for a better experience. + +The multi3f method is meant to be used within `helm-find-files' or at +least when matching on a list of files or strings with a leading common +part like the basedir of an absolute filename from the same directory +but never globally.") + + +;; Internal +(defvar helm-mm-default-match-functions + '(helm-mm-exact-match helm-mm-match)) +(defvar helm-mm-default-search-functions + '(helm-mm-exact-search helm-mm-search)) + + +;;; Build regexps +;; +;; +(defconst helm-mm-space-regexp "\\s\\\\s-" + "Regexp to represent space itself in multiple regexp match.") + +(defun helm-mm-split-pattern (pattern &optional grep-space) + "Split PATTERN if it contains spaces and return resulting list. +If spaces in PATTERN are escaped, don't split at this place. +i.e \"foo bar baz\"=> (\"foo\" \"bar\" \"baz\") +but \"foo\\ bar baz\"=> (\"foo\\s-bar\" \"baz\"). +If GREP-SPACE is used translate escaped space to \"\\s\" instead of \"\\s-\"." + (split-string + ;; Match spaces litteraly because candidate buffer syntax-table + ;; doesn't understand "\s-" properly. + (replace-regexp-in-string + helm-mm-space-regexp + (if grep-space "\\s" "\\s-") pattern nil t))) + +(defun helm-mm-1-make-regexp (pattern) + "Replace spaces in PATTERN with \".*\"." + (mapconcat 'identity (helm-mm-split-pattern pattern) ".*")) + + +;;; Exact match. +;; +;; +;; Internal. +(defvar helm-mm--exact-pattern-str nil) +(defvar helm-mm--exact-pattern-real nil) + +(defun helm-mm-exact-get-pattern (pattern) + (unless (equal pattern helm-mm--exact-pattern-str) + (setq helm-mm--exact-pattern-str pattern + helm-mm--exact-pattern-real (concat "^" (regexp-quote pattern) "$"))) + helm-mm--exact-pattern-real) + + +(defun helm-mm-exact-match (candidate &optional pattern) + (unless pattern (setq pattern helm-pattern)) + (if case-fold-search + (string= (downcase candidate) (downcase pattern)) + (string= candidate pattern))) + +(defun helm-mm-exact-search (pattern &rest _ignore) + (helm-re-search-forward (helm-mm-exact-get-pattern pattern) nil t)) + + +;;; Multiple regexp patterns 1 (order is preserved / prefix). +;; +;; Same as "^foo.*bar.*baz" +;; Internal +(defvar helm-mm--1-pattern-str nil) +(defvar helm-mm--1-pattern-real nil) + +(defun helm-mm-1-get-pattern (pattern) + (unless (equal pattern helm-mm--1-pattern-str) + (setq helm-mm--1-pattern-str pattern + helm-mm--1-pattern-real + (concat "^" (helm-mm-1-make-regexp pattern)))) + helm-mm--1-pattern-real) + +(defun helm-mm-1-match (candidate &optional pattern) + (unless pattern (setq 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)) + + +;;; Multiple regexp patterns 2 (order is preserved / partial). +;; +;; Same as "^.*foo.*bar.*baz" +;; Internal +(defvar helm-mm--2-pattern-str nil) +(defvar helm-mm--2-pattern-real nil) + +(defun helm-mm-2-get-pattern (pattern) + (unless (equal pattern helm-mm--2-pattern-str) + (setq helm-mm--2-pattern-str pattern + helm-mm--2-pattern-real + (concat "^.*" (helm-mm-1-make-regexp pattern)))) + helm-mm--2-pattern-real) + +(defun helm-mm-2-match (candidate &optional pattern) + (unless pattern (setq 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)) + + +;;; Multiple regexp patterns 3 (permutation). +;; +;; +;; Internal +(defvar helm-mm--3-pattern-str nil) +(defvar helm-mm--3-pattern-list nil) + +(defun helm-mm-3-get-patterns (pattern) + "Return a list of predicate/regexp cons cells. +E.g., ((identity . \"foo\") (not . \"bar\")). +If PATTERN is unchanged, 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) + +(defun helm-mm-3-get-patterns-internal (pattern) + "Return a list of predicate/regexp cons cells. +E.g., ((identity . \"foo\") (not . \"bar\"))." + (unless (string= pattern "") + (cl-loop for pat in (helm-mm-split-pattern pattern) + collect (if (char-equal ?! (aref pat 0)) + (cons 'not (substring pat 1)) + (cons 'identity pat))))) + +(defun helm-mm-regexp-p (string) + (string-match-p "[][*+^$.?]" string)) + +(defvar helm-mm--match-on-diacritics nil) + +(defun helm-mm-3-match (candidate &optional pattern) + "Check if PATTERN match CANDIDATE. +When PATTERN contains a space, it is splitted and matching is +done 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 contains a space. +E.g., \"foo bar\"=>((identity . \"foo\") (identity . \"bar\")). +Then each predicate of cons cell(s) is called with the regexp of +the same cons cell against CANDIDATE. +I.e. (identity (string-match \"foo\" \"foo bar\")) => t." + (let ((pat (helm-mm-3-get-patterns (or pattern helm-pattern)))) + (cl-loop for (predicate . regexp) in pat + for re = (if (and helm-mm--match-on-diacritics + (not (helm-mm-regexp-p regexp))) + (char-fold-to-regexp regexp) + regexp) + always (funcall predicate + (condition-case _err + ;; FIXME: Probably do nothing when + ;; using fuzzy leaving the job + ;; to the fuzzy fn. + (string-match re candidate) + (invalid-regexp nil)))))) + +(defun helm-mm-3-search-base (pattern searchfn1 searchfn2) + "Try to find PATTERN in `helm-buffer' with SEARCHFN1 and SEARCHFN2. +This is the search function for `candidates-in-buffer' enabled sources. +Use the same method as `helm-mm-3-match' except it search in buffer +instead of matching on a string. +i.e (identity (re-search-forward \"foo\" (pos-eol) t)) => t." + (cl-loop with pat = (if (stringp pattern) + (helm-mm-3-get-patterns pattern) + pattern) + with regex = (cdar pat) + with regex1 = (if (and regex + helm-mm--match-on-diacritics + (not (helm-mm-regexp-p regex))) + (char-fold-to-regexp regex) + regex) + with prefix-search = (eq searchfn1 'helm-mm-prefix-search) + ;; First pattern is a negation. + when (eq (caar pat) 'not) return + ;; Pass the job to `helm-search-match-part'. + ;; We now forward-line from `helm-search-from-candidate-buffer', see + ;; comments about bug#2650 there. + (list (pos-bol) (pos-eol)) + ;; Start searching the first pattern [1]. + while (condition-case _err + (funcall searchfn1 (or regex1 "") nil t) + (invalid-regexp nil)) + for bol = (pos-bol) + for eol = (pos-eol) + for end = (and prefix-search (+ bol (match-end 0))) ; End of prefix. + ;; Now search subsequent patterns on this line. + if (cl-loop for (pred . str) in (cdr pat) + for regexp = (if (and helm-mm--match-on-diacritics + (not (helm-mm-regexp-p str))) + (char-fold-to-regexp str) + str) + always + ;; Search from end of initial match (prefix) or from bol. + (progn (goto-char (or end bol)) + (funcall pred (condition-case _err + (funcall searchfn2 regexp eol t) + (invalid-regexp nil))))) + ;; When all patterns match on line move at eol or next line and exit + ;; with t. + do (helm-mm-3--search-move-forward bol eol) and return t + ;; if no matches continue [1] until the next matching line and so on. + else do (helm-mm-3--search-move-forward bol eol) + finally return nil)) + +(defun helm-mm-3--search-move-forward (bol eol) + "Move point forward for next search. +Forward line on empty lines, otherwise goto eol." + (if (eql bol eol) (forward-line 1) (goto-char eol))) + +(defun helm-mm-3-search (pattern &rest _ignore) + (helm-mm-3-search-base + pattern #'helm-re-search-forward #'helm-re-search-forward)) + +(defun helm-mm-3-search-on-diacritics (pattern &rest _ignore) + (let ((helm-mm--match-on-diacritics t)) + (helm-mm-3-search pattern))) + + +;;; mm-3f (match on filenames) +;; +;; +;; When this is called by HFF, the pattern is transformed like this: +;; "/home/you/foo/foo bar" => "/home/you/foo/ foo bar" so the prefix is always +;; the basedir. +(defun helm-mm-3f-match (candidate &optional pattern) + "Same as `helm-mm-3-match' but for files or prefix matching. +Once the first pattern is matched, the subsequent patterns match on the part of +CANDIDATE starting at end of first match. +Diacritics regexp is never used on the first pattern, the basedir." + ;; When matching a filename like "/home/you/github/foo-bar.txt" there is no + ;; problems with `helm-mm-3-match' as long as one of the patterns doesn't + ;; match the basedir of filename but as soon as you try to match a file with a + ;; name matching basedir we would match all the file of directory instead of + ;; just the files we want e.g. with a pattern like "/home/you/github/ foo git" + ;; you would match all files of directory instead of matching only + ;; "/home/you/github/foo-git.el" because "git" will always match "github". + (let ((pat (helm-mm-3-get-patterns (or pattern helm-pattern)))) + (cl-loop with end = nil + for (predicate . regexp) in pat + for re = (if (and helm-mm--match-on-diacritics + (not (helm-mm-regexp-p regexp))) + (char-fold-to-regexp regexp) + regexp) + ;; Use `char-fold-to-regexp' on subsequent patterns only. + for pref-re = (if end re (concat "\\`" regexp)) + always (funcall predicate + (prog1 (condition-case _err + (string-match pref-re candidate end) + (invalid-regexp nil)) + (unless end + (setq end (match-end 0)))))))) + +(defun helm-mm-3f-match-on-diacritics (candidate &optional pattern) + "Ignore diacritics in basename of files. +This happens as soon as you enter multi matching i.e. you add space(s) after +basedir." + (let ((helm-mm--match-on-diacritics t)) + (helm-mm-3f-match candidate (or pattern helm-pattern)))) + +;;; multiple regexp pattern 3 with prefix search +;; +;; +(defalias 'helm-mm-3p-match #'helm-mm-3f-match + "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.") + +;; This is just a wrapper around helm-re-search-forward but we need it in +;; helm-mm-3-search-base to decide if we use prefix search or not by comparing +;; symbols. +(defun helm-mm-prefix-search (pattern &rest _ignore) + (helm-re-search-forward pattern nil t)) + +(defun helm-mm-3p-search (pattern &rest _ignore) + (helm-mm-3-search-base + pattern 'helm-mm-prefix-search 'helm-re-search-forward)) + +;;; mm-3 with migemo +;; Needs https://github.com/emacs-jp/migemo +;; +(defvar helm-mm--previous-migemo-info nil + "[Internal] Cache previous migemo query.") +(make-local-variable 'helm-mm--previous-migemo-info) + +(declare-function migemo-get-pattern "ext:migemo.el") +(declare-function migemo-search-pattern-get "ext:migemo.el") + +(define-minor-mode helm-migemo-mode + "Enable migemo in helm. +It will be available in the sources handling it, +i.e. the sources which have the slot :migemo with non--nil value." + :lighter " Hmio" + :group 'helm + :global t + (cl-assert (featurep 'migemo) + nil "No feature called migemo found, install migemo.el.")) + +(defun helm-mm-migemo-get-pattern (pattern) + (let ((regex (migemo-get-pattern pattern))) + (if (ignore-errors (string-match regex "") t) + (concat regex "\\|" pattern) pattern))) + +(defun helm-mm-migemo-search-pattern-get (pattern) + (let ((regex (migemo-search-pattern-get pattern))) + (if (ignore-errors (string-match regex "") t) + (concat regex "\\|" pattern) pattern))) + +(defun helm-mm-migemo-string-match (pattern str) + "Migemo version of `string-match'." + (unless (assoc pattern helm-mm--previous-migemo-info) + (with-helm-buffer + (setq helm-mm--previous-migemo-info + (push (cons pattern (helm-mm-migemo-get-pattern pattern)) + helm-mm--previous-migemo-info)))) + (string-match (assoc-default pattern helm-mm--previous-migemo-info) str)) + +(defun helm-mm-diacritics-string-match (pattern str) + "Check if PATTERN match STR ignoring diacritics. + +If PATTERN is a regexp (i.e. `helm-mm-regexp-p') use PATTERN +unmodified, otherwise transform PATTERN with `char-fold-to-regexp'. + +This function is used to search match-part of candidate in in-buffer +sources." + (string-match (if (helm-mm-regexp-p pattern) + pattern + (char-fold-to-regexp pattern)) + str)) + +(defun helm-mm-3-migemo-match (candidate &optional pattern) + (unless pattern (setq 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 candidate))))) + +(defun helm-mm-migemo-forward (word &optional bound noerror count) + (with-helm-buffer + (unless (assoc word helm-mm--previous-migemo-info) + (setq helm-mm--previous-migemo-info + (push (cons word (if (delq 'ascii (find-charset-string word)) + word + (helm-mm-migemo-search-pattern-get word))) + helm-mm--previous-migemo-info)))) + (re-search-forward + (assoc-default word helm-mm--previous-migemo-info) bound noerror count)) + +(defun helm-mm-3-migemo-search (pattern &rest _ignore) + (and helm-migemo-mode + (helm-mm-3-search-base + pattern 'helm-mm-migemo-forward 'helm-mm-migemo-forward))) + + +;;; Generic multi-match/search functions +;; +;; +(defun helm-mm-match (candidate &optional pattern) + "Call `helm-mm-matching-method' function against CANDIDATE." + (unless pattern (setq pattern helm-pattern)) + (let ((fun (cl-ecase helm-mm-matching-method + (multi1 #'helm-mm-1-match) + (multi2 #'helm-mm-2-match) + (multi3 #'helm-mm-3-match) + (multi3f #'helm-mm-3f-match) + (multi3p #'helm-mm-3p-match)))) + (funcall fun candidate pattern))) + +(defun helm-mm-3-match-on-diacritics (candidate &optional pattern) + "Same as `helm-mm-3-match' but match on diacritics if possible." + (unless pattern (setq pattern helm-pattern)) + (let ((helm-mm--match-on-diacritics t)) + (helm-mm-match 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) + (multi3 #'helm-mm-3-search) + ((multi3p multi3f) #'helm-mm-3p-search)))) + (funcall fun pattern))) + + +(provide 'helm-multi-match) + + +;;; helm-multi-match.el ends here diff --git a/elpa/helm-core-20260424.1357/helm-source.el b/elpa/helm-core-20260424.1357/helm-source.el new file mode 100644 index 00000000..2df9075d --- /dev/null +++ b/elpa/helm-core-20260424.1357/helm-source.el @@ -0,0 +1,1356 @@ +;;; helm-source.el --- Helm source creation. -*- lexical-binding: t -*- + +;; Copyright (C) 2015 ~ 2026 Thierry Volpiatto + +;; Author: Thierry Volpiatto +;; URL: http://github.com/emacs-helm/helm + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; Interface to create helm sources easily. +;; Currently the eieo objects are transformed in alist for compatibility. +;; In the future this package should allow creating source as eieo objects +;; without conversion to alist, teaching helm to read such a structure. +;; The compatibility with alists would be kept. + +;;; Code: + +(require 'cl-lib) +(require 'eieio) +(require 'helm-lib) + +(defvar helm-fuzzy-sort-fn) +(defvar helm-fuzzy-match-fn) +(defvar helm-fuzzy-search-fn) + +(declare-function helm-init-candidates-in-buffer "helm-core.el") +(declare-function helm-interpret-value "helm-core.el") +(declare-function helm-fuzzy-highlight-matches "helm-core.el") +(declare-function helm-marked-candidates "helm-core.el") + +;;; Advice Emacs fn +;; Make Classes's docstrings more readable by removing the attempts to align +;; unuseful stuff and add newline for separating slot documentation, as well +;; slots are in bold characters. + +(defun helm-source--cl--print-table (&rest args) + "Advice for `cl--print-table' to make readable class slots docstrings." + (let ((format "%s\n\n Initform=%s\n\n%s")) + (dolist (row (cadr args)) + (setcar row (propertize (car row) 'face 'bold)) + (setcdr row (nthcdr 1 (cdr row))) + (insert "\n* " (apply #'format format row) "\n")))) + +(cl-defgeneric helm--setup-source (source) + "Prepare slots and handle slot errors before creating a helm source.") + +(cl-defgeneric helm-setup-user-source (source) + "Allow users modifying slots in SOURCE just before creation.") + + +;;; Classes for sources +;; +;; +(defclass helm-source () + ((name + :initarg :name + :initform nil + :custom string + :documentation + " The name of the source. + A string which is also the heading which appears + above the list of matches from the source. Must be unique.") + + (header-name + :initarg :header-name + :initform nil + :custom function + :documentation + " A function returning the display string of the header. + Its argument is the name of the source. This attribute is useful to + add an additional information with the source name. + It doesn't modify the name of the source.") + + (init + :initarg :init + :initform nil + :custom function + :documentation + " Function called with no parameters when helm is started. + It is useful for collecting current state information which can be + used to create the list of candidates later. + Initialization of `candidates-in-buffer' is done here + with `helm-init-candidates-in-buffer'.") + + (candidates + :initarg :candidates + :initform nil + :custom (choice function list) + :documentation + " Specifies how to retrieve candidates from the source. + 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. + + In case of (DISPLAY . REAL) pairs, the DISPLAY string is shown + in the Helm buffer, but the REAL one is used as action + argument when the candidate is selected. This allows a more + readable presentation for candidates which would otherwise be, + for example, too long or have a common part shared with other + candidates which can be safely replaced with an abbreviated + string for display purposes. + + Note that if the (DISPLAY . REAL) form is used then pattern + matching is done on the displayed string, not on the real + value. + + This function, generally should not compute candidates according to + `helm-pattern' which defeat all the Helm's matching mechanism + i.e. multiple pattern matching and/or fuzzy matching. + If you want to do so, use :match-dynamic slot to be sure matching + occur only in :candidates function and there is no conflict with + other match functions.") + + (update + :initarg :update + :initform nil + :custom function + :documentation + " Function called with no parameters before :init function + when `helm-force-update' is called.") + + (cleanup + :initarg :cleanup + :initform nil + :custom function + :documentation + " Function called with no parameters when *helm* buffer is + closed. It is useful for killing unneeded candidates buffer. + + Note that the function is executed BEFORE performing action.") + + (keymap + :initarg :keymap + :initform 'helm-map + :custom sexp + :documentation + " Specific keymap for this source. + default value is `helm-map'.") + + (action + :initarg :action + :initform 'identity + :custom (alist :key-type string + :value-type function) + :documentation + " An alist of (DISPLAY . FUNCTION) pairs, a variable name or a function. + FUNCTION is called with one parameter: the selected candidate. + + An action other than the default can be chosen from this list + of actions for the currently selected candidate (by default + with TAB). The DISPLAY string is shown in the completions + buffer and the FUNCTION is invoked when an action is + selected. The first action of the list is the default. + + You should use `helm-make-actions' to build this alist easily.") + + (persistent-action + :initarg :persistent-action + :initform nil + :custom function + :documentation + " Can be a either a Function called with one parameter (the + selected candidate) or a cons cell where first element is this + same function and second element a symbol (e.g never-split) + that inform `helm-execute-persistent-action' to not split his + window to execute this persistent action. + Example: + + (defun foo-persistent-action (candidate) + (do-something candidate)) + + :persistent-action \\='(foo-persistent-action . never-split) ; Don't split + or + :persistent-action \\='foo-persistent-action ; Split + + When specifying :persistent-action by slot directly, foo-persistent-action + will be executed without quitting helm when hitting `C-j'. + + Note that other persistent actions can be defined using other + bindings than `C-j' by simply defining an interactive function bound + to a key in the keymap source. + The function should create a new attribute in source before calling + `helm-execute-persistent-action' on this attribute. + Example: + + (defun helm-ff-persistent-delete () + \"Delete current candidate without quitting.\" + (interactive) + (with-helm-alive-p + (helm-set-attr \\='quick-delete \\='(helm-ff-quick-delete . never-split)) + (helm-execute-persistent-action \\='quick-delete))) + + This function is then bound in `helm-find-files-map'.") + + (persistent-action-if + :initarg :persistent-action-if + :initform nil + :custom function + :documentation + " Similar from persistent action but it is a function that should + return an object suitable for persistent action when called , i.e. a + function or a cons cell. + Example: + + (defun foo-persistent-action (candidate) + (cond (something + ;; Don't split helm-window. + (cons (lambda (_ignore) + (do-something candidate)) + \\='no-split)) + ;; Split helm-window. + (something-else + (lambda (_ignore) + (do-something-else candidate))))) + + :persistent-action-if \\='foo-persistent-action + + Here when hitting `C-j' one of the lambda's will be executed + depending on something or something-else condition, splitting or not + splitting as needed. + See `helm-find-files-persistent-action-if' definition as another example.") + + (persistent-help + :initarg :persistent-help + :initform nil + :custom string + :documentation + " A string to explain persistent-action of this source. + It is a facility to display what persistent action does in + header-line, once your source is loaded don't use it directly, it will + have no effect, use instead `header-line' attribute. + It also accepts a function or a variable name. + It will be displayed in `header-line' or in `minibuffer' depending + of value of `helm-echo-input-in-header-line' and `helm-display-header-line'.") + + (help-message + :initarg :help-message + :initform nil + :custom (choice string function) + :documentation + " Help message for this source. + If not present, `helm-help-message' value will be used.") + + (multiline + :initarg :multiline + :initform nil + :custom (choice boolean integer) + :documentation + " Allow multiline candidates. + When non-nil candidates will be separated by `helm-candidate-separator'. + You can customize the color of this separator with `helm-separator' face. + Value of multiline can be an integer which specify the maximum size of the + multiline string to display, if multiline string is longer than this value + it will be truncated.") + + (requires-pattern + :initarg :requires-pattern + :initform 0 + :custom integer + :documentation + " If present matches from the source are shown only if the + pattern is not empty. Optionally, it can have an integer + parameter specifying the required length of input which is + useful in case of sources with lots of candidates.") + + (candidate-transformer + :initarg :candidate-transformer + :initform nil + :custom (choice function list) + :documentation + " It's a function or a list of functions called with one argument + when the completion list from the source is built. The argument + is the list of candidates retrieved from the source. The + function should return a transformed list of candidates which + will be used for the current completion. If it is a list of + functions, it calls each function sequentially. + + This can be used to transform or remove items from the list of + candidates. + + Note that `candidates' is run already, so the given transformer + function should also be able to handle candidates with (DISPLAY + . REAL) format.") + + (filtered-candidate-transformer + :initarg :filtered-candidate-transformer + :initform nil + :custom (choice function list) + :documentation + " It has the same format as `candidate-transformer', except the + function is called with two parameters: the candidate list and + the source. + + This transformer is run on the candidate list which is already + filtered by the current pattern. While `candidate-transformer' + is run only once, it is run every time the input pattern is + changed. + + It can be used to transform the candidate list dynamically, for + example, based on the current pattern. + + In some cases it may also be more efficent to perform candidate + transformation here, instead of with `candidate-transformer' + even if this transformation is done every time the pattern is + changed. For example, if a candidate set is very large then + `candidate-transformer' transforms every candidate while only + some of them will currently be displayed due to the limit + imposed by `helm-candidate-number-limit'. + + Note that `candidates' and `candidate-transformer' is run + already, so the given transformer function should also be able + to handle candidates with (DISPLAY . REAL) format.") + + (filter-one-by-one + :initarg :filter-one-by-one + :initform nil + :custom (choice function list) + :documentation + " A transformer function that treat candidates one by one. + It is called with one arg the candidate. + It is faster than `filtered-candidate-transformer' or + `candidate-transformer', but should be used only in sources + that recompute constantly their candidates, e.g `helm-source-find-files'. + Filtering happen early and candidates are treated + one by one instead of re-looping on the whole list. + If used with `filtered-candidate-transformer' or `candidate-transformer' + these functions should treat the candidates transformed by the + `filter-one-by-one' function in consequence.") + + (display-to-real + :initarg :display-to-real + :initform nil + :custom function + :documentation + " Transform the selected candidate when passing it to action. + + Function called with one parameter, the selected candidate. + + Avoid recomputing all candidates with candidate-transformer + or filtered-candidate-transformer to give a new value to REAL, + instead the selected candidate is transformed only when passing it + to action. This works (and make sense) only with plain string + candidates, it will NOT work when candidate is a cons cell, in this + case the real value of candidate will be used. + Example: + + (helm :sources (helm-build-sync-source \"test\" + :candidates \\='(a b c d e) + :display-to-real (lambda (c) (concat c \":modified by d-t-r\"))) + :buffer \"*helm test*\") + + Note that this is NOT a transformer, + so the display will not be modified by this function.") + + (real-to-display + :initarg :real-to-display + :initform nil + :custom function + :documentation + " Recompute all candidates computed previously with other transformers. + + Function called with one parameter, the selected candidate. + + The real value of candidates will be shown in display and of course + be used by action. + Example: + + (helm :sources (helm-build-sync-source \"test\" + :candidates \\='((\"foo\" . 1) (\"bar\" . 2) (\"baz\". 3)) + :real-to-display (lambda (c) (format \"%s\" (1+ c)))) + :buffer \"*helm test*\") + + Mostly deprecated, kept only for backward compatibility.") + + (marked-with-props + :initarg :marked-with-props + :initform nil + :custom (choice boolean symbol) + :documentation + " Get candidates with their properties in `helm-marked-candidates'. + Allow using the FORCE-DISPLAY-PART of `helm-get-selection' in marked + candidates, use t or \\='withprop to pass it to `helm-get-selection'.") + + (action-transformer + :initarg :action-transformer + :initform nil + :custom (choice function list) + :documentation + " It's a function or a list of functions called with two + arguments when the action list from the source is + assembled. The first argument is the list of actions, the + second is the current selection. If it is a list of functions, + it calls each function sequentially. + + The function should return a transformed action list. + + This can be used to customize the list of actions based on the + currently selected candidate.") + + (pattern-transformer + :initarg :pattern-transformer + :initform nil + :custom (choice function list) + :documentation + " It's a function or a list of functions called with one argument + before computing matches. Its argument is `helm-pattern'. + Functions should return transformed `helm-pattern'. + + It is useful to change interpretation of `helm-pattern'.") + + (candidate-number-limit + :initarg :candidate-number-limit + :initform nil + :custom integer + :documentation + " Override `helm-candidate-number-limit' only for this source.") + + (volatile + :initarg :volatile + :initform nil + :custom boolean + :documentation + " Indicates the source assembles the candidate list dynamically, + so it shouldn't be cached within a single Helm + invocation. It is only applicable to synchronous sources, + because asynchronous sources are not cached.") + + (match + :initarg :match + :initform nil + :custom (choice function list) + :documentation + " List of functions called with one parameter: a candidate. The + function should return non-nil if the candidate matches the + current pattern (see variable `helm-pattern'). + + When using `candidates-in-buffer' its default value is `identity' and + don't have to be changed, use the `search' slot instead. + + This attribute allows the source to override the default + pattern matching based on `string-match'. It can be used, for + example, to implement a source for file names and do the + pattern matching on the basename of files, since it's more + likely one is typing part of the basename when searching for a + file, instead of some string anywhere else in its path. + + If the list contains more than one function then the list of + matching candidates from the source is constructed by appending + the results after invoking the first function on all the + potential candidates, then the next function, and so on. The + matching candidates supplied by the first function appear first + in the list of results and then results from the other + functions, respectively. + + This attribute has no effect for asynchronous sources (see + attribute `candidates'), and sources using `match-dynamic' + since they perform pattern matching themselves. + + Note that FUZZY-MATCH slot will overhide value of this slot.") + + (diacritics + :initarg :diacritics + :initform nil + :custom boolean + :documentation + " Ignore diacritics when searching or matching. + + If it is a function, use that function that takes CANDIDATE as single + argument, otherwise, if non-nil use one of the default functions + depending of the method in use, either searching or matching.") + + (match-on-real + :initarg :match-on-real + :initform nil + :custom boolean + :documentation + "Match the real value of candidates when non nil. +Note that this assume you are using (DISPLAY . REAL) candidates and +these candidates are computed as cons cell _before_ +`helm-match-from-candidates' run. This mean you have to compute your +candidates as cons cell either in the :candidates or :init function or +in a :candidate-transformer. Expect an error if you compute your +candidates as cons cell in a :filtered-candidate-transformer.") + + (fuzzy-match + :initarg :fuzzy-match + :initform nil + :custom boolean + :documentation + " Enable fuzzy matching in this source. + This will overwrite settings in MATCH slot, and for + sources built with child class `helm-source-in-buffer' the SEARCH slot. + This also add a `filtered-candidate-transformer' function to sort candidates + (see `helm-fuzzy-sort-fn') according to the score of each candidate which is + computed with `helm-fuzzy-default-score-fn'. + This is an easy way of enabling fuzzy matching, but you can use the MATCH + or SEARCH slots yourself if you want something more elaborated, mixing + different type of match (See `helm-source-buffers' class for example), you + will have in this case to provide as well a sort fn + in `filtered-candidate-transformer' yourself. + + This attribute is not supported for asynchronous sources + since they perform pattern matching themselves.") + + (redisplay + :initarg :redisplay + :initform 'identity + :custom (choice list function) + :documentation + " A function or a list of functions to apply to current list + of candidates when redisplaying buffer with `helm-redisplay-buffer'. + This is only interesting for modifying and redisplaying the whole list + of candidates in async sources. + It uses `identity' by default for when async sources are mixed with + normal sources, in this case these normal sources are not modified and + redisplayed as they are.") + + (nomark + :initarg :nomark + :initform nil + :custom boolean + :documentation + " Don't allow marking candidates when this attribute is present.") + + (nohighlight + :initarg :nohighlight + :initform nil + :custom boolean + :documentation + " Disable highlighting matches in this source. + This will disable generic highlighting of matches, + but some specialized highlighting can be done from elsewhere, + i.e from `filtered-candidate-transformer' or `filter-one-by-one' slots. + So use this to either disable completely highlighting in your source, + or to disable highlighting and use a specialized highlighting matches + function for this source. + Remember that this function should run AFTER all filter functions if those + filter functions are modifying face properties, though it is possible to + avoid this by using new `add-face-text-property' in your filter functions.") + + (allow-dups + :initarg :allow-dups + :initform nil + :custom boolean + :documentation + " Allow helm collecting duplicates candidates.") + + (history + :initarg :history + :initform nil + :custom symbol + :documentation + " Allow passing history variable to helm from source. + It should be a quoted symbol. + Passing the history variable here have no effect + so add it also in the `helm' call with the :history keyword. + The main point of adding the variable here + is to make it available when resuming.") + + (coerce + :initarg :coerce + :initform nil + :custom function + :documentation + " It's a function called with one argument: the selected candidate. + This function is intended for type convertion. In normal case, + the selected candidate (string) is passed to action + function. If coerce function is specified, it is called just + before action function. + + Example: converting string to symbol + (coerce . intern)") + + (mode-line + :initarg :mode-line + :initform nil + :custom (choice string sexp) + :documentation + " Source local `helm-mode-line-string' (included in + `mode-line-format'). It accepts also variable/function name.") + + (header-line + :initarg :header-line + :initform nil + :custom (choice string function) + :documentation + " Source local `header-line-format'. + It will be displayed in `header-line' or in `minibuffer' depending + of value of `helm-echo-input-in-header-line' and `helm-display-header-line'. + It accepts also variable/function name.") + + (resume + :initarg :resume + :initform nil + :custom function + :documentation + " Function called with no parameters at end of initialization + when `helm-resume' is started. + If this function try to do something against `helm-buffer', (e.g updating, + searching etc...) probably you should run it in a timer to ensure + `helm-buffer' is ready.") + + (follow + :initarg :follow + :initform nil + :custom integer + :documentation + " Enable `helm-follow-mode' for this source only. + With a value of 1 enable, a value of -1 or nil disable the mode, value set to + \\='never prevent using `helm-follow-mode' in this source. + See `helm-follow-mode' for more infos.") + + (follow-delay + :initarg :follow-delay + :initform nil + :custom integer + :documentation + " `helm-follow-mode' will execute persistent-action after this delay. + Otherwise value of `helm-follow-input-idle-delay' is used if non--nil, + Fall back to 0.5 when none of these are found.") + + (multimatch + :initarg :multimatch + :initform t + :custom boolean + :documentation + " Use the multi-match algorithm when non-nil. + I.e Allow specifying multiple patterns separated by spaces. + When a pattern is prefixed by \"!\" the negation of this pattern is used, + i.e match anything but this pattern. + It is the standard way of matching in helm and is enabled by default. + It can be used with fuzzy-matching enabled, but as soon helm detect a space, + each pattern will match by regexp and will not be fuzzy.") + + (match-part + :initarg :match-part + :initform nil + :custom function + :documentation + " Allow matching only one part of candidate. + If source contain match-part attribute, match is computed only + on part of candidate returned by the call of function provided + by this attribute. The function should have one arg, candidate, + and return only a specific part of candidate. + On async sources, as matching is done by the backend, this have + no effect apart for highlighting matches.") + + (before-init-hook + :initarg :before-init-hook + :initform nil + :custom symbol + :documentation + " A local hook that run at beginning of initilization of this source. + i.e Before the creation of `helm-buffer'. + + Should be a variable (a symbol) bound to a list of + functions or a single function (see `run-hooks' documentation). + Even better is to use `add-hook' to feed this variable. + Usage of an anonymous function, or a list of functions is still + supported but not recommended.") + + (after-init-hook + :initarg :after-init-hook + :initform nil + :custom symbol + :documentation + " A local hook that run at end of initilization of this source. + i.e After the creation of `helm-buffer'. + + Should be a variable (a symbol) bound to a list of + functions or a single function (see `run-hooks' documentation). + Even better is to use `add-hook' to feed this variable. + Usage of an anonymous function, or a list of functions is still + supported but not recommended.") + + (delayed + :initarg :delayed + :initform nil + :custom (choice null integer) + :documentation + " 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 + " Same as `completing-read' require-match arg. + Possible values are: + - `t' which prevent exiting with an empty helm-buffer i.e. no matches. + - `confirm' which ask for confirmation i.e. need to press a second + time RET. + - `nil' is the default and is doing nothing i.e. returns nil when + pressing RET with an empty helm-buffer. + - Any other non nil values e.g. `ignore' allow exiting with + minibuffer contents as candidate value (in this case helm-buffer + is empty).") + + (find-file-target + :initarg :find-file-target + :initform nil + :custom function + :documentation + " Determine the target file when running `helm-quit-and-find-file'. + It is a function called with one arg SOURCE.") + + (group + :initarg :group + :initform 'helm + :custom symbol + :documentation + " The current source group, default to `helm' when not specified.") + (popup-info + :initarg :popup-info + :initform nil + :custom function + :documentation + " A function that show infos in a popup on the selected candidate. + This happen when `helm-popup-tip-mode' is enabled. + The function is called on candidate.") + (all-marked + :initarg :all-marked + :initform nil + :custom boolean + :documentation + " When non nil display marked candidates from all sources in mode-line.")) + + "Main interface to define helm sources." + :abstract t) + +(defclass helm-source-sync (helm-source) + ((candidates + :initform '("ERROR: You must specify the `candidates' slot, either with a list or a function")) + + (migemo + :initarg :migemo + :initform nil + :custom boolean + :documentation + " Enable migemo. + When multimatch is disabled, you can give the symbol \\='nomultimatch as value + to force not using generic migemo matching function. + In this case you have to provide your own migemo matching funtion + that kick in when `helm-migemo-mode' is enabled. + Otherwise it will be available for this source once `helm-migemo-mode' + is enabled when non-nil.") + + (match-strict + :initarg :match-strict + :initform nil + :custom function + :documentation + " When specifying a match function within a source and + helm-multi-match is enabled, the result of all matching + functions will be concatened, which in some cases is not what + is wanted. When using `match-strict' only this or these + functions will be used. You can specify those functions as a + list of functions or a single symbol function. + + NOTE: This have the same effect as using :MULTIMATCH nil.") + + (match-dynamic + :initarg :match-dynamic + :initform nil + :custom boolean + :documentation + " Disable all helm matching functions when non nil. + The :candidates function in this case is in charge of fetching + candidates dynamically according to `helm-pattern'. + If you want to make your :candidates function working with `completion-styles' + use the function `helm-dynamic-completion'. + Note that :volatile is automatically enabled when using this, so no + need to specify it.")) + + "Use this class to make helm sources using a list of candidates. +This list should be given as a normal list, a variable handling a list +or a function returning a list. +Matching is done basically with `string-match' against each candidate.") + +(defclass helm-source-async (helm-source) + ((candidates-process + :initarg :candidates-process + :initform nil + :custom function + :documentation + " This attribute is used to define a process as candidate. + 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 + as value, otherwise wrap the process call into a function. + The process buffer should be nil, otherwise, if you use + `helm-buffer' give to the process a sentinel.") + + (multimatch :initform nil)) + + "Use this class to define a helm source calling an external process. +The external process is called typically in a `start-process' call to be +asynchronous. + +Note that using multiples asynchronous sources is not fully working, +expect weird behavior if you try this. + +The :candidates slot is not allowed even if described because this class +inherit from `helm-source'.") + +(defclass helm-source-in-buffer (helm-source) + ((init + :initform 'helm-default-init-source-in-buffer-function) + + (data + :initarg :data + :initform nil + :custom (choice list string) + :documentation + " A string, a list or a buffer that will be used to feed the `helm-candidates-buffer'. + This data will be passed in a function added to the init slot and + the buffer will be build with `helm-init-candidates-in-buffer' or directly + with `helm-candidates-buffer' if data is a buffer. + This is an easy and fast method to build a `candidates-in-buffer' source.") + + (migemo + :initarg :migemo + :initform nil + :custom boolean + :documentation + " Enable migemo. + When multimatch is disabled, you can give the symbol \\='nomultimatch as value + to force not using generic migemo matching function. + In this case you have to provide your own migemo matching funtion + that kick in when `helm-migemo-mode' is enabled. + Otherwise it will be available for this source once `helm-migemo-mode' + is enabled when non-nil.") + + (candidates + :initform 'helm-candidates-in-buffer) + + (volatile + :initform t) + + (match + :initform '(identity)) + + (get-line + :initarg :get-line + :initform 'buffer-substring-no-properties + :custom function + :documentation + " A function like `buffer-substring-no-properties' or `buffer-substring'. + This function converts region from point at line-beginning and point + at line-end in the `helm-candidate-buffer' to a string which will be displayed + in the `helm-buffer', it takes two args BEG and END. + By default, `helm-candidates-in-buffer' uses + `buffer-substring-no-properties' which does no conversion and doesn't carry + text properties.") + + (search + :initarg :search + :initform '(helm-candidates-in-buffer-search-default-fn) + :custom (choice function list) + :documentation + " List of functions like `re-search-forward' or `search-forward'. + Buffer search function used by `helm-candidates-in-buffer'. + By default, `helm-candidates-in-buffer' uses `re-search-forward'. + The function should take one arg PATTERN. + If your search function needs to handle negation like multimatch, + this function should returns in such case a cons cell of two integers defining + the beg and end positions to match in the line previously matched by + `re-search-forward' or similar, and move point to next line + (See how the `helm-mm-3-search-base' and `helm-fuzzy-search' functions are working). + + NOTE: FUZZY-MATCH slot will overhide value of this slot.") + + (search-strict + :initarg :search-strict + :initform nil + :custom function + :documentation + " When specifying a search function within a source and + helm-multi-match is enabled, the result of all searching + functions will be concatened, which in some cases is not what + is wanted. When using `search-strict' only this or these + functions will be used. You can specify those functions as a + list of functions or a single symbol function. + + NOTE: This have the same effect as using a nil value for + :MULTIMATCH slot.")) + + "Use this source to make helm sources storing candidates inside a buffer. + +The buffer storing candidates is generated by `helm-candidate-buffer' function +and all search are done in this buffer, results are transfered to the `helm-buffer' +when done. +Contrarily to `helm-source-sync' candidates are matched using a function +like `re-search-forward' (see below documentation of `:search' slot) which makes +the search much faster than matching candidates one by one. +If you want to add search functions to your sources, don't use `:match' which +will raise an error, but `:search'. +See `helm-candidates-in-buffer' for more infos.") + +(defclass helm-source-dummy (helm-source) + ((candidates + :initform '("dummy")) + + (filtered-candidate-transformer + :initform (lambda (_candidates _source) (list helm-pattern))) + + (multimatch + :initform nil) + + (accept-empty + :initarg :accept-empty + :initform t + :custom boolean + :documentation + " Allow exiting with an empty string. + You should keep the default value.") + + (match + :initform 'identity) + + (volatile + :initform t))) + +(defclass helm-source-in-file (helm-source-in-buffer) + ((init :initform (lambda () + (let ((file (helm-get-attr 'candidates-file)) + (count 1)) + (with-current-buffer (helm-candidate-buffer 'global) + (insert-file-contents file) + (goto-char (point-min)) + (when (helm-get-attr 'linum) + (while (not (eobp)) + (add-text-properties + (pos-bol) (pos-eol) + `(helm-linum ,count)) + (cl-incf count) + (forward-line 1))))))) + (get-line :initform #'buffer-substring) + (candidates-file + :initarg :candidates-file + :initform nil + :custom string + :documentation + " The file used to fetch candidates.") + (linum + :initarg :linum + :initform nil + :documentation + " Store line number in each candidate when non nil. + Line number is stored in `helm-linum' text property.")) + + "The contents of the FILE will be used as candidates in buffer.") + + +;;; Error functions +;; +;; +(defun helm-default-init-source-in-buffer-function () + (helm-init-candidates-in-buffer 'global + '("ERROR: No buffer handling your data, use either the `init' slot or the `data' slot."))) + + +;;; Internal Builder functions. +;; +;; +(defun helm--create-source (object) + "[INTERNAL] Build a helm source from OBJECT. +Where OBJECT is an instance of an eieio class." + (cl-loop for sd in (eieio-class-slots (eieio-object-class object)) + for s = (eieio-slot-descriptor-name sd) + for slot-val = (slot-value object s) + when slot-val + collect (cons s slot-val))) + +(defun helm-make-source (name class &rest args) + "Build a `helm' source named NAME with ARGS for CLASS. +Argument NAME is a string which define the source name, so no need to use +the keyword :name in your source, NAME will be used instead. +Argument CLASS is a symbol defining an eieio class object. +Arguments ARGS are keyword value pairs as defined in CLASS." + (declare (indent 2)) + (let ((source (apply #'make-instance class :name name args))) + (helm--setup-source source) + (helm-setup-user-source source) + (helm--create-source source))) + +(defun helm-make-type (class &rest args) + (let ((source (apply #'make-instance class args))) + (setf (slot-value source 'name) nil) + (helm--setup-source source) + (helm--create-source source))) +(make-obsolete 'helm-make-type 'helm-make-source "4.0.3") + +(defvar helm-mm-default-search-functions) +(defvar helm-mm-default-match-functions) + +(defun helm-source-mm-get-search-or-match-fns (source method) + "Prepare match or search functions for class SOURCE. +Argument METHOD is the matching method used by SOURCE either `match' +or `search'." + (let* ((diacritics (slot-value source 'diacritics)) + (diacritics-fn (if (functionp diacritics) + diacritics + (helm-acase method + (match #'helm-mm-3-match-on-diacritics) + (search #'helm-mm-3-search-on-diacritics)))) + (defmatch (helm-aif (slot-value source 'match) + (helm-mklist it))) + (defmatch-strict (helm-aif (and (eq method 'match) + (slot-value source 'match-strict)) + (helm-mklist it))) + (defsearch (helm-aif (and (eq method 'search) + (slot-value source 'search)) + (helm-mklist it))) + (defsearch-strict (helm-aif (and (eq method 'search-strict) + (slot-value source 'search-strict)) + (helm-mklist it))) + (migemo (slot-value source 'migemo)) + ;; Ensure helm-mm-match/search is not used when one of the helm-mm-* + ;; fns is specified directly in source. + (helm-mm-default-match-functions + (if (cl-loop for fn in defmatch + thereis (memq fn '(helm-mm-3f-match + helm-mm-3p-match + helm-mm-3-match + helm-mm-2-match + helm-mm-1-match))) + (remove 'helm-mm-match helm-mm-default-match-functions) + helm-mm-default-match-functions)) + (helm-mm-default-search-functions + (if (cl-loop for fn in defsearch + thereis (memq fn '(helm-mm-3p-search + helm-mm-3-search + helm-mm-2-search + helm-mm-1-search))) + (remove 'helm-mm-search helm-mm-default-search-functions) + helm-mm-default-search-functions))) + (cl-case method + (match (cond (defmatch-strict) + ((and migemo diacritics) + (append (list 'helm-mm-exact-match diacritics-fn) + defmatch '(helm-mm-3-migemo-match))) + (migemo + (append helm-mm-default-match-functions + defmatch '(helm-mm-3-migemo-match))) + (diacritics + (delq nil `(helm-mm-exact-match ,@defmatch ,diacritics-fn))) + (defmatch + (append helm-mm-default-match-functions defmatch)) + (t helm-mm-default-match-functions))) + (search (cond (defsearch-strict) + ((and migemo diacritics) + (append '(helm-mm-exact-search) + defsearch + `(helm-mm-3-migemo-search ,diacritics-fn))) + (migemo + (append helm-mm-default-search-functions + defsearch '(helm-mm-3-migemo-search))) + (diacritics + (delq nil + `(helm-mm-exact-search ,@defsearch ,diacritics-fn))) + (defsearch + (append helm-mm-default-search-functions defsearch)) + (t helm-mm-default-search-functions)))))) + + +;;; Modifiers +;; +(cl-defun helm-source-add-action-to-source-if (name fn source predicate + &optional (index 4)) + "Same as `helm-add-action-to-source-if' but for SOURCE defined as eieio object. +You can use this inside a `helm--setup-source' method for a SOURCE defined as +an eieio class." + (let* ((actions (slot-value source 'action)) + (action-transformers (slot-value source 'action-transformer)) + (new-action (list (cons name fn))) + (transformer (lambda (actions _candidate) + (let ((candidate (car (helm-marked-candidates)))) + (cond ((funcall predicate candidate) + (helm-append-at-nth + actions new-action index)) + (t actions)))))) + (cond ((functionp actions) + (setf (slot-value source 'action) (list (cons "Default action" actions)))) + ((listp actions) + (setf (slot-value source 'action) (helm-interpret-value actions source)))) + (when (or (symbolp action-transformers) (functionp action-transformers)) + (setq action-transformers (list action-transformers))) + (setf (slot-value source 'action-transformer) + (delq nil (append (list transformer) action-transformers))))) + + +;;; Methods to build sources. +;; +;; +(defun helm-source--persistent-help-string (value source) + "Format `persistent-help' VALUE in SOURCE. +Argument VALUE can be a string, a variable or a function." + (substitute-command-keys + (format "\\\\[helm-execute-persistent-action]: %s (keeping session)" + (helm-aif value + (helm-interpret-value value source) + (slot-value source 'header-line))))) + +(defun helm-source--header-line (source) + "Compute a default header line for SOURCE. + +The header line is based on one of `persistent-action-if', +`persistent-action', or `action' (in this order of precedence)." + (substitute-command-keys + (concat "\\\\[helm-execute-persistent-action]: " + (helm-acond + ((slot-value source 'persistent-action-if) + (helm-symbol-name it)) + ((or (slot-value source 'persistent-action) + (slot-value source 'action)) + (cond ((and (symbolp it) + (functionp it) + (eq it 'identity)) + "Do Nothing") + ((and (symbolp it) + (boundp it) + (listp (symbol-value it)) + (stringp (caar (symbol-value it)))) + (caar (symbol-value it))) + ((or (symbolp it) (functionp it)) + (helm-symbol-name it)) + ((listp it) + (let ((action (car it))) + ;; It comes from :action ("foo" . function). + (if (stringp (car action)) + (car action) + ;; It comes from :persistent-action + ;; (function . 'nosplit) Fix Bug#788. + (if (or (symbolp action) + (functionp action)) + (helm-symbol-name action))))) + (t ""))) + (t "")) + " (keeping session)"))) + +(cl-defmethod helm--setup-source ((_source helm-source))) + +(cl-defmethod helm--setup-source :before ((source helm-source)) + (unless (slot-value source 'group) + (setf (slot-value source 'group) 'helm)) + (when (slot-value source 'delayed) + (warn "Deprecated usage of helm `delayed' slot in `%s'" + (slot-value source 'name))) + (helm-aif (slot-value source 'keymap) + (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)) + (setf (slot-value source 'header-line) (helm-source--header-line source))) + (when (slot-value source 'fuzzy-match) + (cl-assert helm-fuzzy-sort-fn nil "Wrong type argument functionp: nil") + (setf (slot-value source 'filtered-candidate-transformer) + (helm-aif (slot-value source 'filtered-candidate-transformer) + (append (helm-mklist it) + (list helm-fuzzy-sort-fn)) + (list helm-fuzzy-sort-fn)))) + (unless (slot-value source 'nohighlight) + (setf (slot-value source 'filtered-candidate-transformer) + (helm-aif (slot-value source 'filtered-candidate-transformer) + (append (helm-mklist it) + (list #'helm-fuzzy-highlight-matches)) + (list #'helm-fuzzy-highlight-matches)))) + (when (numberp (helm-interpret-value (slot-value source 'multiline))) + (setf (slot-value source 'filtered-candidate-transformer) + (helm-aif (slot-value source 'filtered-candidate-transformer) + (append (helm-mklist it) + (list #'helm-multiline-transformer)) + (list #'helm-multiline-transformer)))) + (helm-aif (slot-value source 'requires-pattern) + (let ((val (if (symbolp it) + (symbol-value it) + it))) + (setf (slot-value source 'requires-pattern) val))) + ;; Warn when hooks are defined as something else as a symbol i.e. a lambda or + ;; a list, if a function an error will raise later anyway when this function + ;; is called with `run-hooks'. + (let ((sname (slot-value source 'name))) + (helm-aif (slot-value source 'before-init-hook) + (when (or (and (functionp it) (not (symbolp it))) + (consp it)) + (warn "Helm source `%s': before-init-hook Should be defined as a symbol" sname))) + (helm-aif (slot-value source 'after-init-hook) + (when (or (and (functionp it) (not (symbolp it))) + (consp it)) + (warn "Helm source `%s': after-init-hook Should be defined as a symbol" sname))))) + +(cl-defmethod helm-setup-user-source ((_source helm-source))) + +(cl-defmethod helm--setup-source ((source helm-source-sync)) + (when (slot-value source 'fuzzy-match) + (helm-aif (slot-value source 'match) + (setf (slot-value source 'match) + (append (helm-mklist it) + (list helm-fuzzy-match-fn))) + (setf (slot-value source 'match) helm-fuzzy-match-fn))) + (when (slot-value source 'multimatch) + (setf (slot-value source 'match) + (helm-source-mm-get-search-or-match-fns source 'match))) + (helm-aif (and (null (slot-value source 'multimatch)) + (slot-value source 'migemo)) + (unless (eq it 'nomultimatch) ; Use own migemo fn. + (setf (slot-value source 'match) + (append (helm-mklist (slot-value source 'match)) + '(helm-mm-3-migemo-match))))) + (when (slot-value source 'match-dynamic) + (setf (slot-value source 'match) 'identity) + (setf (slot-value source 'match-part) nil) + (setf (slot-value source 'multimatch) nil) + (setf (slot-value source 'fuzzy-match) nil) + (setf (slot-value source 'volatile) t))) + +(cl-defmethod helm--setup-source ((source helm-source-in-buffer)) + (cl-assert (eq (slot-value source 'candidates) 'helm-candidates-in-buffer) + nil + (format "Wrong usage of `candidates' attr in `%s' use `data' or `init' instead" + (slot-value source 'name))) + (let ((cur-init (slot-value source 'init))) + (helm-aif (slot-value source 'data) + (setf (slot-value source 'init) + (delq + nil + (list + (and (null (eq 'helm-default-init-source-in-buffer-function + cur-init)) + cur-init) + (lambda () + (helm-init-candidates-in-buffer + 'global + (cond ((functionp it) (funcall it)) + ((and (bufferp it) (buffer-live-p it)) + (with-current-buffer it (buffer-string))) + (t it))))))))) + (when (slot-value source 'fuzzy-match) + (helm-aif (slot-value source 'search) + (setf (slot-value source 'search) + (append (helm-mklist it) + (list helm-fuzzy-search-fn))) + (setf (slot-value source 'search) (list helm-fuzzy-search-fn)))) + (when (slot-value source 'multimatch) + (setf (slot-value source 'search) + (helm-source-mm-get-search-or-match-fns source 'search))) + (helm-aif (and (null (slot-value source 'multimatch)) + (slot-value source 'migemo)) + (unless (eq it 'nomultimatch) + (setf (slot-value source 'search) + (append (helm-mklist (slot-value source 'search)) + '(helm-mm-3-migemo-search))))) + (let ((mtc (slot-value source 'match))) + (cl-assert (or (equal '(identity) mtc) + (eq 'identity mtc)) + nil "Invalid slot value for `match'") + (cl-assert (eq (slot-value source 'volatile) t) + nil "Invalid slot value for `volatile'"))) + +(cl-defmethod helm--setup-source ((source helm-source-async)) + (cl-assert (null (slot-value source 'candidates)) + nil "Incorrect use of `candidates' use `candidates-process' instead") + (cl-assert (null (slot-value source 'multimatch)) + nil "`multimatch' not allowed in async sources.") + (cl-assert (null (slot-value source 'fuzzy-match)) + nil "`fuzzy-match' not supported in async sources.")) + +(cl-defmethod helm--setup-source ((source helm-source-dummy)) + (let ((mtc (slot-value source 'match))) + (cl-assert (or (equal '(identity) mtc) + (eq 'identity mtc)) + nil "Invalid slot value for `match'") + (cl-assert (eq (slot-value source 'volatile) t) + nil "Invalid slot value for `volatile'") + (cl-assert (equal (slot-value source 'candidates) '("dummy")) + nil "Invalid slot value for `candidates'") + (cl-assert (eq (slot-value source 'accept-empty) t) + nil "Invalid slot value for `accept-empty'"))) + + +;;; User functions +;; +;; Sources +(defmacro helm-build-sync-source (name &rest args) + "Build a synchronous helm source with name NAME. +Args ARGS are keywords provided by `helm-source-sync'." + (declare (indent 1)) + `(helm-make-source ,name 'helm-source-sync ,@args)) + +(defmacro helm-build-async-source (name &rest args) + "Build a asynchronous helm source with name NAME. +Args ARGS are keywords provided by `helm-source-async'." + (declare (indent 1)) + `(helm-make-source ,name 'helm-source-async ,@args)) + +(defmacro helm-build-in-buffer-source (name &rest args) + "Build a helm source with name NAME using `candidates-in-buffer' method. +Args ARGS are keywords provided by `helm-source-in-buffer'." + (declare (indent 1)) + `(helm-make-source ,name 'helm-source-in-buffer ,@args)) + +(defmacro helm-build-dummy-source (name &rest args) + "Build a helm source with name NAME using `dummy' method. +Args ARGS are keywords provided by `helm-source-dummy'." + (declare (indent 1)) + `(helm-make-source ,name 'helm-source-dummy ,@args)) + +(defmacro helm-build-in-file-source (name file &rest args) + "Build a helm source with NAME name using `candidates-in-files' method. +Arg FILE is a filename, the contents of this file will be +used as candidates in buffer. +Args ARGS are keywords provided by `helm-source-in-file'." + (declare (indent 2)) + `(helm-make-source ,name 'helm-source-in-file + :candidates-file ,file ,@args)) + + +(provide 'helm-source) + +;;; helm-source.el ends here diff --git a/elpa/helm-gtags-20240925.755/helm-gtags-autoloads.el b/elpa/helm-gtags-20240925.755/helm-gtags-autoloads.el deleted file mode 100644 index 3815127e..00000000 --- a/elpa/helm-gtags-20240925.755/helm-gtags-autoloads.el +++ /dev/null @@ -1,117 +0,0 @@ -;;; helm-gtags-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*- -;; Generated by the `loaddefs-generate' function. - -;; This file is part of GNU Emacs. - -;;; Code: - -(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path))) - - - -;;; Generated autoloads from helm-gtags.el - -(autoload 'helm-gtags-clear-all-cache "helm-gtags" "\ -Not documented." t) -(autoload 'helm-gtags-clear-cache "helm-gtags" "\ -Not documented." t) -(autoload 'helm-gtags-next-history "helm-gtags" "\ -Jump to next position on context stack" t) -(autoload 'helm-gtags-previous-history "helm-gtags" "\ -Jump to previous position on context stack" t) -(autoload 'helm-gtags-select "helm-gtags" "\ -Not documented." t) -(autoload 'helm-gtags-select-path "helm-gtags" "\ -Not documented." t) -(autoload 'helm-gtags-tags-in-this-function "helm-gtags" "\ -Show tagnames which are referenced in this function and jump to it." t) -(autoload 'helm-gtags-create-tags "helm-gtags" "\ -Not documented. - -(fn DIR LABEL)" t) -(autoload 'helm-gtags-delete-tags "helm-gtags" "\ -Delete file GTAGS, GRTAGS, GPATH, ID etc. generated by gtags." t) -(autoload 'helm-gtags-find-tag "helm-gtags" "\ -Jump to definition - -(fn TAG)" t) -(autoload 'helm-gtags-find-tag-other-window "helm-gtags" "\ -Jump to definition in other window. - -(fn TAG)" t) -(autoload 'helm-gtags-find-rtag "helm-gtags" "\ -Jump to referenced point - -(fn TAG)" t) -(autoload 'helm-gtags-find-symbol "helm-gtags" "\ -Jump to the symbol location - -(fn TAG)" t) -(autoload 'helm-gtags-find-pattern "helm-gtags" "\ -Grep and jump by gtags tag files. - -(fn PATTERN)" t) -(autoload 'helm-gtags-find-files "helm-gtags" "\ -Find file from tagged with gnu global. - -(fn FILE)" t) -(autoload 'helm-gtags-find-tag-from-here "helm-gtags" "\ -Jump point by current point information. -Jump to definition point if cursor is on its reference. -Jump to reference point if curosr is on its definition" t) -(autoload 'helm-gtags-dwim "helm-gtags" "\ -Find by context. Here is -- on include statement then jump to included file -- on symbol definition then jump to its references -- on reference point then jump to its definition." t) -(autoload 'helm-gtags-parse-file "helm-gtags" "\ -Parse current file with gnu global. This is similar to `imenu'. -You can jump definitions of functions, symbols in this file." t) -(autoload 'helm-gtags-push-stack "helm-gtags" "\ -Push current location to the stack." t) -(autoload 'helm-gtags-pop-stack "helm-gtags" "\ -Jump to previous point on the context stack and pop it from stack." t) -(autoload 'helm-gtags-show-stack "helm-gtags" "\ -Show current context stack." t) -(autoload 'helm-gtags-clear-stack "helm-gtags" "\ -Clear current context stack." t) -(autoload 'helm-gtags-clear-all-stacks "helm-gtags" "\ -Clear all context stacks." t) -(autoload 'helm-gtags-update-tags "helm-gtags" "\ -Update TAG file. Update All files with `C-u' prefix. -Generate new TAG file in selected directory with `C-u C-u'" t) -(autoload 'helm-gtags-resume "helm-gtags" "\ -Resurrect previously invoked `helm-gtags` command." t) -(autoload 'helm-gtags-mode "helm-gtags" "\ -Toggle Helm-Gtags mode on or off. - -This is a minor mode. If called interactively, toggle the `Helm-Gtags -mode' mode. If the prefix argument is positive, enable the mode, and if -it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the mode -if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate the variable `helm-gtags-mode'. - -The mode's hook is called both when the mode is enabled and when it is -disabled. - -(fn &optional ARG)" t) -(register-definition-prefixes "helm-gtags" '("helm-")) - -;;; End of scraped data - -(provide 'helm-gtags-autoloads) - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; no-native-compile: t -;; coding: utf-8-emacs-unix -;; End: - -;;; helm-gtags-autoloads.el ends here diff --git a/elpa/helm-gtags-20240925.755/helm-gtags-pkg.el b/elpa/helm-gtags-20240925.755/helm-gtags-pkg.el deleted file mode 100644 index 03161ad1..00000000 --- a/elpa/helm-gtags-20240925.755/helm-gtags-pkg.el +++ /dev/null @@ -1,10 +0,0 @@ -;; -*- no-byte-compile: t; lexical-binding: nil -*- -(define-package "helm-gtags" "20240925.755" - "GNU GLOBAL helm interface." - '((emacs "24.4") - (helm "2.0")) - :url "https://github.com/emacsorphanage/helm-gtags" - :commit "f51eec4a39d7a38a030fd37e40834f1ca9b61e00" - :revdesc "f51eec4a39d7" - :authors '(("Syohei YOSHIDA" . "syohex@gmail.com")) - :maintainers '(("Jen-Chieh Shen" . "jcs090218@gmail.com"))) diff --git a/elpa/helm-gtags-20240925.755/helm-gtags.el b/elpa/helm-gtags-20240925.755/helm-gtags.el deleted file mode 100644 index 72ceddef..00000000 --- a/elpa/helm-gtags-20240925.755/helm-gtags.el +++ /dev/null @@ -1,1497 +0,0 @@ -;;; helm-gtags.el --- GNU GLOBAL helm interface -*- lexical-binding: t; -*- - -;; Copyright (C) 2016 by Syohei YOSHIDA -;; Copyright (C) 2020-2024 Shen, Jen-Chieh - -;; Author: Syohei YOSHIDA -;; Maintainer: Jen-Chieh Shen -;; URL: https://github.com/syohex/emacs-helm-gtags -;; Package-Version: 20240925.755 -;; Package-Revision: f51eec4a39d7 -;; Package-Requires: ((emacs "24.4") (helm "2.0")) - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Commentary: - -;; `helm-gtags.el' is a `helm' interface of GNU Global. -;; `helm-gtags.el' is not compatible `anything-gtags.el', but `helm-gtags.el' -;; is designed for fast search. - -;; -;; To use this package, add these lines to your init.el or .emacs file: -;; -;; ;; Enable helm-gtags-mode -;; (add-hook 'c-mode-hook 'helm-gtags-mode) -;; (add-hook 'c++-mode-hook 'helm-gtags-mode) -;; (add-hook 'asm-mode-hook 'helm-gtags-mode) -;; -;; ;; Set key bindings -;; (eval-after-load "helm-gtags" -;; '(progn -;; (define-key helm-gtags-mode-map (kbd "M-t") 'helm-gtags-find-tag) -;; (define-key helm-gtags-mode-map (kbd "M-r") 'helm-gtags-find-rtag) -;; (define-key helm-gtags-mode-map (kbd "M-s") 'helm-gtags-find-symbol) -;; (define-key helm-gtags-mode-map (kbd "M-g M-p") 'helm-gtags-parse-file) -;; (define-key helm-gtags-mode-map (kbd "C-c <") 'helm-gtags-previous-history) -;; (define-key helm-gtags-mode-map (kbd "C-c >") 'helm-gtags-next-history) -;; (define-key helm-gtags-mode-map (kbd "M-,") 'helm-gtags-pop-stack))) -;; - -;;; Code: - -(require 'cl-lib) -(require 'helm) -(require 'helm-files) -(require 'which-func) -(require 'pulse) -(require 'subr-x) - -(declare-function helm-comp-read "helm-mode") -(declare-function cygwin-convert-file-name-from-windows "cygw32.c") -(declare-function cygwin-convert-file-name-to-windows "cygw32.c") - -(defgroup helm-gtags nil - "GNU GLOBAL for helm." - :group 'helm) - -(defcustom helm-gtags-path-style 'root - "Style of file path." - :type '(choice (const :tag "Root of the current project" root) - (const :tag "Relative from the current directory" relative) - (const :tag "Absolute Path" absolute))) - -(defcustom helm-gtags-ignore-case nil - "Ignore case in each search." - :type 'boolean - :group 'helm-gtags) - -(defcustom helm-gtags-cygwin-use-global-w32-port t - "Use the GNU global win32 port in Cygwin." - :type 'boolean - :group 'helm-gtags) - -(defcustom helm-gtags-read-only nil - "Gtags read only mode." - :type 'boolean - :group 'helm-gtags) - -(defcustom helm-gtags-auto-update nil - "*If non-nil, tag files are updated whenever a file is saved." - :type 'boolean - :group 'helm-gtags) - -(defcustom helm-gtags-pulse-at-cursor t - "If non-nil, pulse at point after jumping." - :type 'boolean - :group 'helm-gtags) - -(defcustom helm-gtags-cache-select-result nil - "*If non-nil, results of helm-gtags-select and helm-gtags-select-path are cached." - :type 'boolean - :group 'helm-gtags) - -(defcustom helm-gtags-cache-max-result-size (* 10 1024 1024) ;10M - "Max size(bytes) to cache for each select result." - :type 'integer - :group 'helm-gtags) - -(defcustom helm-gtags-update-interval-second 60 - "Tags are updated in `after-save-hook' if this seconds is passed from \ -last update. -Always update if value of this variable is nil." - :type '(choice (integer :tag "Update interval seconds") - (boolean :tag "Update every time" nil)) - :group 'helm-gtags) - -(defcustom helm-gtags-highlight-candidate t - "Highlight candidate or not." - :type 'boolean - :group 'helm-gtags) - -(defcustom helm-gtags-use-input-at-cursor nil - "Use input at cursor." - :type 'boolean - :group 'helm-gtags) - -(defcustom helm-gtags-prefix-key "\C-c" - "If non-nil, it is used for the prefix key of gtags-xxx command." - :type 'string - :group 'helm-gtags) - -(defcustom helm-gtags-suggested-key-mapping nil - "If non-nil, suggested key mapping is enabled." - :type 'boolean - :group 'helm-gtags) - -(defcustom helm-gtags-preselect nil - "If non-nil, preselect current file and line." - :type 'boolean - :group 'helm-gtags) - -(defcustom helm-gtags-display-style nil - "Style of display result." - :type '(choice (const :tag "Show in detail" detail) - (const :tag "Normal style" nil)) - :group 'helm-gtags) - -(defcustom helm-gtags-fuzzy-match nil - "Enable fuzzy match." - :type 'boolean - :group 'helm-gtags) - -(defcustom helm-gtags-maximum-candidates (if helm-gtags-fuzzy-match 100 9999) - "Maximum number of helm candidates." - :type 'integer - :group 'helm-gtags) - -(defcustom helm-gtags-symbol-at-point-function 'helm-gtags--symbol-at-point - "Function to use to get the symbol at point." - :type 'symbol) - -(defcustom helm-gtags-direct-helm-completing nil - "Use helm mode directly." - :type 'boolean - :group 'helm-gtags) - -(defface helm-gtags-file - '((t :inherit font-lock-keyword-face)) - "Face for line numbers in the error list.") - -(defface helm-gtags-lineno - '((t :inherit font-lock-doc-face)) - "Face for line numbers in the error list.") - -(defface helm-gtags-match - '((t :inherit helm-match)) - "Face for word matched against tagname") - -(defvar helm-gtags--tag-location nil) -(defvar helm-gtags--last-update-time 0) -(defvar helm-gtags--completing-history nil) -(defvar helm-gtags--context-stack (make-hash-table :test 'equal)) -(defvar helm-gtags--result-cache (make-hash-table :test 'equal)) -(defvar helm-gtags--saved-context nil) -(defvar helm-gtags--use-otherwin nil) -(defvar helm-gtags--local-directory nil) -(defvar helm-gtags--parsed-file nil) -(defvar helm-gtags--current-position nil) -(defvar helm-gtags--real-tag-location nil) -(defvar helm-gtags--last-input nil) -(defvar helm-gtags--query nil) -(defvar helm-gtags--last-default-directory nil) - -(defconst helm-gtags--buffer "*helm gtags*" - "Not documented.") - -(defconst helm-gtags--include-regexp - "\\`\\s-*#\\(?:include\\|import\\)\\s-*[\"<]\\(?:[./]*\\)?\\(.*?\\)[\">]" - "Not documented.") - -(defmacro helm-declare-obsolete-variable (old new version) - "Not documented, OLD, NEW, VERSION." - `(progn - (defvaralias ,old ,new) - (make-obsolete-variable ,old ,new ,version))) - -(helm-declare-obsolete-variable - 'helm-c-gtags-path-style 'helm-gtags-path-style "0.8") -(helm-declare-obsolete-variable - 'helm-c-gtags-ignore-case 'helm-gtags-ignore-case "0.8") -(helm-declare-obsolete-variable - 'helm-c-gtags-read-only 'helm-gtags-read-only "0.8") - -;; completsion function for completing-read. -(defun helm-gtags--completing-gtags (string predicate code) - (helm-gtags--complete 'tag string predicate code)) -(defun helm-gtags--completing-pattern (string predicate code) - (helm-gtags--complete 'pattern string predicate code)) -(defun helm-gtags--completing-grtags (string predicate code) - (helm-gtags--complete 'rtag string predicate code)) -(defun helm-gtags--completing-gsyms (string predicate code) - (helm-gtags--complete 'symbol string predicate code)) -(defun helm-gtags--completing-files (string predicate code) - (helm-gtags--complete 'find-file string predicate code)) - -(defconst helm-gtags-comp-func-alist - '((tag . helm-gtags--completing-gtags) - (pattern . helm-gtags--completing-pattern) - (rtag . helm-gtags--completing-grtags) - (symbol . helm-gtags--completing-gsyms) - (find-file . helm-gtags--completing-files)) - "Not documented.") - -(defconst helm-gtags--search-option-alist - '((pattern . "-g") - (rtag . "-r") - (symbol . "-s") - (find-file . "-Poa")) - "Not documented.") - -(defsubst helm-gtags--windows-p () - "Not documented." - (memq system-type '(windows-nt ms-dos))) - -(defun helm-gtags--remove-carrige-returns () - "Not documented." - (when (helm-gtags--windows-p) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward "\xd" nil t) - (replace-match ""))))) - -;; Work around for GNU global Windows issue -(defsubst helm-gtags--use-abs-path-p (gtagslibpath) - "Not documented." - (and (helm-gtags--windows-p) gtagslibpath)) - -(defun helm-gtags--construct-options (type completion) - "Not documented." - (let ((find-file-p (eq type 'find-file)) - (gtagslibpath (getenv "GTAGSLIBPATH")) - options) - (unless find-file-p - (push "--result=grep" options)) - (when completion - (push "-c" options)) - (helm-aif (assoc-default type helm-gtags--search-option-alist) - (push it options)) - (when (or (eq helm-gtags-path-style 'absolute) - (helm-gtags--use-abs-path-p gtagslibpath)) - (push "-a" options)) - (when helm-gtags-ignore-case - (push "-i" options)) - (when (and current-prefix-arg (not find-file-p)) - (push "-l" options)) - (when gtagslibpath - (push "-T" options)) - options)) - -(defun helm-gtags--complete (type string predicate code) - "Not documented." - (let* ((options (helm-gtags--construct-options type t)) - (args (reverse (cons string options))) - candidates) - (with-temp-buffer - (apply #'process-file "global" nil t nil args) - (goto-char (point-min)) - (while (re-search-forward "^\\(.+\\)$" nil t) - (push (match-string-no-properties 1) candidates))) - (if (not code) - (try-completion string candidates predicate) - (all-completions string candidates predicate)))) - -(defun helm-gtags--symbol-at-point () - (thing-at-point 'symbol)) - -(defun helm-gtags--token-at-point (type) - "Not documented." - (if (not (eq type 'find-file)) - (funcall helm-gtags-symbol-at-point-function) - (let ((line (helm-current-line-contents))) - (when (string-match helm-gtags--include-regexp line) - (match-string-no-properties 1 line))))) - -(defconst helm-gtags--prompt-alist - '((tag . "Find Definition: ") - (pattern . "Find Pattern: ") - (rtag . "Find Reference: ") - (symbol . "Find Symbol: ") - (find-file . "Find File: ")) - "Not documented.") - -(defun helm-gtags--read-tagname (type &optional default-tagname) - "Not documented." - (let ((tagname (helm-gtags--token-at-point type)) - (prompt (assoc-default type helm-gtags--prompt-alist)) - (comp-func (assoc-default type helm-gtags-comp-func-alist))) - (if (and tagname helm-gtags-use-input-at-cursor) - tagname - (when (and (not tagname) default-tagname) - (setq tagname default-tagname)) - (when tagname - (setq prompt (format "%s(default \"%s\") " prompt tagname))) - (let ((completion-ignore-case helm-gtags-ignore-case) - (completing-read-function 'completing-read-default)) - (if (and helm-gtags-direct-helm-completing (memq type '(tag rtag symbol find-file))) - (helm-comp-read prompt comp-func - :history 'helm-gtags--completing-history - :exec-when-only-one t - :default tagname) - (completing-read prompt comp-func nil nil nil - 'helm-gtags--completing-history tagname)))))) - -(defun helm-gtags--path-libpath-p (tagroot) - "Not documented." - (helm-aif (getenv "GTAGSLIBPATH") - (cl-loop for path in (parse-colon-path it) - for libpath = (file-name-as-directory (expand-file-name path)) - thereis (string= tagroot libpath)))) - -(defsubst helm-gtags--convert-cygwin-windows-file-name-p () - "Not documented." - (and (eq system-type 'cygwin) helm-gtags-cygwin-use-global-w32-port)) - -(defun helm-gtags--tag-directory () - "Not documented." - (with-temp-buffer - (helm-aif (getenv "GTAGSROOT") - it - (unless (zerop (process-file "global" nil t nil "-p")) - (error "GTAGS not found")) - (goto-char (point-min)) - (when (looking-at "^\\([^\r\n]+\\)") - (let ((tag-path (match-string-no-properties 1))) - (file-name-as-directory - (if (helm-gtags--convert-cygwin-windows-file-name-p) - (cygwin-convert-file-name-from-windows tag-path) - tag-path))))))) - -(defun helm-gtags--find-tag-directory () - "Not documented." - (setq helm-gtags--real-tag-location nil) - (let ((tagroot (helm-gtags--tag-directory))) - (if (and (helm-gtags--path-libpath-p tagroot) helm-gtags--tag-location) - (progn - (setq helm-gtags--real-tag-location tagroot) - helm-gtags--tag-location) - (setq helm-gtags--tag-location tagroot)))) - -(defun helm-gtags--base-directory () - "Not documented." - (let ((dir (or helm-gtags--last-default-directory - helm-gtags--local-directory - (cl-case helm-gtags-path-style - (root (or helm-gtags--real-tag-location - helm-gtags--tag-location)) - (otherwise default-directory)))) - (remote (file-remote-p default-directory))) - (if (and remote (not (file-remote-p dir))) - (concat remote dir) - dir))) - -(defsubst helm-gtags--new-context-info (index stack) - "Not documented." - (list :index index :stack stack)) - -(defun helm-gtags--put-context-stack (tag-location index stack) - "Not documented." - (puthash tag-location (helm-gtags--new-context-info index stack) - helm-gtags--context-stack)) - -(defsubst helm-gtags--current-context () - "Not documented." - (let ((file (buffer-file-name (current-buffer)))) - (list :file file :position (point) :readonly buffer-file-read-only))) - -(defsubst helm-gtags--save-current-context () - "Not documented." - (setq helm-gtags--saved-context (helm-gtags--current-context))) - -(defun helm-gtags--open-file (file readonly) - "Not documented." - (if readonly - (find-file-read-only file) - (find-file file))) - -(defun helm-gtags--open-file-other-window (file readonly) - "Not documented." - (setq helm-gtags--use-otherwin nil) - (if readonly - (find-file-read-only-other-window file) - (find-file-other-window file))) - -(defun helm-gtags--get-context-info () - "Not documented." - (let* ((tag-location (helm-gtags--find-tag-directory)) - (context-info (gethash tag-location helm-gtags--context-stack)) - (context-stack (plist-get context-info :stack))) - (if (null context-stack) - (error "Context stack is empty(TAG at %s)" tag-location) - context-info))) - -(defun helm-gtags--get-or-create-context-info () - "Not documented." - (or (gethash helm-gtags--tag-location helm-gtags--context-stack) - (helm-gtags--new-context-info -1 nil))) - -;;;###autoload -(defun helm-gtags-clear-all-cache () - "Not documented." - (interactive) - (clrhash helm-gtags--result-cache)) - -;;;###autoload -(defun helm-gtags-clear-cache () - "Not documented." - (interactive) - (helm-gtags--find-tag-directory) - (let* ((tag-location (or helm-gtags--real-tag-location - helm-gtags--tag-location)) - (gtags-path (concat tag-location "GTAGS")) - (gpath-path (concat tag-location "GPATH"))) - (remhash gtags-path helm-gtags--result-cache) - (remhash gpath-path helm-gtags--result-cache))) - -(defun helm-gtags--move-to-context (context) - "Not documented." - (let ((file (plist-get context :file)) - (curpoint (plist-get context :position)) - (readonly (plist-get context :readonly))) - (helm-gtags--open-file file readonly) - (goto-char curpoint) - (recenter))) - -;;;###autoload -(defun helm-gtags-next-history () - "Jump to next position on context stack" - (interactive) - (let* ((context-info (helm-gtags--get-context-info)) - (current-index (plist-get context-info :index)) - (context-stack (plist-get context-info :stack)) - context) - (when (<= current-index -1) - (error "This context is latest in context stack")) - (setf (nth current-index context-stack) (helm-gtags--current-context)) - (cl-decf current-index) - (if (= current-index -1) - (setq context helm-gtags--current-position - helm-gtags--current-position nil) - (setq context (nth current-index context-stack))) - (helm-gtags--put-context-stack helm-gtags--tag-location - current-index context-stack) - (helm-gtags--move-to-context context))) - -;;;###autoload -(defun helm-gtags-previous-history () - "Jump to previous position on context stack" - (interactive) - (let* ((context-info (helm-gtags--get-context-info)) - (current-index (plist-get context-info :index)) - (context-stack (plist-get context-info :stack)) - (context-length (length context-stack))) - (cl-incf current-index) - (when (>= current-index context-length) - (error "This context is last in context stack")) - (if (= current-index 0) - (setq helm-gtags--current-position (helm-gtags--current-context)) - (setf (nth (- current-index 1) context-stack) (helm-gtags--current-context))) - (let ((prev-context (nth current-index context-stack))) - (helm-gtags--move-to-context prev-context)) - (helm-gtags--put-context-stack helm-gtags--tag-location - current-index context-stack))) - -(defun helm-gtags--get-result-cache (file) - "Not documented." - (helm-gtags--find-tag-directory) - (let* ((file-path (concat (or helm-gtags--real-tag-location - helm-gtags--tag-location) - file)) - (file-mtime (nth 5 (file-attributes file-path))) - (hash-value (gethash file-path helm-gtags--result-cache)) - (cached-file-mtime (nth 0 hash-value))) - (if (and cached-file-mtime (equal cached-file-mtime file-mtime)) - (nth 1 hash-value) - nil))) - -(defun helm-gtags--put-result-cache (file cache) - "Not documented." - (helm-gtags--find-tag-directory) - (let* ((file-path (concat (or helm-gtags--real-tag-location - helm-gtags--tag-location) - file)) - (file-mtime (nth 5 (file-attributes file-path))) - (hash-value (list file-mtime cache))) - (puthash file-path hash-value helm-gtags--result-cache))) - -(defun helm-gtags--referer-function (file ref-line) - "Not documented." - (let ((is-opened (cl-loop with path = (concat default-directory file) - for buf in (buffer-list) - when (string= (buffer-file-name buf) path) - return it)) - retval) - (with-current-buffer (find-file-noselect file) - (goto-char (point-min)) - (forward-line (1- ref-line)) - (unless (zerop (current-indentation)) - (setq retval (which-function))) - (unless is-opened - (kill-buffer (current-buffer))) - retval))) - -(defun helm-gtags--show-detail () - "Not documented." - (goto-char (point-min)) - (while (not (eobp)) - (let ((line (helm-current-line-contents))) - (let* ((file-and-line (helm-gtags--extract-file-and-line line)) - (file (car file-and-line)) - (ref-line (cdr file-and-line)) - (ref-func (helm-gtags--referer-function file ref-line))) - (when ref-func - (search-forward ":" nil nil 2) - (insert " " ref-func "|")) - (forward-line 1))))) - -(defun helm-gtags--print-path-in-gtagslibpath (args) - "Not documented." - (let ((libpath (getenv "GTAGSLIBPATH"))) - (when libpath - (dolist (path (parse-colon-path libpath)) - (let ((default-directory (file-name-as-directory path))) - (apply #'process-file "global" nil t nil "-Poa" args)))))) - -(defun helm-gtags--exec-global-command (type input &optional detail) - "Not documented." - (let ((args (helm-gtags--construct-command type input))) - (helm-gtags--find-tag-directory) - (helm-gtags--save-current-context) - (let ((buf-coding buffer-file-coding-system)) - (with-current-buffer (helm-candidate-buffer 'global) - (let ((default-directory (helm-gtags--base-directory)) - (input (car (last args))) - (coding-system-for-read buf-coding) - (coding-system-for-write buf-coding)) - (unless (zerop (apply #'process-file "global" nil '(t nil) nil args)) - (error (format "%s: not found" input))) - ;; --path options does not support searching under GTAGSLIBPATH - (when (eq type 'find-file) - (helm-gtags--print-path-in-gtagslibpath args)) - (helm-gtags--remove-carrige-returns) - (when detail - (helm-gtags--show-detail))))))) - -(defun helm-gtags--construct-command (type &optional in) - "Not documented." - (setq helm-gtags--local-directory nil) - (let ((dir (helm-attr 'helm-gtags-base-directory (helm-get-current-source)))) - (when (and dir (not (eq type 'find-file))) - (setq helm-gtags--local-directory dir))) - (let ((input (or in helm-gtags--query)) - (options (helm-gtags--construct-options type nil))) - (when (string-empty-p input) - (error "Input is empty!!")) - (setq helm-gtags--last-input input) - (reverse (cons input options)))) - -(defun helm-gtags--tags-init (&optional input) - "Not documented." - (helm-gtags--exec-global-command 'tag input)) - -(defun helm-gtags--pattern-init (&optional input) - "Not documented." - (helm-gtags--exec-global-command 'pattern input helm-gtags-display-style)) - -(defun helm-gtags--rtags-init (&optional input) - "Not documented." - (helm-gtags--exec-global-command 'rtag input helm-gtags-display-style)) - -(defun helm-gtags--gsyms-init () - "Not documented." - (helm-gtags--exec-global-command 'symbol nil helm-gtags-display-style)) - -(defun helm-gtags--files-init () - "Not documented." - (helm-gtags--exec-global-command 'find-file nil)) - -(defun helm-gtags--real-file-name () - "Not documented." - (let ((buffile (buffer-file-name))) - (unless buffile - (error "This buffer is not related to file.")) - (if (file-remote-p buffile) - (tramp-file-name-localname (tramp-dissect-file-name buffile)) - (file-truename buffile)))) - -(defun helm-gtags--find-tag-from-here-init () - "Not documented." - (helm-gtags--find-tag-directory) - (helm-gtags--save-current-context) - (let ((token (helm-gtags--token-at-point 'from-here))) - (unless token - (error "Cursor is not on symbol.")) - (let* ((filename (helm-gtags--real-file-name)) - (from-here-opt (format "--from-here=%d:%s" - (line-number-at-pos) - (if (helm-gtags--convert-cygwin-windows-file-name-p) - (cygwin-convert-file-name-to-windows filename) - filename)))) - (setq helm-gtags--last-input token) - (with-current-buffer (helm-candidate-buffer 'global) - (let* ((default-directory (helm-gtags--base-directory)) - (status (process-file "global" nil '(t nil) nil - "--result=grep" from-here-opt token))) - (helm-gtags--remove-carrige-returns) - (unless (zerop status) - (cond ((= status 1) - (error "Error: %s%s" (buffer-string) filename)) - ((= status 3) - (error "Error: %s" (buffer-string))) - (t (error "%s: not found" token))))))))) - -(defun helm-gtags--parse-file-init () - "Not documented." - (with-current-buffer (helm-candidate-buffer 'global) - (unless (zerop (process-file "global" nil t nil - "--result=cscope" "-f" helm-gtags--parsed-file)) - (error "Failed: 'global --result=cscope -f %s" helm-gtags--parsed-file)) - (helm-gtags--remove-carrige-returns))) - -(defun helm-gtags--push-context (context) - "Not documented." - (let* ((context-info (helm-gtags--get-or-create-context-info)) - (current-index (plist-get context-info :index)) - (context-stack (plist-get context-info :stack))) - (unless (= current-index -1) - (setq context-stack (nthcdr (1+ current-index) context-stack))) - (setq helm-gtags--current-position nil) - (push context context-stack) - (helm-gtags--put-context-stack helm-gtags--tag-location -1 context-stack))) - -(defsubst helm-gtags--select-find-file-func () - "Not documented." - (if helm-gtags--use-otherwin - #'helm-gtags--open-file-other-window - #'helm-gtags--open-file)) - -(defun helm-gtags--do-open-file (open-func file line) - "Not documented." - (funcall open-func file helm-gtags-read-only) - (goto-char (point-min)) - (forward-line (1- line)) - (back-to-indentation) - (recenter) - (helm-gtags--push-context helm-gtags--saved-context) - (when helm-gtags-pulse-at-cursor - (pulse-momentary-highlight-one-line (point)))) - -(defun helm-gtags--find-line-number (cand) - "Not documented." - (if (string-match "\\s-+\\([1-9][0-9]+\\)\\s-+" cand) - (string-to-number (match-string-no-properties 1 cand)) - (error "Can't find line number in %s" cand))) - -(defun helm-gtags--parse-file-action (cand) - "Not documented." - (let ((line (helm-gtags--find-line-number cand)) - (open-func (helm-gtags--select-find-file-func))) - (helm-gtags--do-open-file open-func helm-gtags--parsed-file line))) - -(defsubst helm-gtags--has-drive-letter-p (path) - "Not documented." - (string-match-p "\\`[a-zA-Z]:" path)) - -(defun helm-gtags--extract-file-and-line (cand) - "Not documented." - (if (and (helm-gtags--windows-p) (helm-gtags--has-drive-letter-p cand)) - (when (string-match "\\(\\`[a-zA-Z]:[^:]+\\):\\([^:]+\\)" cand) - (cons (match-string-no-properties 1 cand) - (string-to-number (match-string-no-properties 2 cand)))) - (let ((elems (split-string cand ":"))) - (cons (cl-first elems) (string-to-number (cl-second elems)))))) - -(defun helm-gtags--action-openfile (cand) - "Not documented." - (let* ((file-and-line (helm-gtags--extract-file-and-line cand)) - (filename (car file-and-line)) - (line (cdr file-and-line)) - (open-func (helm-gtags--select-find-file-func)) - (default-directory (helm-gtags--base-directory))) - (helm-gtags--do-open-file open-func filename line))) - -(defun helm-gtags--action-openfile-other-window (cand) - "Not documented." - (let ((helm-gtags--use-otherwin t)) - (helm-gtags--action-openfile cand))) - -(defun helm-gtags--file-content-at-pos (file pos) - "Not documented." - (with-current-buffer (find-file-noselect file) - (save-excursion - (goto-char pos) - (format "%s:%d:%s:%s" - file (line-number-at-pos) - (helm-aif (which-function) (format "[%s]" it) "") - (helm-current-line-contents))))) - -(defun helm-gtags--files-candidate-transformer (file) - "Not documented." - (if (eq helm-gtags-path-style 'absolute) - file - (let ((removed-regexp (concat "\\`" helm-gtags--tag-location))) - (replace-regexp-in-string removed-regexp "" file)))) - -(defun helm-gtags--show-stack-init () - "Not documented." - (cl-loop with context-stack = (plist-get (helm-gtags--get-context-info) :stack) - with stack-length = (length context-stack) - for context in (reverse context-stack) - for file = (plist-get context :file) - for pos = (plist-get context :position) - for index = (1- stack-length) then (1- index) - for line = (helm-gtags--file-content-at-pos file pos) - for cand = (helm-gtags--files-candidate-transformer line) - collect (cons cand (propertize cand 'index index)))) - -(defun helm-gtags--persistent-action (cand) - "Not documented." - (let* ((file-and-line (helm-gtags--extract-file-and-line cand)) - (filename (car file-and-line)) - (line (cdr file-and-line)) - (default-directory (helm-gtags--base-directory))) - (when (eq helm-gtags-path-style 'relative) - (setq helm-gtags--last-default-directory default-directory)) - (find-file filename) - (goto-char (point-min)) - (forward-line (1- line)) - (helm-highlight-current-line))) - -(defvar helm-gtags--find-file-action - (helm-make-actions - "Open file" #'helm-gtags--action-openfile - "Open file other window" #'helm-gtags--action-openfile-other-window) - "Not documented.") - -(defvar helm-source-gtags-tags - (helm-build-in-buffer-source "Jump to definitions" - :init 'helm-gtags--tags-init - :candidate-number-limit helm-gtags-maximum-candidates - :real-to-display 'helm-gtags--candidate-transformer - :persistent-action 'helm-gtags--persistent-action - :fuzzy-match helm-gtags-fuzzy-match - :action helm-gtags--find-file-action) - "Not documented.") - -(defvar helm-source-gtags-pattern - (helm-build-in-buffer-source "Find pattern" - :init 'helm-gtags--pattern-init - :candidate-number-limit helm-gtags-maximum-candidates - :real-to-display 'helm-gtags--candidate-transformer - :persistent-action 'helm-gtags--persistent-action - :fuzzy-match helm-gtags-fuzzy-match - :action helm-gtags--find-file-action) - "Not documented.") - -(defvar helm-source-gtags-rtags - (helm-build-in-buffer-source "Jump to references" - :init 'helm-gtags--rtags-init - :candidate-number-limit helm-gtags-maximum-candidates - :real-to-display 'helm-gtags--candidate-transformer - :persistent-action 'helm-gtags--persistent-action - :fuzzy-match helm-gtags-fuzzy-match - :action helm-gtags--find-file-action) - "Not documented.") - -(defvar helm-source-gtags-gsyms - (helm-build-in-buffer-source "Jump to symbols" - :init 'helm-gtags--gsyms-init - :candidate-number-limit helm-gtags-maximum-candidates - :real-to-display 'helm-gtags--candidate-transformer - :persistent-action 'helm-gtags--persistent-action - :fuzzy-match helm-gtags-fuzzy-match - :action helm-gtags--find-file-action) - "Not documented.") - -(defun helm-gtags--highlight-candidate (candidate) - "Not documented." - (let ((regexp (concat "\\_<" helm-gtags--last-input "\\_>")) - (limit (1- (length candidate))) - (last-pos 0) - (case-fold-search nil)) - (while (and (< last-pos limit) - (string-match regexp candidate last-pos)) - (put-text-property (match-beginning 0) (match-end 0) - 'face 'helm-gtags-match - candidate) - (setq last-pos (1+ (match-end 0)))) - candidate)) - -(defun helm-gtags--transformer-regexp (candidate) - "Not documented." - (if (and (helm-gtags--windows-p) (helm-gtags--has-drive-letter-p candidate)) - "\\`\\([a-zA-Z]:[^:]+\\):\\([^:]+\\):\\(.*\\)" - "\\`\\([^:]+\\):\\([^:]+\\):\\(.*\\)")) - -(defun helm-gtags--candidate-transformer (candidate) - "Not documented." - (if (not helm-gtags-highlight-candidate) - candidate - (let ((regexp (helm-gtags--transformer-regexp candidate))) - (when (string-match regexp candidate) - (format "%s:%s:%s" - (propertize (match-string 1 candidate) 'face 'helm-gtags-file) - (propertize (match-string 2 candidate) 'face 'helm-gtags-lineno) - (helm-gtags--highlight-candidate (match-string 3 candidate))))))) - -(defun helm-gtags--parse-file-candidate-transformer (file) - "Not documented." - (let ((removed-file (replace-regexp-in-string "\\`\\S-+ " "" file))) - (when (string-match "\\`\\(\\S-+\\) \\(\\S-+\\) \\(.+\\)\\'" removed-file) - (format "%-25s %-5s %s" - (match-string-no-properties 1 removed-file) - (match-string-no-properties 2 removed-file) - (match-string-no-properties 3 removed-file))))) - -(defvar helm-source-gtags-find-tag-from-here - (helm-build-in-buffer-source "Find tag from here" - :init 'helm-gtags--find-tag-from-here-init - :candidate-number-limit helm-gtags-maximum-candidates - :real-to-display 'helm-gtags--candidate-transformer - :persistent-action 'helm-gtags--persistent-action - :fuzzy-match helm-gtags-fuzzy-match - :action helm-gtags--find-file-action) - "Not documented.") - -(defvar helm-source-gtags-parse-file - (helm-build-in-buffer-source "Parse file" - :init 'helm-gtags--parse-file-init - :candidate-number-limit helm-gtags-maximum-candidates - :real-to-display 'helm-gtags--parse-file-candidate-transformer - :fuzzy-match helm-gtags-fuzzy-match - :action 'helm-gtags--parse-file-action) - "Not documented.") - -(defun helm-gtags--show-stack-action (cand) - "Not documented." - (let* ((index (get-text-property 0 'index cand)) - (context-info (helm-gtags--get-context-info)) - (context-stack (plist-get context-info :stack))) - (helm-gtags--put-context-stack helm-gtags--tag-location - index context-stack) - (helm-gtags--move-to-context (nth index context-stack)))) - -(defvar helm-source-gtags-show-stack - (helm-build-sync-source "Show Context Stack" - :candidates 'helm-gtags--show-stack-init - :volatile t - :candidate-number-limit helm-gtags-maximum-candidates - :persistent-action 'helm-gtags--persistent-action - :fuzzy-match helm-gtags-fuzzy-match - :action 'helm-gtags--show-stack-action) - "Not documented.") - -;;;###autoload -(defun helm-gtags-select () - "Not documented." - (interactive) - (helm-gtags--common '(helm-source-gtags-select) nil)) - -;;;###autoload -(defun helm-gtags-select-path () - "Not documented." - (interactive) - (helm-gtags--common '(helm-source-gtags-select-path) nil)) - -(defsubst helm-gtags--beginning-of-defun () - "Not documented." - (cl-case major-mode - ((c-mode c++-mode java-mode) 'c-beginning-of-defun) - (php-mode 'php-beginning-of-defun) - (otherwise #'beginning-of-defun))) - -(defsubst helm-gtags--end-of-defun () - "Not documented." - (cl-case major-mode - ((c-mode c++-mode java-mode malabar-mode) 'c-end-of-defun) - (php-mode 'php-end-of-defun) - (otherwise #'end-of-defun))) - -(defun helm-gtags--current-funcion-bound () - "Not documented." - (save-excursion - (let (start) - (funcall (helm-gtags--beginning-of-defun)) - (setq start (line-number-at-pos)) - (funcall (helm-gtags--end-of-defun)) - (cons start (line-number-at-pos))))) - -(defun helm-gtags--tags-refered-from-this-function () - "Not documented." - (let* ((file (helm-gtags--real-file-name)) - (bound (helm-gtags--current-funcion-bound)) - (start-line (car bound)) - (end-line (cdr bound))) - (with-temp-buffer - (unless (process-file "global" nil t nil "-f" "-r" file) - (error "Failed: global -f -r %s" file)) - (goto-char (point-min)) - (let (tagnames finish) - (while (and (not finish) (not (eobp))) - (let* ((cols (split-string (helm-current-line-contents) nil t)) - (lineno (string-to-number (cl-second cols)))) - (if (and (> lineno start-line) (< lineno end-line)) - (let* ((tag (cl-first cols)) - (elm (cl-find tag tagnames :test 'equal))) - (unless elm - (push tag tagnames))) - (when (>= lineno end-line) - (setq finish t))) - (forward-line 1))) - (reverse tagnames))))) - -(defun helm-gtags--tag-in-function-persistent-action (cand) - "Not documented." - (let* ((bound (helm-gtags--current-funcion-bound)) - (limit (save-excursion - (goto-char (point-min)) - (forward-line (cdr bound)) - (goto-char (line-end-position)) - (point)))) - (when (search-forward cand nil limit) - (helm-highlight-current-line)))) - -;;;###autoload -(defun helm-gtags-tags-in-this-function () - "Show tagnames which are referenced in this function and jump to it." - (interactive) - (let ((tags (helm-gtags--tags-refered-from-this-function))) - (unless tags - (error "There are no tags which are refered from this function.")) - (let* ((name (format "Tags in [%s]" (which-function))) - (tag (helm-comp-read - "Tagnames: " tags - :must-match t :name name - :persistent-action 'helm-gtags--tag-in-function-persistent-action))) - (helm-gtags-find-tag tag)))) - -(defun helm-gtags--source-select-tag (candidate) - "Not documented." - (helm-build-in-buffer-source "Select Tag" - :init (lambda () (helm-gtags--tags-init candidate)) - :candidate-number-limit helm-gtags-maximum-candidates - :persistent-action 'helm-gtags--persistent-action - :fuzzy-match helm-gtags-fuzzy-match - :action helm-gtags--find-file-action)) - -(defun helm-gtags--source-select-rtag (candidate) - "Not documented." - (helm-build-in-buffer-source "Select Rtag" - :init (lambda () (helm-gtags--rtags-init candidate)) - :candidate-number-limit helm-gtags-maximum-candidates - :persistent-action 'helm-gtags--persistent-action - :fuzzy-match helm-gtags-fuzzy-match - :action helm-gtags--find-file-action)) - -(defsubst helm-gtags--action-by-timer (src) - "Not documented." - (run-with-timer 0.1 nil (lambda () (helm-gtags--common (list src) nil)))) - -(defun helm-gtags--select-tag-action (c) - "Not documented." - (helm-gtags--action-by-timer (helm-gtags--source-select-tag c))) - -(defun helm-gtags--select-rtag-action (c) - "Not documented." - (helm-gtags--action-by-timer (helm-gtags--source-select-rtag c))) - -(defun helm-gtags--select-cache-init-common (args tagfile) - "Not documented." - (let ((cache (helm-gtags--get-result-cache tagfile))) - (if cache - (insert cache) - (apply #'process-file "global" nil t nil args) - (let* ((cache (buffer-string)) - (cache-size (length cache))) - (when (<= cache-size helm-gtags-cache-max-result-size) - (helm-gtags--put-result-cache tagfile cache)))))) - -(defun helm-gtags--source-select-init () - "Not documented." - (with-current-buffer (helm-candidate-buffer 'global) - (if (not helm-gtags-cache-select-result) - (progn - (process-file "global" nil t nil "-c") - (helm-gtags--remove-carrige-returns)) - (helm-gtags--select-cache-init-common '("-c") "GTAGS")))) - -(defvar helm-source-gtags-select - (helm-build-in-buffer-source "Find tag from here" - :init 'helm-gtags--source-select-init - :candidate-number-limit helm-gtags-maximum-candidates - :persistent-action #'ignore - :fuzzy-match helm-gtags-fuzzy-match - :action (helm-make-actions - "Goto the location" #'helm-gtags--select-tag-action - "Goto the location(other buffer)" - (lambda (c) - (setq helm-gtags--use-otherwin t) - (helm-gtags--select-tag-action c)) - "Move to the referenced point" #'helm-gtags--select-rtag-action)) - "Not documented.") - -(defun helm-gtags--select-path-init () - "Not documented." - (helm-gtags--find-tag-directory) - (with-current-buffer (helm-candidate-buffer 'global) - (let ((options (if (eq helm-gtags-path-style 'relative) "-Po" "-Poa"))) - (if (not helm-gtags-cache-select-result) - (progn - (process-file "global" nil t nil options) - (helm-gtags--remove-carrige-returns)) - (helm-gtags--select-cache-init-common (list options) "GPATH"))))) - -(defun helm-gtags--file-name (name) - "Not documented." - (let ((remote (file-remote-p default-directory))) - (if (not remote) - name - (cl-case helm-gtags-path-style - (relative name) - (otherwise (concat remote name)))))) - -(defun helm-gtags--find-file-common (open-fn cand) - "Not documented." - (let ((default-directory (helm-gtags--base-directory))) - (funcall open-fn (helm-gtags--file-name cand)))) - -(defun helm-gtags--find-file (cand) - "Not documented." - (helm-gtags--find-file-common #'find-file cand)) - -(defun helm-gtags--find-file-other-window (cand) - "Not documented." - (helm-gtags--find-file-common #'find-file-other-window cand)) - -(defvar helm-gtags--file-util-action - (helm-make-actions - "Open file" #'helm-gtags--find-file - "Open file other window" #'helm-gtags--find-file-other-window) - "Not documented.") - -(defun helm-gtags--file-persistent-action (cand) - "Not documented." - (let ((default-directory (with-helm-current-buffer - default-directory))) - (helm-ff-kill-or-find-buffer-fname (helm-gtags--file-name cand)))) - -(defvar helm-source-gtags-select-path - (helm-build-in-buffer-source "Select path" - :init 'helm-gtags--select-path-init - :candidate-number-limit helm-gtags-maximum-candidates - :real-to-display 'helm-gtags--files-candidate-transformer - :persistent-action #'helm-gtags--file-persistent-action - :fuzzy-match helm-gtags-fuzzy-match - :action helm-gtags--file-util-action) - "Not documented.") - -(defun helm-gtags--searched-directory () - "Not documented." - (cl-case (prefix-numeric-value current-prefix-arg) - (4 (let ((dir (read-directory-name "Input Directory: "))) - (setq helm-gtags--local-directory (file-name-as-directory dir)))) - (16 (file-name-directory (buffer-file-name))))) - -(defsubst helm-gtags--using-other-window-p () - "Not documented." - (< (prefix-numeric-value current-prefix-arg) 0)) - -(defun helm-gtags--make-gtags-sentinel (action) - "Not documented." - (lambda (process _event) - (when (eq (process-status process) 'exit) - (if (zerop (process-exit-status process)) - (message "Success: %s TAGS" action) - (message "Failed: %s TAGS(%d)" action (process-exit-status process)))))) - -(defsubst helm-gtags--read-gtagslabel () - "Not documented." - (let ((labels '("default" "native" "ctags" "new-ctags" "pygments"))) - (completing-read "GTAGSLABEL(Default: default): " labels nil t nil nil "default"))) - -(defsubst helm-gtags--label-option (label) - "Not documented." - (concat "--gtagslabel=" label)) - -;;;###autoload -(defun helm-gtags-create-tags (dir label) - "Not documented." - (interactive - (list (read-directory-name "Root Directory: ") - (helm-gtags--read-gtagslabel))) - (let ((default-directory dir) - (proc-buf (get-buffer-create " *helm-gtags-create*"))) - (let ((proc (start-file-process "helm-gtags-create" proc-buf - "gtags" "-q" (helm-gtags--label-option label)))) - (set-process-sentinel proc (helm-gtags--make-gtags-sentinel 'create))))) - -(defun helm-gtags--find-tag-simple () - "Not documented." - (or (getenv "GTAGSROOT") - (locate-dominating-file default-directory "GTAGS") - (if (not (yes-or-no-p "File GTAGS not found. Run 'gtags'? ")) - (user-error "Abort") - (let* ((tagroot (read-directory-name "Root Directory: ")) - (label (helm-gtags--read-gtagslabel)) - (default-directory tagroot)) - (message "gtags is generating tags....") - (let ((label-opt (helm-gtags--label-option label))) - (unless (zerop (process-file "gtags" nil nil nil "-q" label-opt)) - (error "Failed: 'gtags -q %s'" label-opt))) - tagroot)))) - -(defun helm-gtags--current-file-and-line () - "Not documented." - (let* ((buffile (buffer-file-name)) - (path (cl-case helm-gtags-path-style - (absolute buffile) - (root - (file-relative-name buffile (helm-gtags--find-tag-directory))) - (relative - (file-relative-name buffile (helm-gtags--base-directory)))))) - (format "%s:%d" path (line-number-at-pos)))) - -(defsubst helm-gtags--clear-variables () - "Not documented." - (setq helm-gtags--last-default-directory nil)) - -(defun helm-gtags--common (srcs tagname) - "Not documented." - (helm-gtags--clear-variables) - (let ((helm-quit-if-no-candidate t) - (helm-execute-action-at-once-if-one t) - (dir (helm-gtags--searched-directory)) - (src (car srcs)) - (preselect-regexp (when helm-gtags-preselect - (regexp-quote (helm-gtags--current-file-and-line))))) - (when (symbolp src) - (setq src (symbol-value src))) - (unless helm-gtags--use-otherwin - (setq helm-gtags--use-otherwin (helm-gtags--using-other-window-p))) - (when tagname - (setq helm-gtags--query tagname)) - (let ((tagroot (helm-gtags--find-tag-simple))) - (helm-attrset 'helm-gtags-base-directory dir src) - (when tagname - (helm-attrset 'name (format "%s in %s" tagname (or dir tagroot)) src)) - (helm :sources srcs :buffer helm-gtags--buffer - :preselect preselect-regexp)))) - -;;;###autoload -(defun helm-gtags-delete-tags () - "Delete file GTAGS, GRTAGS, GPATH, ID etc. generated by gtags." - (interactive) - (let* ((root-dir (helm-gtags--tag-directory)) - (re (concat "\\`" (regexp-opt '("GPATH" "GRTAGS" "GTAGS" "ID")) "\\'")) - (files (cl-remove-if-not - (lambda (file) - ;; Don't trust `directory-files'. - (let ((case-fold-search nil)) - (string-match-p re (file-name-nondirectory file)))) - (directory-files root-dir t re))) - (buffer "*GTags File List*")) - (unless files - (user-error "No tag files found")) - (with-output-to-temp-buffer buffer - (princ (mapconcat #'identity files "\n"))) - (let ((win (get-buffer-window buffer))) - (unwind-protect - (progn - (fit-window-to-buffer win) - (when (yes-or-no-p "Remove GNU Global tag files? ") - (with-demoted-errors (mapc #'delete-file files)))) - (when (window-live-p win) - (quit-window t win)))))) - -;;;###autoload -(defun helm-gtags-find-tag (tag) - "Jump to definition" - (interactive - (list (helm-gtags--read-tagname 'tag))) - (helm-gtags--common '(helm-source-gtags-tags) tag)) - -;;;###autoload -(defun helm-gtags-find-tag-other-window (tag) - "Jump to definition in other window." - (interactive - (list (helm-gtags--read-tagname 'tag))) - (setq helm-gtags--use-otherwin t) - (helm-gtags-find-tag tag)) - -;;;###autoload -(defun helm-gtags-find-rtag (tag) - "Jump to referenced point" - (interactive - (list (helm-gtags--read-tagname 'rtag (which-function)))) - (helm-gtags--common '(helm-source-gtags-rtags) tag)) - -;;;###autoload -(defun helm-gtags-find-symbol (tag) - "Jump to the symbol location" - (interactive - (list (helm-gtags--read-tagname 'symbol))) - (helm-gtags--common '(helm-source-gtags-gsyms) tag)) - -;;;###autoload -(defun helm-gtags-find-pattern (pattern) - "Grep and jump by gtags tag files." - (interactive - (list (helm-gtags--read-tagname 'pattern))) - (helm-gtags--common '(helm-source-gtags-pattern) pattern)) - -(defun helm-gtags--find-file-after-hook () - "Not documented." - (helm-gtags--push-context helm-gtags--saved-context)) - -(defvar helm-source-gtags-files - (helm-build-in-buffer-source "Find files" - :init #'helm-gtags--files-init - :candidate-number-limit helm-gtags-maximum-candidates - :real-to-display #'helm-gtags--files-candidate-transformer - :persistent-action #'helm-gtags--file-persistent-action - :fuzzy-match helm-gtags-fuzzy-match - :action helm-gtags--file-util-action) - "Not documented.") - -;;;###autoload -(defun helm-gtags-find-files (file) - "Find file from tagged with gnu global." - (interactive - (list (helm-gtags--read-tagname 'find-file))) - (add-hook 'helm-after-action-hook 'helm-gtags--find-file-after-hook) - (unwind-protect - (helm-gtags--common '(helm-source-gtags-files) file) - (remove-hook 'helm-after-action-hook 'helm-gtags--find-file-after-hook))) - -;;;###autoload -(defun helm-gtags-find-tag-from-here () - "Jump point by current point information. -Jump to definition point if cursor is on its reference. -Jump to reference point if curosr is on its definition" - (interactive) - (helm-gtags--common '(helm-source-gtags-find-tag-from-here) nil)) - -;;;###autoload -(defun helm-gtags-dwim () - "Find by context. Here is -- on include statement then jump to included file -- on symbol definition then jump to its references -- on reference point then jump to its definition." - (interactive) - (let ((line (helm-current-line-contents))) - (if (string-match helm-gtags--include-regexp line) - (let ((helm-gtags-use-input-at-cursor t)) - (helm-gtags-find-files (match-string-no-properties 1 line))) - (if (and (buffer-file-name) (funcall helm-gtags-symbol-at-point-function)) - (helm-gtags-find-tag-from-here) - (call-interactively 'helm-gtags-find-tag))))) - -(defun helm-gtags--set-parsed-file () - "Not documented." - (let* ((this-file (file-name-nondirectory (buffer-file-name))) - (file (if current-prefix-arg - (read-file-name "Parsed File: " nil this-file) - this-file))) - (setq helm-gtags--parsed-file (expand-file-name file)))) - -(defun helm-gtags--find-preselect-line () - "Not documented." - (let ((defun-bound (bounds-of-thing-at-point 'defun))) - (if (not defun-bound) - (line-number-at-pos) - (let ((defun-begin-line (line-number-at-pos (car defun-bound))) - (filename (helm-gtags--real-file-name))) - (with-temp-buffer - (unless (zerop (process-file "global" nil t nil "-f" filename)) - (error "Failed: global -f")) - (goto-char (point-min)) - (let (start-line) - (while (and (not start-line) - (re-search-forward "^\\S-+\\s-+\\([1-9][0-9]*\\)" nil t)) - (let ((line (string-to-number (match-string-no-properties 1)))) - (when (>= line defun-begin-line) - (setq start-line line)))) - (or start-line (line-number-at-pos)))))))) - -;;;###autoload -(defun helm-gtags-parse-file () - "Parse current file with gnu global. This is similar to `imenu'. -You can jump definitions of functions, symbols in this file." - (interactive) - (helm-gtags--find-tag-directory) - (helm-gtags--save-current-context) - (setq helm-gtags--use-otherwin (helm-gtags--using-other-window-p)) - (helm-gtags--set-parsed-file) - (helm-attrset 'name - (format "Parsed File: %s" - (file-relative-name helm-gtags--parsed-file - helm-gtags--tag-location)) - helm-source-gtags-parse-file) - (let ((presel (when helm-gtags-preselect - (format "^\\S-+\\s-+%d\\s-+" (helm-gtags--find-preselect-line))))) - (helm :sources '(helm-source-gtags-parse-file) - :buffer helm-gtags--buffer :preselect presel))) - -;;;###autoload -(defun helm-gtags-push-stack () - "Push current location to the stack." - (interactive) - (helm-gtags--push-context (helm-gtags--current-context))) - -;;;###autoload -(defun helm-gtags-pop-stack () - "Jump to previous point on the context stack and pop it from stack." - (interactive) - (let* ((context-info (helm-gtags--get-context-info)) - (context-stack (plist-get context-info :stack)) - (context (pop context-stack))) - (helm-gtags--put-context-stack helm-gtags--tag-location -1 context-stack) - (helm-gtags--move-to-context context))) - -;;;###autoload -(defun helm-gtags-show-stack () - "Show current context stack." - (interactive) - (helm-other-buffer 'helm-source-gtags-show-stack - (get-buffer-create helm-gtags--buffer))) - -;;;###autoload -(defun helm-gtags-clear-stack () - "Clear current context stack." - (interactive) - (let ((tag-location (helm-gtags--find-tag-directory))) - (message "Clear '%s' context stack." tag-location) - (remhash tag-location helm-gtags--context-stack))) - -;;;###autoload -(defun helm-gtags-clear-all-stacks () - "Clear all context stacks." - (interactive) - (message "Clear all context statks.") - (setq helm-gtags--context-stack (make-hash-table :test 'equal))) - -(defun helm-gtags--read-tag-directory () - "Not documented." - (let ((dir (read-directory-name "Directory tag generated: " nil nil t))) - ;; On Windows, "gtags d:/tmp" work, but "gtags d:/tmp/" doesn't - (directory-file-name (expand-file-name dir)))) - -(defsubst helm-gtags--how-to-update-tags () - "Not documented." - (cl-case (prefix-numeric-value current-prefix-arg) - (4 'entire-update) - (16 'generate-other-directory) - (otherwise 'single-update))) - -(defun helm-gtags--update-tags-command (how-to) - "Not documented." - (cl-case how-to - (entire-update '("global" "-u")) - (generate-other-directory (list "gtags" (helm-gtags--read-tag-directory))) - (single-update (list "global" "--single-update" (helm-gtags--real-file-name))))) - -(defun helm-gtags--update-tags-p (how-to interactive-p current-time) - "Not documented." - (or interactive-p - (and (eq how-to 'single-update) - (buffer-file-name) - (or (not helm-gtags-update-interval-second) - (>= (- current-time helm-gtags--last-update-time) - helm-gtags-update-interval-second))))) - -;;;###autoload -(defun helm-gtags-update-tags () - "Update TAG file. Update All files with `C-u' prefix. -Generate new TAG file in selected directory with `C-u C-u'" - (interactive) - (let ((how-to (helm-gtags--how-to-update-tags)) - (interactive-p (called-interactively-p 'interactive)) - (current-time (float-time (current-time)))) - (when (helm-gtags--update-tags-p how-to interactive-p current-time) - (let* ((cmds (helm-gtags--update-tags-command how-to)) - (proc (apply #'start-file-process "helm-gtags-update-tag" nil cmds))) - (if (not proc) - (message "Failed: %s" (string-join cmds " ")) - (set-process-sentinel proc (helm-gtags--make-gtags-sentinel 'update)) - (setq helm-gtags--last-update-time current-time)))))) - -;;;###autoload -(defun helm-gtags-resume () - "Resurrect previously invoked `helm-gtags` command." - (interactive) - (unless (get-buffer helm-gtags--buffer) - (error "Error: helm-gtags buffer is not existed.")) - (helm-resume helm-gtags--buffer)) - -(defsubst helm-gtags--check-browser-installed (browser) - (let ((used-browser (or browser "mozilla"))) - (unless (executable-find used-browser) - (error "Not found browser '%s'" used-browser)))) - -(defun helm-gtags-display-browser () - "Display current screen on hypertext browser. -`browse-url-generic-program' is used as browser if its value is non-nil. -`mozilla' is used in other case." - (interactive) - (let ((file (buffer-file-name))) - (if (not file) - (error "This buffer is not related to file.") - (let* ((lineopt (concat "+" (number-to-string (line-number-at-pos)))) - (browser (symbol-value 'browse-url-generic-program)) - (args (list lineopt file))) - (helm-gtags--check-browser-installed browser) - (when browser - (setq args (append (list "-b" browser) args))) - ;; `gozilla' commend never returns error status if command is failed. - (apply #'process-file "gozilla" nil nil nil args))))) - -(defvar helm-gtags-mode-name " HelmGtags") -(defvar helm-gtags-mode-map (make-sparse-keymap)) - -;;;###autoload -(define-minor-mode helm-gtags-mode () - "Enable helm-gtags" - :init-value nil - :global nil - :keymap helm-gtags-mode-map - :lighter helm-gtags-mode-name - (if helm-gtags-mode - (when helm-gtags-auto-update - (add-hook 'after-save-hook 'helm-gtags-update-tags nil t)) - (when helm-gtags-auto-update - (remove-hook 'after-save-hook 'helm-gtags-update-tags t)))) - -;; Key mapping of gtags-mode. -(when helm-gtags-suggested-key-mapping - ;; Current key mapping. - (let ((command-table '(("h" . helm-gtags-display-browser) - ("P" . helm-gtags-find-files) - ("f" . helm-gtags-parse-file) - ("g" . helm-gtags-find-pattern) - ("s" . helm-gtags-find-symbol) - ("r" . helm-gtags-find-rtag) - ("t" . helm-gtags-find-tag) - ("d" . helm-gtags-find-tag))) - (key-func (if (string-prefix-p "\\" helm-gtags-prefix-key) - #'concat - (lambda (prefix key) (kbd (concat prefix " " key)))))) - (cl-loop for (key . command) in command-table - do - (define-key helm-gtags-mode-map (funcall key-func helm-gtags-prefix-key key) command)) - - ;; common - (define-key helm-gtags-mode-map "\C-]" 'helm-gtags-find-tag-from-here) - (define-key helm-gtags-mode-map "\C-t" 'helm-gtags-pop-stack) - (define-key helm-gtags-mode-map "\e*" 'helm-gtags-pop-stack) - (define-key helm-gtags-mode-map "\e." 'helm-gtags-find-tag) - (define-key helm-gtags-mode-map "\C-x4." 'helm-gtags-find-tag-other-window))) - -(provide 'helm-gtags) - -;; Local Variables: -;; coding: utf-8 -;; indent-tabs-mode: nil -;; End: - -;;; helm-gtags.el ends here diff --git a/elpa/helm-gtags-20260204.1753/README-elpa b/elpa/helm-gtags-20260204.1753/README-elpa new file mode 100644 index 00000000..26aa68eb --- /dev/null +++ b/elpa/helm-gtags-20260204.1753/README-elpa @@ -0,0 +1,22 @@ +`helm-gtags.el' is a `helm' interface of GNU Global. +`helm-gtags.el' is not compatible `anything-gtags.el', but `helm-gtags.el' +is designed for fast search. + + +To use this package, add these lines to your init.el or .emacs file: + + ;; Enable helm-gtags-mode + (add-hook 'c-mode-hook 'helm-gtags-mode) + (add-hook 'c++-mode-hook 'helm-gtags-mode) + (add-hook 'asm-mode-hook 'helm-gtags-mode) + + ;; Set key bindings + (eval-after-load "helm-gtags" + '(progn + (define-key helm-gtags-mode-map (kbd "M-t") 'helm-gtags-find-tag) + (define-key helm-gtags-mode-map (kbd "M-r") 'helm-gtags-find-rtag) + (define-key helm-gtags-mode-map (kbd "M-s") 'helm-gtags-find-symbol) + (define-key helm-gtags-mode-map (kbd "M-g M-p") 'helm-gtags-parse-file) + (define-key helm-gtags-mode-map (kbd "C-c <") 'helm-gtags-previous-history) + (define-key helm-gtags-mode-map (kbd "C-c >") 'helm-gtags-next-history) + (define-key helm-gtags-mode-map (kbd "M-,") 'helm-gtags-pop-stack))) diff --git a/elpa/helm-gtags-20260204.1753/helm-gtags-autoloads.el b/elpa/helm-gtags-20260204.1753/helm-gtags-autoloads.el new file mode 100644 index 00000000..4db4ce39 --- /dev/null +++ b/elpa/helm-gtags-20260204.1753/helm-gtags-autoloads.el @@ -0,0 +1,119 @@ +;;; helm-gtags-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*- +;; Generated by the `loaddefs-generate' function. + +;; This file is part of GNU Emacs. + +;;; Code: + +(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path))) + + + +;;; Generated autoloads from helm-gtags.el + +(autoload 'helm-gtags-clear-all-cache "helm-gtags" +"Not documented." t) +(autoload 'helm-gtags-clear-cache "helm-gtags" +"Not documented." t) +(autoload 'helm-gtags-next-history "helm-gtags" +"Jump to next position on context stack" t) +(autoload 'helm-gtags-previous-history "helm-gtags" +"Jump to previous position on context stack" t) +(autoload 'helm-gtags-select "helm-gtags" +"Not documented." t) +(autoload 'helm-gtags-select-path "helm-gtags" +"Not documented." t) +(autoload 'helm-gtags-tags-in-this-function "helm-gtags" +"Show tagnames which are referenced in this function and jump to it." t) +(autoload 'helm-gtags-create-tags "helm-gtags" +"Not documented. + +(fn DIR LABEL)" t) +(autoload 'helm-gtags-delete-tags "helm-gtags" +"Delete file GTAGS, GRTAGS, GPATH, ID etc. generated by gtags." t) +(autoload 'helm-gtags-find-tag "helm-gtags" +"Jump to definition + +(fn TAG)" t) +(autoload 'helm-gtags-find-tag-other-window "helm-gtags" +"Jump to definition in other window. + +(fn TAG)" t) +(autoload 'helm-gtags-find-rtag "helm-gtags" +"Jump to referenced point + +(fn TAG)" t) +(autoload 'helm-gtags-find-symbol "helm-gtags" +"Jump to the symbol location + +(fn TAG)" t) +(autoload 'helm-gtags-find-pattern "helm-gtags" +"Grep and jump by gtags tag files. + +(fn PATTERN)" t) +(autoload 'helm-gtags-find-files "helm-gtags" +"Find file from tagged with gnu global. + +(fn FILE)" t) +(autoload 'helm-gtags-find-tag-from-here "helm-gtags" +"Jump point by current point information. +Jump to definition point if cursor is on its reference. +Jump to reference point if curosr is on its definition" t) +(autoload 'helm-gtags-dwim "helm-gtags" +"Find by context. Here is +- on include statement then jump to included file +- on symbol definition then jump to its references +- on reference point then jump to its definition." t) +(autoload 'helm-gtags-parse-file "helm-gtags" +"Parse current file with gnu global. This is similar to `imenu'. +You can jump definitions of functions, symbols in this file." t) +(autoload 'helm-gtags-push-stack "helm-gtags" +"Push current location to the stack." t) +(autoload 'helm-gtags-pop-stack "helm-gtags" +"Jump to previous point on the context stack and pop it from stack." t) +(autoload 'helm-gtags-show-stack "helm-gtags" +"Show current context stack." t) +(autoload 'helm-gtags-clear-stack "helm-gtags" +"Clear current context stack." t) +(autoload 'helm-gtags-clear-all-stacks "helm-gtags" +"Clear all context stacks." t) +(autoload 'helm-gtags-update-tags "helm-gtags" +"Update TAG file. Update All files with `C-u' prefix. +Generate new TAG file in selected directory with `C-u C-u'" t) +(autoload 'helm-gtags-resume "helm-gtags" +"Resurrect previously invoked `helm-gtags` command." t) +(autoload 'helm-gtags-mode "helm-gtags" +"Enable helm-gtags. + +This is a minor mode. If called interactively, toggle the `Helm-Gtags +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate the variable `helm-gtags-mode'. + +The mode's hook is called both when the mode is enabled and when it is +disabled. + +\\{helm-gtags-mode-map} + +(fn &optional ARG)" t) +(register-definition-prefixes "helm-gtags" '("helm-")) + +;;; End of scraped data + +(provide 'helm-gtags-autoloads) + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; no-native-compile: t +;; coding: utf-8-emacs-unix +;; End: + +;;; helm-gtags-autoloads.el ends here diff --git a/elpa/helm-gtags-20260204.1753/helm-gtags-pkg.el b/elpa/helm-gtags-20260204.1753/helm-gtags-pkg.el new file mode 100644 index 00000000..1b347f05 --- /dev/null +++ b/elpa/helm-gtags-20260204.1753/helm-gtags-pkg.el @@ -0,0 +1,10 @@ +;; -*- no-byte-compile: t; lexical-binding: nil -*- +(define-package "helm-gtags" "20260204.1753" + "GNU GLOBAL helm interface." + '((emacs "27.1") + (helm "3.0")) + :url "https://github.com/syohex/emacs-helm-gtags" + :commit "bfafd3d4a7f028d42f3f46c3273eaed930269ec6" + :revdesc "bfafd3d4a7f0" + :authors '(("Syohei YOSHIDA" . "syohex@gmail.com")) + :maintainers '(("Jen-Chieh Shen" . "jcs090218@gmail.com"))) diff --git a/elpa/helm-gtags-20260204.1753/helm-gtags.el b/elpa/helm-gtags-20260204.1753/helm-gtags.el new file mode 100644 index 00000000..c52c9bed --- /dev/null +++ b/elpa/helm-gtags-20260204.1753/helm-gtags.el @@ -0,0 +1,1493 @@ +;;; helm-gtags.el --- GNU GLOBAL helm interface -*- lexical-binding: t; -*- + +;; Copyright (C) 2016 by Syohei YOSHIDA +;; Copyright (C) 2020-2026 Shen, Jen-Chieh + +;; Author: Syohei YOSHIDA +;; Maintainer: Jen-Chieh Shen +;; URL: https://github.com/syohex/emacs-helm-gtags +;; Package-Version: 20260204.1753 +;; Package-Revision: bfafd3d4a7f0 +;; Package-Requires: ((emacs "27.1") (helm "3.0")) + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; `helm-gtags.el' is a `helm' interface of GNU Global. +;; `helm-gtags.el' is not compatible `anything-gtags.el', but `helm-gtags.el' +;; is designed for fast search. + +;; +;; To use this package, add these lines to your init.el or .emacs file: +;; +;; ;; Enable helm-gtags-mode +;; (add-hook 'c-mode-hook 'helm-gtags-mode) +;; (add-hook 'c++-mode-hook 'helm-gtags-mode) +;; (add-hook 'asm-mode-hook 'helm-gtags-mode) +;; +;; ;; Set key bindings +;; (eval-after-load "helm-gtags" +;; '(progn +;; (define-key helm-gtags-mode-map (kbd "M-t") 'helm-gtags-find-tag) +;; (define-key helm-gtags-mode-map (kbd "M-r") 'helm-gtags-find-rtag) +;; (define-key helm-gtags-mode-map (kbd "M-s") 'helm-gtags-find-symbol) +;; (define-key helm-gtags-mode-map (kbd "M-g M-p") 'helm-gtags-parse-file) +;; (define-key helm-gtags-mode-map (kbd "C-c <") 'helm-gtags-previous-history) +;; (define-key helm-gtags-mode-map (kbd "C-c >") 'helm-gtags-next-history) +;; (define-key helm-gtags-mode-map (kbd "M-,") 'helm-gtags-pop-stack))) +;; + +;;; Code: + +(require 'cl-lib) +(require 'helm) +(require 'helm-files) +(require 'which-func) +(require 'pulse) +(require 'subr-x) + +(declare-function helm-comp-read "helm-mode") +(declare-function cygwin-convert-file-name-from-windows "cygw32.c") +(declare-function cygwin-convert-file-name-to-windows "cygw32.c") + +(defgroup helm-gtags nil + "GNU GLOBAL for helm." + :group 'helm) + +;; Declare obsolete variable aliases before their referents +(define-obsolete-variable-alias + 'helm-c-gtags-path-style 'helm-gtags-path-style "0.8") +(define-obsolete-variable-alias + 'helm-c-gtags-ignore-case 'helm-gtags-ignore-case "0.8") +(define-obsolete-variable-alias + 'helm-c-gtags-read-only 'helm-gtags-read-only "0.8") + +(defcustom helm-gtags-path-style 'root + "Style of file path." + :type '(choice (const :tag "Root of the current project" root) + (const :tag "Relative from the current directory" relative) + (const :tag "Absolute Path" absolute))) + +(defcustom helm-gtags-ignore-case nil + "Ignore case in each search." + :type 'boolean + :group 'helm-gtags) + +(defcustom helm-gtags-cygwin-use-global-w32-port t + "Use the GNU global win32 port in Cygwin." + :type 'boolean + :group 'helm-gtags) + +(defcustom helm-gtags-read-only nil + "Gtags read only mode." + :type 'boolean + :group 'helm-gtags) + +(defcustom helm-gtags-auto-update nil + "*If non-nil, tag files are updated whenever a file is saved." + :type 'boolean + :group 'helm-gtags) + +(defcustom helm-gtags-pulse-at-cursor t + "If non-nil, pulse at point after jumping." + :type 'boolean + :group 'helm-gtags) + +(defcustom helm-gtags-cache-select-result nil + "*If non-nil, results of helm-gtags-select and helm-gtags-select-path are cached." + :type 'boolean + :group 'helm-gtags) + +(defcustom helm-gtags-cache-max-result-size (* 10 1024 1024) ;10M + "Max size(bytes) to cache for each select result." + :type 'integer + :group 'helm-gtags) + +(defcustom helm-gtags-update-interval-second 60 + "Update interval in seconds for tags in `after-save-hook'. +Tags are updated if this many seconds have passed since last update. +Always update if value of this variable is nil." + :type '(choice (integer :tag "Update interval seconds") + (boolean :tag "Update every time" nil)) + :group 'helm-gtags) + +(defcustom helm-gtags-highlight-candidate t + "Highlight candidate or not." + :type 'boolean + :group 'helm-gtags) + +(defcustom helm-gtags-use-input-at-cursor nil + "Use input at cursor." + :type 'boolean + :group 'helm-gtags) + +(defcustom helm-gtags-prefix-key "\C-c" + "If non-nil, it is used for the prefix key of gtags-xxx command." + :type 'string + :group 'helm-gtags) + +(defcustom helm-gtags-suggested-key-mapping nil + "If non-nil, suggested key mapping is enabled." + :type 'boolean + :group 'helm-gtags) + +(defcustom helm-gtags-preselect nil + "If non-nil, preselect current file and line." + :type 'boolean + :group 'helm-gtags) + +(defcustom helm-gtags-display-style nil + "Style of display result." + :type '(choice (const :tag "Show in detail" detail) + (const :tag "Normal style" nil)) + :group 'helm-gtags) + +(defcustom helm-gtags-fuzzy-match nil + "Enable fuzzy match." + :type 'boolean + :group 'helm-gtags) + +(defcustom helm-gtags-maximum-candidates (if helm-gtags-fuzzy-match 100 9999) + "Maximum number of helm candidates." + :type 'integer + :group 'helm-gtags) + +(defcustom helm-gtags-symbol-at-point-function 'helm-gtags--symbol-at-point + "Function to use to get the symbol at point." + :type 'symbol) + +(defcustom helm-gtags-direct-helm-completing nil + "Use helm mode directly." + :type 'boolean + :group 'helm-gtags) + +(defface helm-gtags-file + '((t :inherit font-lock-keyword-face)) + "Face for line numbers in the error list.") + +(defface helm-gtags-lineno + '((t :inherit font-lock-doc-face)) + "Face for line numbers in the error list.") + +(defface helm-gtags-match + '((t :inherit helm-match)) + "Face for word matched against tagname") + +(defvar helm-gtags--tag-location nil) +(defvar helm-gtags--last-update-time 0) +(defvar helm-gtags--completing-history nil) +(defvar helm-gtags--context-stack (make-hash-table :test 'equal)) +(defvar helm-gtags--result-cache (make-hash-table :test 'equal)) +(defvar helm-gtags--saved-context nil) +(defvar helm-gtags--use-otherwin nil) +(defvar helm-gtags--local-directory nil) +(defvar helm-gtags--parsed-file nil) +(defvar helm-gtags--current-position nil) +(defvar helm-gtags--real-tag-location nil) +(defvar helm-gtags--last-input nil) +(defvar helm-gtags--query nil) +(defvar helm-gtags--last-default-directory nil) + +(defconst helm-gtags--buffer "*helm gtags*" + "Not documented.") + +(defconst helm-gtags--include-regexp + "\\`\\s-*#\\(?:include\\|import\\)\\s-*[\"<]\\(?:[./]*\\)?\\(.*?\\)[\">]" + "Not documented.") + +;; completion function for completing-read. +(defun helm-gtags--completing-gtags (string predicate code) + (helm-gtags--complete 'tag string predicate code)) +(defun helm-gtags--completing-pattern (string predicate code) + (helm-gtags--complete 'pattern string predicate code)) +(defun helm-gtags--completing-grtags (string predicate code) + (helm-gtags--complete 'rtag string predicate code)) +(defun helm-gtags--completing-gsyms (string predicate code) + (helm-gtags--complete 'symbol string predicate code)) +(defun helm-gtags--completing-files (string predicate code) + (helm-gtags--complete 'find-file string predicate code)) + +(defconst helm-gtags-comp-func-alist + '((tag . helm-gtags--completing-gtags) + (pattern . helm-gtags--completing-pattern) + (rtag . helm-gtags--completing-grtags) + (symbol . helm-gtags--completing-gsyms) + (find-file . helm-gtags--completing-files)) + "Not documented.") + +(defconst helm-gtags--search-option-alist + '((pattern . "-g") + (rtag . "-r") + (symbol . "-s") + (find-file . "-Poa")) + "Not documented.") + +(defsubst helm-gtags--windows-p () + "Not documented." + (memq system-type '(windows-nt ms-dos))) + +(defun helm-gtags--remove-carrige-returns () + "Not documented." + (when (helm-gtags--windows-p) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "\xd" nil t) + (replace-match ""))))) + +;; Work around for GNU global Windows issue +(defsubst helm-gtags--use-abs-path-p (gtagslibpath) + "Not documented." + (and (helm-gtags--windows-p) gtagslibpath)) + +(defun helm-gtags--construct-options (type completion) + "Not documented." + (let ((find-file-p (eq type 'find-file)) + (gtagslibpath (getenv "GTAGSLIBPATH")) + options) + (unless find-file-p + (push "--result=grep" options)) + (when completion + (push "-c" options)) + (helm-aif (assoc-default type helm-gtags--search-option-alist) + (push it options)) + (when (or (eq helm-gtags-path-style 'absolute) + (helm-gtags--use-abs-path-p gtagslibpath)) + (push "-a" options)) + (when helm-gtags-ignore-case + (push "-i" options)) + (when (and current-prefix-arg (not find-file-p)) + (push "-l" options)) + (when gtagslibpath + (push "-T" options)) + options)) + +(defun helm-gtags--complete (type string predicate code) + "Not documented." + (let* ((options (helm-gtags--construct-options type t)) + (args (reverse (cons string options))) + candidates) + (with-temp-buffer + (apply #'process-file "global" nil t nil args) + (goto-char (point-min)) + (while (re-search-forward "^\\(.+\\)$" nil t) + (push (match-string-no-properties 1) candidates))) + (if (not code) + (try-completion string candidates predicate) + (all-completions string candidates predicate)))) + +(defun helm-gtags--symbol-at-point () + (thing-at-point 'symbol)) + +(defun helm-gtags--token-at-point (type) + "Not documented." + (if (not (eq type 'find-file)) + (funcall helm-gtags-symbol-at-point-function) + (let ((line (helm-current-line-contents))) + (when (string-match helm-gtags--include-regexp line) + (match-string-no-properties 1 line))))) + +(defconst helm-gtags--prompt-alist + '((tag . "Find Definition: ") + (pattern . "Find Pattern: ") + (rtag . "Find Reference: ") + (symbol . "Find Symbol: ") + (find-file . "Find File: ")) + "Not documented.") + +(defun helm-gtags--read-tagname (type &optional default-tagname) + "Not documented." + (let ((tagname (helm-gtags--token-at-point type)) + (prompt (assoc-default type helm-gtags--prompt-alist)) + (comp-func (assoc-default type helm-gtags-comp-func-alist))) + (if (and tagname helm-gtags-use-input-at-cursor) + tagname + (when (and (not tagname) default-tagname) + (setq tagname default-tagname)) + (when tagname + (setq prompt (format "%s(default \"%s\") " prompt tagname))) + (let ((completion-ignore-case helm-gtags-ignore-case) + (completing-read-function 'completing-read-default)) + (if (and helm-gtags-direct-helm-completing (memq type '(tag rtag symbol find-file))) + (helm-comp-read prompt comp-func + :history 'helm-gtags--completing-history + :exec-when-only-one t + :default tagname) + (completing-read prompt comp-func nil nil nil + 'helm-gtags--completing-history tagname)))))) + +(defun helm-gtags--path-libpath-p (tagroot) + "Not documented." + (helm-aif (getenv "GTAGSLIBPATH") + (cl-loop for path in (parse-colon-path it) + for libpath = (file-name-as-directory (expand-file-name path)) + thereis (string= tagroot libpath)))) + +(defsubst helm-gtags--convert-cygwin-windows-file-name-p () + "Not documented." + (and (eq system-type 'cygwin) helm-gtags-cygwin-use-global-w32-port)) + +(defun helm-gtags--tag-directory () + "Not documented." + (with-temp-buffer + (helm-aif (getenv "GTAGSROOT") + it + (unless (zerop (process-file "global" nil t nil "-p")) + (error "GTAGS not found")) + (goto-char (point-min)) + (when (looking-at "^\\([^\r\n]+\\)") + (let ((tag-path (match-string-no-properties 1))) + (file-name-as-directory + (if (helm-gtags--convert-cygwin-windows-file-name-p) + (cygwin-convert-file-name-from-windows tag-path) + tag-path))))))) + +(defun helm-gtags--find-tag-directory () + "Not documented." + (setq helm-gtags--real-tag-location nil) + (let ((tagroot (helm-gtags--tag-directory))) + (if (and (helm-gtags--path-libpath-p tagroot) helm-gtags--tag-location) + (progn + (setq helm-gtags--real-tag-location tagroot) + helm-gtags--tag-location) + (setq helm-gtags--tag-location tagroot)))) + +(defun helm-gtags--base-directory () + "Not documented." + (let ((dir (or helm-gtags--last-default-directory + helm-gtags--local-directory + (cl-case helm-gtags-path-style + (root (or helm-gtags--real-tag-location + helm-gtags--tag-location)) + (otherwise default-directory)))) + (remote (file-remote-p default-directory))) + (if (and remote (not (file-remote-p dir))) + (concat remote dir) + dir))) + +(defsubst helm-gtags--new-context-info (index stack) + "Not documented." + (list :index index :stack stack)) + +(defun helm-gtags--put-context-stack (tag-location index stack) + "Not documented." + (puthash tag-location (helm-gtags--new-context-info index stack) + helm-gtags--context-stack)) + +(defsubst helm-gtags--current-context () + "Not documented." + (let ((file (buffer-file-name (current-buffer)))) + (list :file file :position (point) :readonly buffer-file-read-only))) + +(defsubst helm-gtags--save-current-context () + "Not documented." + (setq helm-gtags--saved-context (helm-gtags--current-context))) + +(defun helm-gtags--open-file (file readonly) + "Not documented." + (if readonly + (find-file-read-only file) + (find-file file))) + +(defun helm-gtags--open-file-other-window (file readonly) + "Not documented." + (setq helm-gtags--use-otherwin nil) + (if readonly + (find-file-read-only-other-window file) + (find-file-other-window file))) + +(defun helm-gtags--get-context-info () + "Not documented." + (let* ((tag-location (helm-gtags--find-tag-directory)) + (context-info (gethash tag-location helm-gtags--context-stack)) + (context-stack (plist-get context-info :stack))) + (if (null context-stack) + (error "Context stack is empty(TAG at %s)" tag-location) + context-info))) + +(defun helm-gtags--get-or-create-context-info () + "Not documented." + (or (gethash helm-gtags--tag-location helm-gtags--context-stack) + (helm-gtags--new-context-info -1 nil))) + +;;;###autoload +(defun helm-gtags-clear-all-cache () + "Not documented." + (interactive) + (clrhash helm-gtags--result-cache)) + +;;;###autoload +(defun helm-gtags-clear-cache () + "Not documented." + (interactive) + (helm-gtags--find-tag-directory) + (let* ((tag-location (or helm-gtags--real-tag-location + helm-gtags--tag-location)) + (gtags-path (concat tag-location "GTAGS")) + (gpath-path (concat tag-location "GPATH"))) + (remhash gtags-path helm-gtags--result-cache) + (remhash gpath-path helm-gtags--result-cache))) + +(defun helm-gtags--move-to-context (context) + "Not documented." + (let ((file (plist-get context :file)) + (curpoint (plist-get context :position)) + (readonly (plist-get context :readonly))) + (helm-gtags--open-file file readonly) + (goto-char curpoint) + (recenter))) + +;;;###autoload +(defun helm-gtags-next-history () + "Jump to next position on context stack" + (interactive) + (let* ((context-info (helm-gtags--get-context-info)) + (current-index (plist-get context-info :index)) + (context-stack (plist-get context-info :stack)) + context) + (when (<= current-index -1) + (error "This context is latest in context stack")) + (setf (nth current-index context-stack) (helm-gtags--current-context)) + (cl-decf current-index) + (if (= current-index -1) + (setq context helm-gtags--current-position + helm-gtags--current-position nil) + (setq context (nth current-index context-stack))) + (helm-gtags--put-context-stack helm-gtags--tag-location + current-index context-stack) + (helm-gtags--move-to-context context))) + +;;;###autoload +(defun helm-gtags-previous-history () + "Jump to previous position on context stack" + (interactive) + (let* ((context-info (helm-gtags--get-context-info)) + (current-index (plist-get context-info :index)) + (context-stack (plist-get context-info :stack)) + (context-length (length context-stack))) + (cl-incf current-index) + (when (>= current-index context-length) + (error "This context is last in context stack")) + (if (= current-index 0) + (setq helm-gtags--current-position (helm-gtags--current-context)) + (setf (nth (- current-index 1) context-stack) (helm-gtags--current-context))) + (let ((prev-context (nth current-index context-stack))) + (helm-gtags--move-to-context prev-context)) + (helm-gtags--put-context-stack helm-gtags--tag-location + current-index context-stack))) + +(defun helm-gtags--get-result-cache (file) + "Not documented." + (helm-gtags--find-tag-directory) + (let* ((file-path (concat (or helm-gtags--real-tag-location + helm-gtags--tag-location) + file)) + (file-mtime (nth 5 (file-attributes file-path))) + (hash-value (gethash file-path helm-gtags--result-cache)) + (cached-file-mtime (nth 0 hash-value))) + (if (and cached-file-mtime (equal cached-file-mtime file-mtime)) + (nth 1 hash-value) + nil))) + +(defun helm-gtags--put-result-cache (file cache) + "Not documented." + (helm-gtags--find-tag-directory) + (let* ((file-path (concat (or helm-gtags--real-tag-location + helm-gtags--tag-location) + file)) + (file-mtime (nth 5 (file-attributes file-path))) + (hash-value (list file-mtime cache))) + (puthash file-path hash-value helm-gtags--result-cache))) + +(defun helm-gtags--referer-function (file ref-line) + "Not documented." + (let ((is-opened (cl-loop with path = (concat default-directory file) + for buf in (buffer-list) + when (string= (buffer-file-name buf) path) + return it)) + retval) + (with-current-buffer (find-file-noselect file) + (goto-char (point-min)) + (forward-line (1- ref-line)) + (unless (zerop (current-indentation)) + (setq retval (which-function))) + (unless is-opened + (kill-buffer (current-buffer))) + retval))) + +(defun helm-gtags--show-detail () + "Not documented." + (goto-char (point-min)) + (while (not (eobp)) + (let ((line (helm-current-line-contents))) + (let* ((file-and-line (helm-gtags--extract-file-and-line line)) + (file (car file-and-line)) + (ref-line (cdr file-and-line)) + (ref-func (helm-gtags--referer-function file ref-line))) + (when ref-func + (search-forward ":" nil nil 2) + (insert " " ref-func "|")) + (forward-line 1))))) + +(defun helm-gtags--print-path-in-gtagslibpath (args) + "Not documented." + (let ((libpath (getenv "GTAGSLIBPATH"))) + (when libpath + (dolist (path (parse-colon-path libpath)) + (let ((default-directory (file-name-as-directory path))) + (apply #'process-file "global" nil t nil "-Poa" args)))))) + +(defun helm-gtags--exec-global-command (type input &optional detail) + "Not documented." + (let ((args (helm-gtags--construct-command type input))) + (helm-gtags--find-tag-directory) + (helm-gtags--save-current-context) + (let ((buf-coding buffer-file-coding-system)) + (with-current-buffer (helm-candidate-buffer 'global) + (let ((default-directory (helm-gtags--base-directory)) + (input (car (last args))) + (coding-system-for-read buf-coding) + (coding-system-for-write buf-coding)) + (unless (zerop (apply #'process-file "global" nil '(t nil) nil args)) + (error (format "%s: not found" input))) + ;; --path options does not support searching under GTAGSLIBPATH + (when (eq type 'find-file) + (helm-gtags--print-path-in-gtagslibpath args)) + (helm-gtags--remove-carrige-returns) + (when detail + (helm-gtags--show-detail))))))) + +(defun helm-gtags--construct-command (type &optional in) + "Not documented." + (setq helm-gtags--local-directory nil) + (let ((dir (helm-get-attr 'helm-gtags-base-directory (helm-get-current-source)))) + (when (and dir (not (eq type 'find-file))) + (setq helm-gtags--local-directory dir))) + (let ((input (or in helm-gtags--query)) + (options (helm-gtags--construct-options type nil))) + (when (string-empty-p input) + (error "Input is empty!!")) + (setq helm-gtags--last-input input) + (reverse (cons input options)))) + +(defun helm-gtags--tags-init (&optional input) + "Not documented." + (helm-gtags--exec-global-command 'tag input)) + +(defun helm-gtags--pattern-init (&optional input) + "Not documented." + (helm-gtags--exec-global-command 'pattern input helm-gtags-display-style)) + +(defun helm-gtags--rtags-init (&optional input) + "Not documented." + (helm-gtags--exec-global-command 'rtag input helm-gtags-display-style)) + +(defun helm-gtags--gsyms-init () + "Not documented." + (helm-gtags--exec-global-command 'symbol nil helm-gtags-display-style)) + +(defun helm-gtags--files-init () + "Not documented." + (helm-gtags--exec-global-command 'find-file nil)) + +(defun helm-gtags--real-file-name () + "Not documented." + (let ((buffile (buffer-file-name))) + (unless buffile + (error "This buffer is not related to file.")) + (if (file-remote-p buffile) + (tramp-file-name-localname (tramp-dissect-file-name buffile)) + (file-truename buffile)))) + +(defun helm-gtags--find-tag-from-here-init () + "Not documented." + (helm-gtags--find-tag-directory) + (helm-gtags--save-current-context) + (let ((token (helm-gtags--token-at-point 'from-here))) + (unless token + (error "Cursor is not on symbol.")) + (let* ((filename (helm-gtags--real-file-name)) + (from-here-opt (format "--from-here=%d:%s" + (line-number-at-pos) + (if (helm-gtags--convert-cygwin-windows-file-name-p) + (cygwin-convert-file-name-to-windows filename) + filename)))) + (setq helm-gtags--last-input token) + (with-current-buffer (helm-candidate-buffer 'global) + (let* ((default-directory (helm-gtags--base-directory)) + (status (process-file "global" nil '(t nil) nil + "--result=grep" from-here-opt token))) + (helm-gtags--remove-carrige-returns) + (unless (zerop status) + (cond ((= status 1) + (error "Error: %s%s" (buffer-string) filename)) + ((= status 3) + (error "Error: %s" (buffer-string))) + (t (error "%s: not found" token))))))))) + +(defun helm-gtags--parse-file-init () + "Not documented." + (with-current-buffer (helm-candidate-buffer 'global) + (unless (zerop (process-file "global" nil t nil + "--result=cscope" "-f" helm-gtags--parsed-file)) + (error "Failed: 'global --result=cscope -f %s" helm-gtags--parsed-file)) + (helm-gtags--remove-carrige-returns))) + +(defun helm-gtags--push-context (context) + "Not documented." + (let* ((context-info (helm-gtags--get-or-create-context-info)) + (current-index (plist-get context-info :index)) + (context-stack (plist-get context-info :stack))) + (unless (= current-index -1) + (setq context-stack (nthcdr (1+ current-index) context-stack))) + (setq helm-gtags--current-position nil) + (push context context-stack) + (helm-gtags--put-context-stack helm-gtags--tag-location -1 context-stack))) + +(defsubst helm-gtags--select-find-file-func () + "Not documented." + (if helm-gtags--use-otherwin + #'helm-gtags--open-file-other-window + #'helm-gtags--open-file)) + +(defun helm-gtags--do-open-file (open-func file line) + "Not documented." + (funcall open-func file helm-gtags-read-only) + (goto-char (point-min)) + (forward-line (1- line)) + (back-to-indentation) + (recenter) + (helm-gtags--push-context helm-gtags--saved-context) + (when helm-gtags-pulse-at-cursor + (pulse-momentary-highlight-one-line (point)))) + +(defun helm-gtags--find-line-number (cand) + "Not documented." + (if (string-match "\\s-+\\([1-9][0-9]+\\)\\s-+" cand) + (string-to-number (match-string-no-properties 1 cand)) + (error "Can't find line number in %s" cand))) + +(defun helm-gtags--parse-file-action (cand) + "Not documented." + (let ((line (helm-gtags--find-line-number cand)) + (open-func (helm-gtags--select-find-file-func))) + (helm-gtags--do-open-file open-func helm-gtags--parsed-file line))) + +(defsubst helm-gtags--has-drive-letter-p (path) + "Not documented." + (string-match-p "\\`[a-zA-Z]:" path)) + +(defun helm-gtags--extract-file-and-line (cand) + "Not documented." + (if (and (helm-gtags--windows-p) (helm-gtags--has-drive-letter-p cand)) + (when (string-match "\\(\\`[a-zA-Z]:[^:]+\\):\\([^:]+\\)" cand) + (cons (match-string-no-properties 1 cand) + (string-to-number (match-string-no-properties 2 cand)))) + (let ((elems (split-string cand ":"))) + (cons (cl-first elems) (string-to-number (cl-second elems)))))) + +(defun helm-gtags--action-openfile (cand) + "Not documented." + (let* ((file-and-line (helm-gtags--extract-file-and-line cand)) + (filename (car file-and-line)) + (line (cdr file-and-line)) + (open-func (helm-gtags--select-find-file-func)) + (default-directory (helm-gtags--base-directory))) + (helm-gtags--do-open-file open-func filename line))) + +(defun helm-gtags--action-openfile-other-window (cand) + "Not documented." + (let ((helm-gtags--use-otherwin t)) + (helm-gtags--action-openfile cand))) + +(defun helm-gtags--file-content-at-pos (file pos) + "Not documented." + (with-current-buffer (find-file-noselect file) + (save-excursion + (goto-char pos) + (format "%s:%d:%s:%s" + file (line-number-at-pos) + (helm-aif (which-function) (format "[%s]" it) "") + (helm-current-line-contents))))) + +(defun helm-gtags--files-candidate-transformer (file) + "Not documented." + (if (eq helm-gtags-path-style 'absolute) + file + (let ((removed-regexp (concat "\\`" helm-gtags--tag-location))) + (replace-regexp-in-string removed-regexp "" file)))) + +(defun helm-gtags--show-stack-init () + "Not documented." + (cl-loop with context-stack = (plist-get (helm-gtags--get-context-info) :stack) + with stack-length = (length context-stack) + for context in (reverse context-stack) + for file = (plist-get context :file) + for pos = (plist-get context :position) + for index = (1- stack-length) then (1- index) + for line = (helm-gtags--file-content-at-pos file pos) + for cand = (helm-gtags--files-candidate-transformer line) + collect (cons cand (propertize cand 'index index)))) + +(defun helm-gtags--persistent-action (cand) + "Not documented." + (let* ((file-and-line (helm-gtags--extract-file-and-line cand)) + (filename (car file-and-line)) + (line (cdr file-and-line)) + (default-directory (helm-gtags--base-directory))) + (when (eq helm-gtags-path-style 'relative) + (setq helm-gtags--last-default-directory default-directory)) + (find-file filename) + (goto-char (point-min)) + (forward-line (1- line)) + (helm-highlight-current-line))) + +(defvar helm-gtags--find-file-action + (helm-make-actions + "Open file" #'helm-gtags--action-openfile + "Open file other window" #'helm-gtags--action-openfile-other-window) + "Not documented.") + +(defvar helm-source-gtags-tags + (helm-build-in-buffer-source "Jump to definitions" + :init 'helm-gtags--tags-init + :candidate-number-limit helm-gtags-maximum-candidates + :real-to-display 'helm-gtags--candidate-transformer + :persistent-action 'helm-gtags--persistent-action + :fuzzy-match helm-gtags-fuzzy-match + :action helm-gtags--find-file-action) + "Not documented.") + +(defvar helm-source-gtags-pattern + (helm-build-in-buffer-source "Find pattern" + :init 'helm-gtags--pattern-init + :candidate-number-limit helm-gtags-maximum-candidates + :real-to-display 'helm-gtags--candidate-transformer + :persistent-action 'helm-gtags--persistent-action + :fuzzy-match helm-gtags-fuzzy-match + :action helm-gtags--find-file-action) + "Not documented.") + +(defvar helm-source-gtags-rtags + (helm-build-in-buffer-source "Jump to references" + :init 'helm-gtags--rtags-init + :candidate-number-limit helm-gtags-maximum-candidates + :real-to-display 'helm-gtags--candidate-transformer + :persistent-action 'helm-gtags--persistent-action + :fuzzy-match helm-gtags-fuzzy-match + :action helm-gtags--find-file-action) + "Not documented.") + +(defvar helm-source-gtags-gsyms + (helm-build-in-buffer-source "Jump to symbols" + :init 'helm-gtags--gsyms-init + :candidate-number-limit helm-gtags-maximum-candidates + :real-to-display 'helm-gtags--candidate-transformer + :persistent-action 'helm-gtags--persistent-action + :fuzzy-match helm-gtags-fuzzy-match + :action helm-gtags--find-file-action) + "Not documented.") + +(defun helm-gtags--highlight-candidate (candidate) + "Not documented." + (let ((regexp (concat "\\_<" helm-gtags--last-input "\\_>")) + (limit (1- (length candidate))) + (last-pos 0) + (case-fold-search nil)) + (while (and (< last-pos limit) + (string-match regexp candidate last-pos)) + (put-text-property (match-beginning 0) (match-end 0) + 'face 'helm-gtags-match + candidate) + (setq last-pos (1+ (match-end 0)))) + candidate)) + +(defun helm-gtags--transformer-regexp (candidate) + "Not documented." + (if (and (helm-gtags--windows-p) (helm-gtags--has-drive-letter-p candidate)) + "\\`\\([a-zA-Z]:[^:]+\\):\\([^:]+\\):\\(.*\\)" + "\\`\\([^:]+\\):\\([^:]+\\):\\(.*\\)")) + +(defun helm-gtags--candidate-transformer (candidate) + "Not documented." + (if (not helm-gtags-highlight-candidate) + candidate + (let ((regexp (helm-gtags--transformer-regexp candidate))) + (when (string-match regexp candidate) + (format "%s:%s:%s" + (propertize (match-string 1 candidate) 'face 'helm-gtags-file) + (propertize (match-string 2 candidate) 'face 'helm-gtags-lineno) + (helm-gtags--highlight-candidate (match-string 3 candidate))))))) + +(defun helm-gtags--parse-file-candidate-transformer (file) + "Not documented." + (let ((removed-file (replace-regexp-in-string "\\`\\S-+ " "" file))) + (when (string-match "\\`\\(\\S-+\\) \\(\\S-+\\) \\(.+\\)\\'" removed-file) + (format "%-25s %-5s %s" + (match-string-no-properties 1 removed-file) + (match-string-no-properties 2 removed-file) + (match-string-no-properties 3 removed-file))))) + +(defvar helm-source-gtags-find-tag-from-here + (helm-build-in-buffer-source "Find tag from here" + :init 'helm-gtags--find-tag-from-here-init + :candidate-number-limit helm-gtags-maximum-candidates + :real-to-display 'helm-gtags--candidate-transformer + :persistent-action 'helm-gtags--persistent-action + :fuzzy-match helm-gtags-fuzzy-match + :action helm-gtags--find-file-action) + "Not documented.") + +(defvar helm-source-gtags-parse-file + (helm-build-in-buffer-source "Parse file" + :init 'helm-gtags--parse-file-init + :candidate-number-limit helm-gtags-maximum-candidates + :real-to-display 'helm-gtags--parse-file-candidate-transformer + :fuzzy-match helm-gtags-fuzzy-match + :action 'helm-gtags--parse-file-action) + "Not documented.") + +(defun helm-gtags--show-stack-action (cand) + "Not documented." + (let* ((index (get-text-property 0 'index cand)) + (context-info (helm-gtags--get-context-info)) + (context-stack (plist-get context-info :stack))) + (helm-gtags--put-context-stack helm-gtags--tag-location + index context-stack) + (helm-gtags--move-to-context (nth index context-stack)))) + +(defvar helm-source-gtags-show-stack + (helm-build-sync-source "Show Context Stack" + :candidates 'helm-gtags--show-stack-init + :volatile t + :candidate-number-limit helm-gtags-maximum-candidates + :persistent-action 'helm-gtags--persistent-action + :fuzzy-match helm-gtags-fuzzy-match + :action 'helm-gtags--show-stack-action) + "Not documented.") + +;;;###autoload +(defun helm-gtags-select () + "Not documented." + (interactive) + (helm-gtags--common '(helm-source-gtags-select) nil)) + +;;;###autoload +(defun helm-gtags-select-path () + "Not documented." + (interactive) + (helm-gtags--common '(helm-source-gtags-select-path) nil)) + +(defsubst helm-gtags--beginning-of-defun () + "Not documented." + (cl-case major-mode + ((c-mode c++-mode java-mode) 'c-beginning-of-defun) + (php-mode 'php-beginning-of-defun) + (otherwise #'beginning-of-defun))) + +(defsubst helm-gtags--end-of-defun () + "Not documented." + (cl-case major-mode + ((c-mode c++-mode java-mode malabar-mode) 'c-end-of-defun) + (php-mode 'php-end-of-defun) + (otherwise #'end-of-defun))) + +(defun helm-gtags--current-funcion-bound () + "Not documented." + (save-excursion + (let (start) + (funcall (helm-gtags--beginning-of-defun)) + (setq start (line-number-at-pos)) + (funcall (helm-gtags--end-of-defun)) + (cons start (line-number-at-pos))))) + +(defun helm-gtags--tags-refered-from-this-function () + "Not documented." + (let* ((file (helm-gtags--real-file-name)) + (bound (helm-gtags--current-funcion-bound)) + (start-line (car bound)) + (end-line (cdr bound))) + (with-temp-buffer + (unless (process-file "global" nil t nil "-f" "-r" file) + (error "Failed: global -f -r %s" file)) + (goto-char (point-min)) + (let (tagnames finish) + (while (and (not finish) (not (eobp))) + (let* ((cols (split-string (helm-current-line-contents) nil t)) + (lineno (string-to-number (cl-second cols)))) + (if (and (> lineno start-line) (< lineno end-line)) + (let* ((tag (cl-first cols)) + (elm (cl-find tag tagnames :test 'equal))) + (unless elm + (push tag tagnames))) + (when (>= lineno end-line) + (setq finish t))) + (forward-line 1))) + (reverse tagnames))))) + +(defun helm-gtags--tag-in-function-persistent-action (cand) + "Not documented." + (let* ((bound (helm-gtags--current-funcion-bound)) + (limit (save-excursion + (goto-char (point-min)) + (forward-line (cdr bound)) + (goto-char (line-end-position)) + (point)))) + (when (search-forward cand nil limit) + (helm-highlight-current-line)))) + +;;;###autoload +(defun helm-gtags-tags-in-this-function () + "Show tagnames which are referenced in this function and jump to it." + (interactive) + (let ((tags (helm-gtags--tags-refered-from-this-function))) + (unless tags + (error "There are no tags which are refered from this function.")) + (let* ((name (format "Tags in [%s]" (which-function))) + (tag (helm-comp-read + "Tagnames: " tags + :must-match t :name name + :persistent-action 'helm-gtags--tag-in-function-persistent-action))) + (helm-gtags-find-tag tag)))) + +(defun helm-gtags--source-select-tag (candidate) + "Not documented." + (helm-build-in-buffer-source "Select Tag" + :init (lambda () (helm-gtags--tags-init candidate)) + :candidate-number-limit helm-gtags-maximum-candidates + :persistent-action 'helm-gtags--persistent-action + :fuzzy-match helm-gtags-fuzzy-match + :action helm-gtags--find-file-action)) + +(defun helm-gtags--source-select-rtag (candidate) + "Not documented." + (helm-build-in-buffer-source "Select Rtag" + :init (lambda () (helm-gtags--rtags-init candidate)) + :candidate-number-limit helm-gtags-maximum-candidates + :persistent-action 'helm-gtags--persistent-action + :fuzzy-match helm-gtags-fuzzy-match + :action helm-gtags--find-file-action)) + +(defsubst helm-gtags--action-by-timer (src) + "Not documented." + (run-with-timer 0.1 nil (lambda () (helm-gtags--common (list src) nil)))) + +(defun helm-gtags--select-tag-action (c) + "Not documented." + (helm-gtags--action-by-timer (helm-gtags--source-select-tag c))) + +(defun helm-gtags--select-rtag-action (c) + "Not documented." + (helm-gtags--action-by-timer (helm-gtags--source-select-rtag c))) + +(defun helm-gtags--select-cache-init-common (args tagfile) + "Not documented." + (let ((cache (helm-gtags--get-result-cache tagfile))) + (if cache + (insert cache) + (apply #'process-file "global" nil t nil args) + (let* ((cache (buffer-string)) + (cache-size (length cache))) + (when (<= cache-size helm-gtags-cache-max-result-size) + (helm-gtags--put-result-cache tagfile cache)))))) + +(defun helm-gtags--source-select-init () + "Not documented." + (with-current-buffer (helm-candidate-buffer 'global) + (if (not helm-gtags-cache-select-result) + (progn + (process-file "global" nil t nil "-c") + (helm-gtags--remove-carrige-returns)) + (helm-gtags--select-cache-init-common '("-c") "GTAGS")))) + +(defvar helm-source-gtags-select + (helm-build-in-buffer-source "Find tag from here" + :init 'helm-gtags--source-select-init + :candidate-number-limit helm-gtags-maximum-candidates + :persistent-action #'ignore + :fuzzy-match helm-gtags-fuzzy-match + :action (helm-make-actions + "Goto the location" #'helm-gtags--select-tag-action + "Goto the location(other buffer)" + (lambda (c) + (setq helm-gtags--use-otherwin t) + (helm-gtags--select-tag-action c)) + "Move to the referenced point" #'helm-gtags--select-rtag-action)) + "Not documented.") + +(defun helm-gtags--select-path-init () + "Not documented." + (helm-gtags--find-tag-directory) + (with-current-buffer (helm-candidate-buffer 'global) + (let ((options (if (eq helm-gtags-path-style 'relative) "-Po" "-Poa"))) + (if (not helm-gtags-cache-select-result) + (progn + (process-file "global" nil t nil options) + (helm-gtags--remove-carrige-returns)) + (helm-gtags--select-cache-init-common (list options) "GPATH"))))) + +(defun helm-gtags--file-name (name) + "Not documented." + (let ((remote (file-remote-p default-directory))) + (if (not remote) + name + (cl-case helm-gtags-path-style + (relative name) + (otherwise (concat remote name)))))) + +(defun helm-gtags--find-file-common (open-fn cand) + "Not documented." + (let ((default-directory (helm-gtags--base-directory))) + (funcall open-fn (helm-gtags--file-name cand)))) + +(defun helm-gtags--find-file (cand) + "Not documented." + (helm-gtags--find-file-common #'find-file cand)) + +(defun helm-gtags--find-file-other-window (cand) + "Not documented." + (helm-gtags--find-file-common #'find-file-other-window cand)) + +(defvar helm-gtags--file-util-action + (helm-make-actions + "Open file" #'helm-gtags--find-file + "Open file other window" #'helm-gtags--find-file-other-window) + "Not documented.") + +(defun helm-gtags--file-persistent-action (cand) + "Not documented." + (let ((default-directory (with-helm-current-buffer + default-directory))) + (helm-ff-kill-or-find-buffer-fname (helm-gtags--file-name cand)))) + +(defvar helm-source-gtags-select-path + (helm-build-in-buffer-source "Select path" + :init 'helm-gtags--select-path-init + :candidate-number-limit helm-gtags-maximum-candidates + :real-to-display 'helm-gtags--files-candidate-transformer + :persistent-action #'helm-gtags--file-persistent-action + :fuzzy-match helm-gtags-fuzzy-match + :action helm-gtags--file-util-action) + "Not documented.") + +(defun helm-gtags--searched-directory () + "Not documented." + (cl-case (prefix-numeric-value current-prefix-arg) + (4 (let ((dir (read-directory-name "Input Directory: "))) + (setq helm-gtags--local-directory (file-name-as-directory dir)))) + (16 (file-name-directory (buffer-file-name))))) + +(defsubst helm-gtags--using-other-window-p () + "Not documented." + (< (prefix-numeric-value current-prefix-arg) 0)) + +(defun helm-gtags--make-gtags-sentinel (action) + "Not documented." + (lambda (process _event) + (when (eq (process-status process) 'exit) + (if (zerop (process-exit-status process)) + (message "Success: %s TAGS" action) + (message "Failed: %s TAGS(%d)" action (process-exit-status process)))))) + +(defsubst helm-gtags--read-gtagslabel () + "Not documented." + (let ((labels '("default" "native" "ctags" "new-ctags" "pygments"))) + (completing-read "GTAGSLABEL(Default: default): " labels nil t nil nil "default"))) + +(defsubst helm-gtags--label-option (label) + "Not documented." + (concat "--gtagslabel=" label)) + +;;;###autoload +(defun helm-gtags-create-tags (dir label) + "Not documented." + (interactive + (list (read-directory-name "Root Directory: ") + (helm-gtags--read-gtagslabel))) + (let ((default-directory dir) + (proc-buf (get-buffer-create " *helm-gtags-create*"))) + (let ((proc (start-file-process "helm-gtags-create" proc-buf + "gtags" "-q" (helm-gtags--label-option label)))) + (set-process-sentinel proc (helm-gtags--make-gtags-sentinel 'create))))) + +(defun helm-gtags--find-tag-simple () + "Not documented." + (or (getenv "GTAGSROOT") + (locate-dominating-file default-directory "GTAGS") + (if (not (yes-or-no-p "File GTAGS not found. Run 'gtags'? ")) + (user-error "Abort") + (let* ((tagroot (read-directory-name "Root Directory: ")) + (label (helm-gtags--read-gtagslabel)) + (default-directory tagroot)) + (message "gtags is generating tags....") + (let ((label-opt (helm-gtags--label-option label))) + (unless (zerop (process-file "gtags" nil nil nil "-q" label-opt)) + (error "Failed: 'gtags -q %s'" label-opt))) + tagroot)))) + +(defun helm-gtags--current-file-and-line () + "Not documented." + (let* ((buffile (buffer-file-name)) + (path (cl-case helm-gtags-path-style + (absolute buffile) + (root + (file-relative-name buffile (helm-gtags--find-tag-directory))) + (relative + (file-relative-name buffile (helm-gtags--base-directory)))))) + (format "%s:%d" path (line-number-at-pos)))) + +(defsubst helm-gtags--clear-variables () + "Not documented." + (setq helm-gtags--last-default-directory nil)) + +(defun helm-gtags--common (srcs tagname) + "Not documented." + (helm-gtags--clear-variables) + (let ((helm-quit-if-no-candidate t) + (helm-execute-action-at-once-if-one t) + (dir (helm-gtags--searched-directory)) + (src (car srcs)) + (preselect-regexp (when helm-gtags-preselect + (regexp-quote (helm-gtags--current-file-and-line))))) + (when (symbolp src) + (setq src (symbol-value src))) + (unless helm-gtags--use-otherwin + (setq helm-gtags--use-otherwin (helm-gtags--using-other-window-p))) + (when tagname + (setq helm-gtags--query tagname)) + (let ((tagroot (helm-gtags--find-tag-simple))) + (helm-set-attr 'helm-gtags-base-directory dir src) + (when tagname + (helm-set-attr 'name (format "%s in %s" tagname (or dir tagroot)) src)) + (helm :sources srcs :buffer helm-gtags--buffer + :preselect preselect-regexp)))) + +;;;###autoload +(defun helm-gtags-delete-tags () + "Delete file GTAGS, GRTAGS, GPATH, ID etc. generated by gtags." + (interactive) + (let* ((root-dir (helm-gtags--tag-directory)) + (re (concat "\\`" (regexp-opt '("GPATH" "GRTAGS" "GTAGS" "ID")) "\\'")) + (files (cl-remove-if-not + (lambda (file) + ;; Don't trust `directory-files'. + (let ((case-fold-search nil)) + (string-match-p re (file-name-nondirectory file)))) + (directory-files root-dir t re))) + (buffer "*GTags File List*")) + (unless files + (user-error "No tag files found")) + (with-output-to-temp-buffer buffer + (princ (mapconcat #'identity files "\n"))) + (let ((win (get-buffer-window buffer))) + (unwind-protect + (progn + (fit-window-to-buffer win) + (when (yes-or-no-p "Remove GNU Global tag files? ") + (with-demoted-errors "Error deleting files: %S" + (mapc #'delete-file files)))) + (when (window-live-p win) + (quit-window t win)))))) + +;;;###autoload +(defun helm-gtags-find-tag (tag) + "Jump to definition" + (interactive + (list (helm-gtags--read-tagname 'tag))) + (helm-gtags--common '(helm-source-gtags-tags) tag)) + +;;;###autoload +(defun helm-gtags-find-tag-other-window (tag) + "Jump to definition in other window." + (interactive + (list (helm-gtags--read-tagname 'tag))) + (setq helm-gtags--use-otherwin t) + (helm-gtags-find-tag tag)) + +;;;###autoload +(defun helm-gtags-find-rtag (tag) + "Jump to referenced point" + (interactive + (list (helm-gtags--read-tagname 'rtag (which-function)))) + (helm-gtags--common '(helm-source-gtags-rtags) tag)) + +;;;###autoload +(defun helm-gtags-find-symbol (tag) + "Jump to the symbol location" + (interactive + (list (helm-gtags--read-tagname 'symbol))) + (helm-gtags--common '(helm-source-gtags-gsyms) tag)) + +;;;###autoload +(defun helm-gtags-find-pattern (pattern) + "Grep and jump by gtags tag files." + (interactive + (list (helm-gtags--read-tagname 'pattern))) + (helm-gtags--common '(helm-source-gtags-pattern) pattern)) + +(defun helm-gtags--find-file-after-hook () + "Not documented." + (helm-gtags--push-context helm-gtags--saved-context)) + +(defvar helm-source-gtags-files + (helm-build-in-buffer-source "Find files" + :init #'helm-gtags--files-init + :candidate-number-limit helm-gtags-maximum-candidates + :real-to-display #'helm-gtags--files-candidate-transformer + :persistent-action #'helm-gtags--file-persistent-action + :fuzzy-match helm-gtags-fuzzy-match + :action helm-gtags--file-util-action) + "Not documented.") + +;;;###autoload +(defun helm-gtags-find-files (file) + "Find file from tagged with gnu global." + (interactive + (list (helm-gtags--read-tagname 'find-file))) + (add-hook 'helm-after-action-hook 'helm-gtags--find-file-after-hook) + (unwind-protect + (helm-gtags--common '(helm-source-gtags-files) file) + (remove-hook 'helm-after-action-hook 'helm-gtags--find-file-after-hook))) + +;;;###autoload +(defun helm-gtags-find-tag-from-here () + "Jump point by current point information. +Jump to definition point if cursor is on its reference. +Jump to reference point if curosr is on its definition" + (interactive) + (helm-gtags--common '(helm-source-gtags-find-tag-from-here) nil)) + +;;;###autoload +(defun helm-gtags-dwim () + "Find by context. Here is +- on include statement then jump to included file +- on symbol definition then jump to its references +- on reference point then jump to its definition." + (interactive) + (let ((line (helm-current-line-contents))) + (if (string-match helm-gtags--include-regexp line) + (let ((helm-gtags-use-input-at-cursor t)) + (helm-gtags-find-files (match-string-no-properties 1 line))) + (if (and (buffer-file-name) (funcall helm-gtags-symbol-at-point-function)) + (helm-gtags-find-tag-from-here) + (call-interactively 'helm-gtags-find-tag))))) + +(defun helm-gtags--set-parsed-file () + "Not documented." + (let* ((this-file (file-name-nondirectory (buffer-file-name))) + (file (if current-prefix-arg + (read-file-name "Parsed File: " nil this-file) + this-file))) + (setq helm-gtags--parsed-file (expand-file-name file)))) + +(defun helm-gtags--find-preselect-line () + "Not documented." + (let ((defun-bound (bounds-of-thing-at-point 'defun))) + (if (not defun-bound) + (line-number-at-pos) + (let ((defun-begin-line (line-number-at-pos (car defun-bound))) + (filename (helm-gtags--real-file-name))) + (with-temp-buffer + (unless (zerop (process-file "global" nil t nil "-f" filename)) + (error "Failed: global -f")) + (goto-char (point-min)) + (let (start-line) + (while (and (not start-line) + (re-search-forward "^\\S-+\\s-+\\([1-9][0-9]*\\)" nil t)) + (let ((line (string-to-number (match-string-no-properties 1)))) + (when (>= line defun-begin-line) + (setq start-line line)))) + (or start-line (line-number-at-pos)))))))) + +;;;###autoload +(defun helm-gtags-parse-file () + "Parse current file with gnu global. This is similar to `imenu'. +You can jump definitions of functions, symbols in this file." + (interactive) + (helm-gtags--find-tag-directory) + (helm-gtags--save-current-context) + (setq helm-gtags--use-otherwin (helm-gtags--using-other-window-p)) + (helm-gtags--set-parsed-file) + (helm-set-attr 'name + (format "Parsed File: %s" + (file-relative-name helm-gtags--parsed-file + helm-gtags--tag-location)) + helm-source-gtags-parse-file) + (let ((presel (when helm-gtags-preselect + (format "^\\S-+\\s-+%d\\s-+" (helm-gtags--find-preselect-line))))) + (helm :sources '(helm-source-gtags-parse-file) + :buffer helm-gtags--buffer :preselect presel))) + +;;;###autoload +(defun helm-gtags-push-stack () + "Push current location to the stack." + (interactive) + (helm-gtags--push-context (helm-gtags--current-context))) + +;;;###autoload +(defun helm-gtags-pop-stack () + "Jump to previous point on the context stack and pop it from stack." + (interactive) + (let* ((context-info (helm-gtags--get-context-info)) + (context-stack (plist-get context-info :stack)) + (context (pop context-stack))) + (helm-gtags--put-context-stack helm-gtags--tag-location -1 context-stack) + (helm-gtags--move-to-context context))) + +;;;###autoload +(defun helm-gtags-show-stack () + "Show current context stack." + (interactive) + (helm :sources 'helm-source-gtags-show-stack + :buffer (get-buffer-create helm-gtags--buffer))) + +;;;###autoload +(defun helm-gtags-clear-stack () + "Clear current context stack." + (interactive) + (let ((tag-location (helm-gtags--find-tag-directory))) + (message "Clear '%s' context stack." tag-location) + (remhash tag-location helm-gtags--context-stack))) + +;;;###autoload +(defun helm-gtags-clear-all-stacks () + "Clear all context stacks." + (interactive) + (message "Clear all context statks.") + (setq helm-gtags--context-stack (make-hash-table :test 'equal))) + +(defun helm-gtags--read-tag-directory () + "Not documented." + (let ((dir (read-directory-name "Directory tag generated: " nil nil t))) + ;; On Windows, "gtags d:/tmp" work, but "gtags d:/tmp/" doesn't + (directory-file-name (expand-file-name dir)))) + +(defsubst helm-gtags--how-to-update-tags () + "Not documented." + (cl-case (prefix-numeric-value current-prefix-arg) + (4 'entire-update) + (16 'generate-other-directory) + (otherwise 'single-update))) + +(defun helm-gtags--update-tags-command (how-to) + "Not documented." + (cl-case how-to + (entire-update '("global" "-u")) + (generate-other-directory (list "gtags" (helm-gtags--read-tag-directory))) + (single-update (list "global" "--single-update" (helm-gtags--real-file-name))))) + +(defun helm-gtags--update-tags-p (how-to interactive-p current-time) + "Not documented." + (or interactive-p + (and (eq how-to 'single-update) + (buffer-file-name) + (or (not helm-gtags-update-interval-second) + (>= (- current-time helm-gtags--last-update-time) + helm-gtags-update-interval-second))))) + +;;;###autoload +(defun helm-gtags-update-tags () + "Update TAG file. Update All files with `C-u' prefix. +Generate new TAG file in selected directory with `C-u C-u'" + (interactive) + (let ((how-to (helm-gtags--how-to-update-tags)) + (interactive-p (called-interactively-p 'interactive)) + (current-time (float-time (current-time)))) + (when (helm-gtags--update-tags-p how-to interactive-p current-time) + (let* ((cmds (helm-gtags--update-tags-command how-to)) + (proc (apply #'start-file-process "helm-gtags-update-tag" nil cmds))) + (if (not proc) + (message "Failed: %s" (string-join cmds " ")) + (set-process-sentinel proc (helm-gtags--make-gtags-sentinel 'update)) + (setq helm-gtags--last-update-time current-time)))))) + +;;;###autoload +(defun helm-gtags-resume () + "Resurrect previously invoked `helm-gtags` command." + (interactive) + (unless (get-buffer helm-gtags--buffer) + (error "Error: helm-gtags buffer is not existed.")) + (helm-resume helm-gtags--buffer)) + +(defsubst helm-gtags--check-browser-installed (browser) + (let ((used-browser (or browser "mozilla"))) + (unless (executable-find used-browser) + (error "Not found browser '%s'" used-browser)))) + +(defun helm-gtags-display-browser () + "Display current screen on hypertext browser. +`browse-url-generic-program' is used as browser if its value is non-nil. +`mozilla' is used in other case." + (interactive) + (let ((file (buffer-file-name))) + (if (not file) + (error "This buffer is not related to file.") + (let* ((lineopt (concat "+" (number-to-string (line-number-at-pos)))) + (browser (symbol-value 'browse-url-generic-program)) + (args (list lineopt file))) + (helm-gtags--check-browser-installed browser) + (when browser + (setq args (append (list "-b" browser) args))) + ;; `gozilla' commend never returns error status if command is failed. + (apply #'process-file "gozilla" nil nil nil args))))) + +(defvar helm-gtags-mode-name " HelmGtags") +(defvar helm-gtags-mode-map (make-sparse-keymap)) + +;;;###autoload +(define-minor-mode helm-gtags-mode + "Enable helm-gtags." + :init-value nil + :global nil + :keymap helm-gtags-mode-map + :lighter helm-gtags-mode-name + (if helm-gtags-mode + (when helm-gtags-auto-update + (add-hook 'after-save-hook 'helm-gtags-update-tags nil t)) + (when helm-gtags-auto-update + (remove-hook 'after-save-hook 'helm-gtags-update-tags t)))) + +;; Key mapping of gtags-mode. +(when helm-gtags-suggested-key-mapping + ;; Current key mapping. + (let ((command-table '(("h" . helm-gtags-display-browser) + ("P" . helm-gtags-find-files) + ("f" . helm-gtags-parse-file) + ("g" . helm-gtags-find-pattern) + ("s" . helm-gtags-find-symbol) + ("r" . helm-gtags-find-rtag) + ("t" . helm-gtags-find-tag) + ("d" . helm-gtags-find-tag))) + (key-func (if (string-prefix-p "\\" helm-gtags-prefix-key) + #'concat + (lambda (prefix key) (kbd (concat prefix " " key)))))) + (cl-loop for (key . command) in command-table + do + (define-key helm-gtags-mode-map (funcall key-func helm-gtags-prefix-key key) command)) + + ;; common + (define-key helm-gtags-mode-map "\C-]" 'helm-gtags-find-tag-from-here) + (define-key helm-gtags-mode-map "\C-t" 'helm-gtags-pop-stack) + (define-key helm-gtags-mode-map "\e*" 'helm-gtags-pop-stack) + (define-key helm-gtags-mode-map "\e." 'helm-gtags-find-tag) + (define-key helm-gtags-mode-map "\C-x4." 'helm-gtags-find-tag-other-window))) + +(provide 'helm-gtags) + +;; Local Variables: +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-gtags.el ends here