update code profile elpa packages
This commit is contained in:
parent
da6c9c62d4
commit
ee6401529a
|
@ -1,6 +1,8 @@
|
||||||
(define-package "all-the-icons" "20230316.1906" "A library for inserting Developer icons"
|
(define-package "all-the-icons" "20230615.2016" "A library for inserting Developer icons"
|
||||||
'((emacs "24.3"))
|
'((emacs "24.3"))
|
||||||
:commit "d922aff57ac8308d3ed067f9151cc76d342855f2" :authors
|
:commit "f491f39c21336d354e85bdb4cca281e0a0c2f880" :authors
|
||||||
|
'(("Dominic Charlesworth" . "dgc336@gmail.com"))
|
||||||
|
:maintainers
|
||||||
'(("Dominic Charlesworth" . "dgc336@gmail.com"))
|
'(("Dominic Charlesworth" . "dgc336@gmail.com"))
|
||||||
:maintainer
|
:maintainer
|
||||||
'("Dominic Charlesworth" . "dgc336@gmail.com")
|
'("Dominic Charlesworth" . "dgc336@gmail.com")
|
|
@ -284,6 +284,8 @@
|
||||||
("tsx" all-the-icons-fileicon "tsx" :height 1.0 :v-adjust -0.1 :face all-the-icons-cyan-alt)
|
("tsx" all-the-icons-fileicon "tsx" :height 1.0 :v-adjust -0.1 :face all-the-icons-cyan-alt)
|
||||||
("njs" all-the-icons-alltheicon "nodejs" :height 1.2 :face all-the-icons-lgreen)
|
("njs" all-the-icons-alltheicon "nodejs" :height 1.2 :face all-the-icons-lgreen)
|
||||||
("vue" all-the-icons-fileicon "vue" :face all-the-icons-lgreen)
|
("vue" all-the-icons-fileicon "vue" :face all-the-icons-lgreen)
|
||||||
|
("wasm" all-the-icons-fileicon "wasm" :height 1.0 :face all-the-icons-purple-alt)
|
||||||
|
("wat" all-the-icons-fileicon "wasm" :height 1.0 :face all-the-icons-purple-alt)
|
||||||
|
|
||||||
("sbt" all-the-icons-fileicon "sbt" :face all-the-icons-red)
|
("sbt" all-the-icons-fileicon "sbt" :face all-the-icons-red)
|
||||||
("scala" all-the-icons-alltheicon "scala" :face all-the-icons-red)
|
("scala" all-the-icons-alltheicon "scala" :face all-the-icons-red)
|
||||||
|
@ -410,7 +412,7 @@
|
||||||
("pps" all-the-icons-fileicon "powerpoint" :face all-the-icons-orange)
|
("pps" all-the-icons-fileicon "powerpoint" :face all-the-icons-orange)
|
||||||
("ppt" all-the-icons-fileicon "powerpoint" :face all-the-icons-orange)
|
("ppt" all-the-icons-fileicon "powerpoint" :face all-the-icons-orange)
|
||||||
("pptsx" all-the-icons-fileicon "powerpoint" :face all-the-icons-orange)
|
("pptsx" all-the-icons-fileicon "powerpoint" :face all-the-icons-orange)
|
||||||
("ppttx" all-the-icons-fileicon "powerpoint" :face all-the-icons-orange)
|
("pptx" all-the-icons-fileicon "powerpoint" :face all-the-icons-orange)
|
||||||
("knt" all-the-icons-fileicon "powerpoint" :face all-the-icons-cyan)
|
("knt" all-the-icons-fileicon "powerpoint" :face all-the-icons-cyan)
|
||||||
("xlsx" all-the-icons-fileicon "excel" :face all-the-icons-dgreen)
|
("xlsx" all-the-icons-fileicon "excel" :face all-the-icons-dgreen)
|
||||||
("xlsm" all-the-icons-fileicon "excel" :face all-the-icons-dgreen)
|
("xlsm" all-the-icons-fileicon "excel" :face all-the-icons-dgreen)
|
||||||
|
@ -609,6 +611,7 @@ for performance sake.")
|
||||||
(ibuffer-mode all-the-icons-faicon "files-o" :v-adjust 0.0 :face all-the-icons-dsilver)
|
(ibuffer-mode all-the-icons-faicon "files-o" :v-adjust 0.0 :face all-the-icons-dsilver)
|
||||||
(messages-buffer-mode all-the-icons-faicon "file-o" :v-adjust 0.0 :face all-the-icons-dsilver)
|
(messages-buffer-mode all-the-icons-faicon "file-o" :v-adjust 0.0 :face all-the-icons-dsilver)
|
||||||
(help-mode all-the-icons-faicon "info" :v-adjust -0.1 :face all-the-icons-purple)
|
(help-mode all-the-icons-faicon "info" :v-adjust -0.1 :face all-the-icons-purple)
|
||||||
|
(helpful-mode all-the-icons-faicon "info" :v-adjust -0.1 :face all-the-icons-purple)
|
||||||
(benchmark-init/tree-mode all-the-icons-octicon "dashboard" :v-adjust 0.0)
|
(benchmark-init/tree-mode all-the-icons-octicon "dashboard" :v-adjust 0.0)
|
||||||
(jenkins-mode all-the-icons-fileicon "jenkins" :face all-the-icons-blue)
|
(jenkins-mode all-the-icons-fileicon "jenkins" :face all-the-icons-blue)
|
||||||
(magit-popup-mode all-the-icons-alltheicon "git" :face all-the-icons-red)
|
(magit-popup-mode all-the-icons-alltheicon "git" :face all-the-icons-red)
|
||||||
|
@ -1254,8 +1257,6 @@ FONT-NAME is the name of the .ttf file providing the font, defaults to FAMILY."
|
||||||
(interactive "P")
|
(interactive "P")
|
||||||
(all-the-icons-insert arg (quote ,name)))))
|
(all-the-icons-insert arg (quote ,name)))))
|
||||||
|
|
||||||
(define-obsolete-function-alias 'define-icon 'all-the-icons-define-icon "4.0.0")
|
|
||||||
|
|
||||||
(all-the-icons-define-icon alltheicon all-the-icons-data/alltheicons-alist "all-the-icons")
|
(all-the-icons-define-icon alltheicon all-the-icons-data/alltheicons-alist "all-the-icons")
|
||||||
(all-the-icons-define-icon fileicon all-the-icons-data/file-icon-alist "file-icons")
|
(all-the-icons-define-icon fileicon all-the-icons-data/file-icon-alist "file-icons")
|
||||||
(all-the-icons-define-icon faicon all-the-icons-data/fa-icon-alist "FontAwesome")
|
(all-the-icons-define-icon faicon all-the-icons-data/fa-icon-alist "FontAwesome")
|
File diff suppressed because it is too large
Load diff
|
@ -1,7 +1,9 @@
|
||||||
(define-package "async" "20230323.643" "Asynchronous processing in Emacs"
|
(define-package "async" "20230528.622" "Asynchronous processing in Emacs"
|
||||||
'((emacs "24.4"))
|
'((emacs "24.4"))
|
||||||
:commit "34feabe1142863a2c96f75afda1a2ae4aa0813f6" :authors
|
:commit "3ae74c0a4ba223ba373e0cb636c385e08d8838be" :authors
|
||||||
'(("John Wiegley" . "jwiegley@gmail.com"))
|
'(("John Wiegley" . "jwiegley@gmail.com"))
|
||||||
|
:maintainers
|
||||||
|
'(("Thierry Volpiatto" . "thievol@posteo.net"))
|
||||||
:maintainer
|
:maintainer
|
||||||
'("Thierry Volpiatto" . "thievol@posteo.net")
|
'("Thierry Volpiatto" . "thievol@posteo.net")
|
||||||
:keywords
|
:keywords
|
|
@ -251,7 +251,7 @@ See `dired-create-files' for the behavior of arguments."
|
||||||
(setq overwrite-query nil)
|
(setq overwrite-query nil)
|
||||||
(let ((total (length fn-list))
|
(let ((total (length fn-list))
|
||||||
failures async-fn-list skipped callback
|
failures async-fn-list skipped callback
|
||||||
async-quiet-switch)
|
async-quiet-switch create-dir)
|
||||||
(let (to)
|
(let (to)
|
||||||
(dolist (from fn-list)
|
(dolist (from fn-list)
|
||||||
(setq to (funcall name-constructor from))
|
(setq to (funcall name-constructor from))
|
||||||
|
@ -344,7 +344,17 @@ ESC or `q' to not overwrite any of the remaining files,
|
||||||
for destp = (file-exists-p to)
|
for destp = (file-exists-p to)
|
||||||
do (and bf destp
|
do (and bf destp
|
||||||
(with-current-buffer bf
|
(with-current-buffer bf
|
||||||
(set-visited-file-name to t t))))))))
|
(set-visited-file-name to t t)))))))
|
||||||
|
(let ((dirp (file-directory-p to))
|
||||||
|
(dest (file-name-directory to)))
|
||||||
|
(when (boundp 'dired-create-destination-dirs)
|
||||||
|
(setq create-dir
|
||||||
|
(cl-case dired-create-destination-dirs
|
||||||
|
(always 'always)
|
||||||
|
(ask (and (null dirp)
|
||||||
|
(null (file-directory-p dest))
|
||||||
|
(y-or-n-p (format "Create directory `%s'? " dest)))
|
||||||
|
'always))))))
|
||||||
;; Start async process.
|
;; Start async process.
|
||||||
(when async-fn-list
|
(when async-fn-list
|
||||||
(process-put
|
(process-put
|
||||||
|
@ -353,7 +363,8 @@ ESC or `q' to not overwrite any of the remaining files,
|
||||||
,(async-inject-variables dired-async-env-variables-regexp)
|
,(async-inject-variables dired-async-env-variables-regexp)
|
||||||
(let ((dired-recursive-copies (quote always))
|
(let ((dired-recursive-copies (quote always))
|
||||||
(dired-copy-preserve-time
|
(dired-copy-preserve-time
|
||||||
,dired-copy-preserve-time))
|
,dired-copy-preserve-time)
|
||||||
|
(dired-create-destination-dirs ',create-dir))
|
||||||
(setq overwrite-backup-query nil)
|
(setq overwrite-backup-query nil)
|
||||||
;; Inline `backup-file' as long as it is not
|
;; Inline `backup-file' as long as it is not
|
||||||
;; available in emacs.
|
;; available in emacs.
|
|
@ -168,10 +168,31 @@ Default is 'hand. The following scopes are possible:
|
||||||
;;; Icons
|
;;; Icons
|
||||||
;;
|
;;
|
||||||
(defcustom centaur-tabs-set-icons nil
|
(defcustom centaur-tabs-set-icons nil
|
||||||
"When non nil, display an icon from all-the-icons alongside the tab name."
|
"When non nil, display an icon based on `centaur-tabs-icon-type' alongside the tab name."
|
||||||
:group 'centaur-tabs
|
:group 'centaur-tabs
|
||||||
:type 'boolean)
|
:type 'boolean)
|
||||||
|
|
||||||
|
(defcustom centaur-tabs-icon-type (and centaur-tabs-set-icons
|
||||||
|
(or (require 'all-the-icons nil t)
|
||||||
|
(require 'nerd-icons nil t)))
|
||||||
|
"Icon type. It should be one of `all-the-icons' and `nerd-icons'."
|
||||||
|
:group 'centaur-tabs
|
||||||
|
:type 'symbol
|
||||||
|
:set
|
||||||
|
(lambda (k v)
|
||||||
|
(pcase v
|
||||||
|
('all-the-icons
|
||||||
|
(unless (require 'all-the-icons nil t)
|
||||||
|
(setq v nil)))
|
||||||
|
('nerd-icons
|
||||||
|
(unless (require 'nerd-icons nil t)
|
||||||
|
(setq v nil)))
|
||||||
|
(type
|
||||||
|
(if (require 'all-the-icons nil t)
|
||||||
|
(setq v 'all-the-icons)
|
||||||
|
(setq v nil))))
|
||||||
|
(set k v)))
|
||||||
|
|
||||||
(defvar centaur-tabs-icon-scale-factor
|
(defvar centaur-tabs-icon-scale-factor
|
||||||
1.0
|
1.0
|
||||||
"The base scale factor for the `height' face property of tab icons.")
|
"The base scale factor for the `height' face property of tab icons.")
|
||||||
|
@ -191,19 +212,41 @@ Default is 'hand. The following scopes are possible:
|
||||||
:group 'centaur-tabs
|
:group 'centaur-tabs
|
||||||
:type 'boolean)
|
:type 'boolean)
|
||||||
|
|
||||||
|
(defun centaur-tabs--icon-for-file (file &rest args)
|
||||||
|
"Get the formatted icon for FILE.
|
||||||
|
ARGS should be a plist containing `:height', `:v-adjust', or `:face' properties."
|
||||||
|
(pcase centaur-tabs-icon-type
|
||||||
|
('all-the-icons (apply #'all-the-icons-icon-for-file file args))
|
||||||
|
('nerd-icons (apply #'nerd-icons-icon-for-file file args))))
|
||||||
|
|
||||||
|
(defun centaur-tabs--icon-for-mode (mode &rest args)
|
||||||
|
"Get the formatted icon for MODE.
|
||||||
|
ARG-OVERRIDES should be a plist containining `:height',
|
||||||
|
`:v-adjust' or `:face' properties like in the normal icon
|
||||||
|
inserting functions."
|
||||||
|
(pcase centaur-tabs-icon-type
|
||||||
|
('all-the-icons (apply #'all-the-icons-icon-for-mode mode args))
|
||||||
|
('nerd-icons (apply #'nerd-icons-icon-for-mode mode args))))
|
||||||
|
|
||||||
|
(defun centaur-tabs--auto-mode-match? (&optional file)
|
||||||
|
"Whether or not FILE's `major-mode' match against its `auto-mode-alist'."
|
||||||
|
(pcase centaur-tabs-icon-type
|
||||||
|
('all-the-icons (apply #'all-the-icons-auto-mode-match? file))
|
||||||
|
('nerd-icons (apply #'nerd-icons-auto-mode-match? file))))
|
||||||
|
|
||||||
(defun centaur-tabs-icon (tab face selected)
|
(defun centaur-tabs-icon (tab face selected)
|
||||||
"Generate all-the-icons icon for TAB using FACE's background.
|
"Generate icon for TAB using FACE's background.
|
||||||
If icon gray out option enabled, gray out icon if not SELECTED."
|
If icon gray out option enabled, gray out icon if not SELECTED."
|
||||||
(if (featurep 'all-the-icons)
|
(if centaur-tabs-icon-type
|
||||||
(with-current-buffer (car tab)
|
(with-current-buffer (car tab)
|
||||||
(let* ((icon
|
(let* ((icon
|
||||||
(if (and (buffer-file-name)
|
(if (and (buffer-file-name)
|
||||||
(all-the-icons-auto-mode-match?))
|
(centaur-tabs--auto-mode-match?))
|
||||||
(all-the-icons-icon-for-file
|
(centaur-tabs--icon-for-file
|
||||||
(file-name-nondirectory (buffer-file-name))
|
(file-name-nondirectory (buffer-file-name))
|
||||||
:v-adjust centaur-tabs-icon-v-adjust
|
:v-adjust centaur-tabs-icon-v-adjust
|
||||||
:height centaur-tabs-icon-scale-factor)
|
:height centaur-tabs-icon-scale-factor)
|
||||||
(all-the-icons-icon-for-mode
|
(centaur-tabs--icon-for-mode
|
||||||
major-mode
|
major-mode
|
||||||
:v-adjust centaur-tabs-icon-v-adjust
|
:v-adjust centaur-tabs-icon-v-adjust
|
||||||
:height centaur-tabs-icon-scale-factor)))
|
:height centaur-tabs-icon-scale-factor)))
|
|
@ -36,6 +36,10 @@
|
||||||
(declare-function all-the-icons-auto-mode-match? "ext:all-the-icons.el" t t)
|
(declare-function all-the-icons-auto-mode-match? "ext:all-the-icons.el" t t)
|
||||||
(declare-function all-the-icons-icon-for-file "ext:all-the-icons.el" t t)
|
(declare-function all-the-icons-icon-for-file "ext:all-the-icons.el" t t)
|
||||||
(declare-function all-the-icons-icon-for-mode "ext:all-the-icons.el" t t)
|
(declare-function all-the-icons-icon-for-mode "ext:all-the-icons.el" t t)
|
||||||
|
(declare-function nerd-icons-match? "ext:nerd-icons.el" t t)
|
||||||
|
(declare-function nerd-icons-auto-mode-match? "ext:nerd-icons.el" t t)
|
||||||
|
(declare-function nerd-icons-icon-for-file "ext:nerd-icons.el" t t)
|
||||||
|
(declare-function nerd-icons-icon-for-mode "ext:nerd-icons.el" t t)
|
||||||
(declare-function projectile-project-root "ext:projectile.el" t t)
|
(declare-function projectile-project-root "ext:projectile.el" t t)
|
||||||
(declare-function projectile-project-name "ext:projectile.el" t t)
|
(declare-function projectile-project-name "ext:projectile.el" t t)
|
||||||
(defvar helm-source-centaur-tabs-group)
|
(defvar helm-source-centaur-tabs-group)
|
|
@ -1,8 +1,10 @@
|
||||||
(define-package "centaur-tabs" "20230109.457" "Aesthetic, modern looking customizable tabs plugin"
|
(define-package "centaur-tabs" "20230607.1501" "Aesthetic, modern looking customizable tabs plugin"
|
||||||
'((emacs "24.4")
|
'((emacs "24.4")
|
||||||
(powerline "2.4")
|
(powerline "2.4")
|
||||||
(cl-lib "0.5"))
|
(cl-lib "0.5"))
|
||||||
:commit "a2890d968d877b269a814a691356fc5877833c39" :authors
|
:commit "0bb1aa18d475319df85f192dce3327802866c3c3" :authors
|
||||||
|
'(("Emmanuel Bustos" . "ema2159@gmail.com"))
|
||||||
|
:maintainers
|
||||||
'(("Emmanuel Bustos" . "ema2159@gmail.com"))
|
'(("Emmanuel Bustos" . "ema2159@gmail.com"))
|
||||||
:maintainer
|
:maintainer
|
||||||
'("Emmanuel Bustos" . "ema2159@gmail.com")
|
'("Emmanuel Bustos" . "ema2159@gmail.com")
|
|
@ -1,6 +1,8 @@
|
||||||
(define-package "dash" "20230304.2223" "A modern list library for Emacs"
|
(define-package "dash" "20230714.723" "A modern list library for Emacs"
|
||||||
'((emacs "24"))
|
'((emacs "24"))
|
||||||
:commit "bdf4a5d868618532d34c7b5bae6ac382c3b58f67" :authors
|
:commit "f46268c75cb7c18361d3cee942cd4dc14a03aef4" :authors
|
||||||
|
'(("Magnar Sveen" . "magnars@gmail.com"))
|
||||||
|
:maintainers
|
||||||
'(("Magnar Sveen" . "magnars@gmail.com"))
|
'(("Magnar Sveen" . "magnars@gmail.com"))
|
||||||
:maintainer
|
:maintainer
|
||||||
'("Magnar Sveen" . "magnars@gmail.com")
|
'("Magnar Sveen" . "magnars@gmail.com")
|
|
@ -35,11 +35,11 @@
|
||||||
(unless (fboundp 'gv-define-setter)
|
(unless (fboundp 'gv-define-setter)
|
||||||
(require 'cl))
|
(require 'cl))
|
||||||
|
|
||||||
;; TODO: Emacs versions 24.3..24.5 complain about unknown `declare'
|
;; - 24.3 started complaining about unknown `declare' props.
|
||||||
;; props, so remove this when support for those versions is dropped.
|
;; - 25 introduced `pure' and `side-effect-free'.
|
||||||
(and (< emacs-major-version 25)
|
;; - 30 introduced `important-return-value'.
|
||||||
(boundp 'defun-declarations-alist)
|
(when (boundp 'defun-declarations-alist)
|
||||||
(dolist (prop '(pure side-effect-free))
|
(dolist (prop '(important-return-value pure side-effect-free))
|
||||||
(unless (assq prop defun-declarations-alist)
|
(unless (assq prop defun-declarations-alist)
|
||||||
(push (list prop #'ignore) defun-declarations-alist)))))
|
(push (list prop #'ignore) defun-declarations-alist)))))
|
||||||
|
|
||||||
|
@ -223,6 +223,7 @@ This function's anaphoric counterpart is `--dotimes'."
|
||||||
"Apply FN to each item in LIST and return the list of results.
|
"Apply FN to each item in LIST and return the list of results.
|
||||||
|
|
||||||
This function's anaphoric counterpart is `--map'."
|
This function's anaphoric counterpart is `--map'."
|
||||||
|
(declare (important-return-value t))
|
||||||
(mapcar fn list))
|
(mapcar fn list))
|
||||||
|
|
||||||
(defmacro --map (form list)
|
(defmacro --map (form list)
|
||||||
|
@ -258,6 +259,7 @@ etc. If LIST is empty, return INIT without calling FN.
|
||||||
This function's anaphoric counterpart is `--reduce-from'.
|
This function's anaphoric counterpart is `--reduce-from'.
|
||||||
|
|
||||||
For other folds, see also `-reduce' and `-reduce-r'."
|
For other folds, see also `-reduce' and `-reduce-r'."
|
||||||
|
(declare (important-return-value t))
|
||||||
(--reduce-from (funcall fn acc it) init list))
|
(--reduce-from (funcall fn acc it) init list))
|
||||||
|
|
||||||
(defmacro --reduce (form list)
|
(defmacro --reduce (form list)
|
||||||
|
@ -289,6 +291,7 @@ arguments.
|
||||||
This function's anaphoric counterpart is `--reduce'.
|
This function's anaphoric counterpart is `--reduce'.
|
||||||
|
|
||||||
For other folds, see also `-reduce-from' and `-reduce-r'."
|
For other folds, see also `-reduce-from' and `-reduce-r'."
|
||||||
|
(declare (important-return-value t))
|
||||||
(if list
|
(if list
|
||||||
(-reduce-from fn (car list) (cdr list))
|
(-reduce-from fn (car list) (cdr list))
|
||||||
(funcall fn)))
|
(funcall fn)))
|
||||||
|
@ -320,6 +323,7 @@ its last link with INIT, and evaluating the resulting expression.
|
||||||
This function's anaphoric counterpart is `--reduce-r-from'.
|
This function's anaphoric counterpart is `--reduce-r-from'.
|
||||||
|
|
||||||
For other folds, see also `-reduce-r' and `-reduce'."
|
For other folds, see also `-reduce-r' and `-reduce'."
|
||||||
|
(declare (important-return-value t))
|
||||||
(--reduce-r-from (funcall fn it acc) init list))
|
(--reduce-r-from (funcall fn it acc) init list))
|
||||||
|
|
||||||
(defmacro --reduce-r (form list)
|
(defmacro --reduce-r (form list)
|
||||||
|
@ -349,6 +353,7 @@ ignoring its last link, and evaluating the resulting expression.
|
||||||
This function's anaphoric counterpart is `--reduce-r'.
|
This function's anaphoric counterpart is `--reduce-r'.
|
||||||
|
|
||||||
For other folds, see also `-reduce-r-from' and `-reduce'."
|
For other folds, see also `-reduce-r-from' and `-reduce'."
|
||||||
|
(declare (important-return-value t))
|
||||||
(if list
|
(if list
|
||||||
(--reduce-r (funcall fn it acc) list)
|
(--reduce-r (funcall fn it acc) list)
|
||||||
(funcall fn)))
|
(funcall fn)))
|
||||||
|
@ -374,6 +379,7 @@ arguments.
|
||||||
This function's anaphoric counterpart is `--reductions-from'.
|
This function's anaphoric counterpart is `--reductions-from'.
|
||||||
|
|
||||||
For other folds, see also `-reductions' and `-reductions-r'."
|
For other folds, see also `-reductions' and `-reductions-r'."
|
||||||
|
(declare (important-return-value t))
|
||||||
(--reductions-from (funcall fn acc it) init list))
|
(--reductions-from (funcall fn acc it) init list))
|
||||||
|
|
||||||
(defmacro --reductions (form list)
|
(defmacro --reductions (form list)
|
||||||
|
@ -400,6 +406,7 @@ when `-reduce' (which see) is called with the same arguments.
|
||||||
This function's anaphoric counterpart is `--reductions'.
|
This function's anaphoric counterpart is `--reductions'.
|
||||||
|
|
||||||
For other folds, see also `-reductions' and `-reductions-r'."
|
For other folds, see also `-reductions' and `-reductions-r'."
|
||||||
|
(declare (important-return-value t))
|
||||||
(if list
|
(if list
|
||||||
(--reductions-from (funcall fn acc it) (car list) (cdr list))
|
(--reductions-from (funcall fn acc it) (car list) (cdr list))
|
||||||
(list (funcall fn))))
|
(list (funcall fn))))
|
||||||
|
@ -424,6 +431,7 @@ arguments.
|
||||||
This function's anaphoric counterpart is `--reductions-r-from'.
|
This function's anaphoric counterpart is `--reductions-r-from'.
|
||||||
|
|
||||||
For other folds, see also `-reductions' and `-reductions-r'."
|
For other folds, see also `-reductions' and `-reductions-r'."
|
||||||
|
(declare (important-return-value t))
|
||||||
(--reductions-r-from (funcall fn it acc) init list))
|
(--reductions-r-from (funcall fn it acc) init list))
|
||||||
|
|
||||||
(defmacro --reductions-r (form list)
|
(defmacro --reductions-r (form list)
|
||||||
|
@ -453,6 +461,7 @@ This function's anaphoric counterpart is `--reductions-r'.
|
||||||
|
|
||||||
For other folds, see also `-reductions-r-from' and
|
For other folds, see also `-reductions-r-from' and
|
||||||
`-reductions'."
|
`-reductions'."
|
||||||
|
(declare (important-return-value t))
|
||||||
(if list
|
(if list
|
||||||
(--reductions-r (funcall fn it acc) list)
|
(--reductions-r (funcall fn it acc) list)
|
||||||
(list (funcall fn))))
|
(list (funcall fn))))
|
||||||
|
@ -477,6 +486,7 @@ Alias: `-select'.
|
||||||
This function's anaphoric counterpart is `--filter'.
|
This function's anaphoric counterpart is `--filter'.
|
||||||
|
|
||||||
For similar operations, see also `-keep' and `-remove'."
|
For similar operations, see also `-keep' and `-remove'."
|
||||||
|
(declare (important-return-value t))
|
||||||
(--filter (funcall pred it) list))
|
(--filter (funcall pred it) list))
|
||||||
|
|
||||||
(defalias '-select '-filter)
|
(defalias '-select '-filter)
|
||||||
|
@ -499,6 +509,7 @@ Alias: `-reject'.
|
||||||
This function's anaphoric counterpart is `--remove'.
|
This function's anaphoric counterpart is `--remove'.
|
||||||
|
|
||||||
For similar operations, see also `-keep' and `-filter'."
|
For similar operations, see also `-keep' and `-filter'."
|
||||||
|
(declare (important-return-value t))
|
||||||
(--remove (funcall pred it) list))
|
(--remove (funcall pred it) list))
|
||||||
|
|
||||||
(defalias '-reject '-remove)
|
(defalias '-reject '-remove)
|
||||||
|
@ -534,6 +545,7 @@ Alias: `-reject-first'.
|
||||||
This function's anaphoric counterpart is `--remove-first'.
|
This function's anaphoric counterpart is `--remove-first'.
|
||||||
|
|
||||||
See also `-map-first', `-remove-item', and `-remove-last'."
|
See also `-map-first', `-remove-item', and `-remove-last'."
|
||||||
|
(declare (important-return-value t))
|
||||||
(--remove-first (funcall pred it) list))
|
(--remove-first (funcall pred it) list))
|
||||||
|
|
||||||
;; TODO: #'-quoting the macro upsets Emacs 24.
|
;; TODO: #'-quoting the macro upsets Emacs 24.
|
||||||
|
@ -559,6 +571,7 @@ Alias: `-reject-last'.
|
||||||
This function's anaphoric counterpart is `--remove-last'.
|
This function's anaphoric counterpart is `--remove-last'.
|
||||||
|
|
||||||
See also `-map-last', `-remove-item', and `-remove-first'."
|
See also `-map-last', `-remove-item', and `-remove-first'."
|
||||||
|
(declare (important-return-value t))
|
||||||
(--remove-last (funcall pred it) list))
|
(--remove-last (funcall pred it) list))
|
||||||
|
|
||||||
(defalias '-reject-last '-remove-last)
|
(defalias '-reject-last '-remove-last)
|
||||||
|
@ -589,11 +602,12 @@ Like `-filter', but returns the non-nil results of FN instead of
|
||||||
the corresponding elements of LIST.
|
the corresponding elements of LIST.
|
||||||
|
|
||||||
Its anaphoric counterpart is `--keep'."
|
Its anaphoric counterpart is `--keep'."
|
||||||
|
(declare (important-return-value t))
|
||||||
(--keep (funcall fn it) list))
|
(--keep (funcall fn it) list))
|
||||||
|
|
||||||
(defun -non-nil (list)
|
(defun -non-nil (list)
|
||||||
"Return a copy of LIST with all nil items removed."
|
"Return a copy of LIST with all nil items removed."
|
||||||
(declare (pure t) (side-effect-free t))
|
(declare (side-effect-free t))
|
||||||
(--filter it list))
|
(--filter it list))
|
||||||
|
|
||||||
(defmacro --map-indexed (form list)
|
(defmacro --map-indexed (form list)
|
||||||
|
@ -618,6 +632,7 @@ current element within LIST, and the element itself.
|
||||||
This function's anaphoric counterpart is `--map-indexed'.
|
This function's anaphoric counterpart is `--map-indexed'.
|
||||||
|
|
||||||
For a side-effecting variant, see also `-each-indexed'."
|
For a side-effecting variant, see also `-each-indexed'."
|
||||||
|
(declare (important-return-value t))
|
||||||
(--map-indexed (funcall fn it-index it) list))
|
(--map-indexed (funcall fn it-index it) list))
|
||||||
|
|
||||||
(defmacro --map-when (pred rep list)
|
(defmacro --map-when (pred rep list)
|
||||||
|
@ -636,6 +651,7 @@ are unchanged, and the rest are mapped through the REP function.
|
||||||
Alias: `-replace-where'
|
Alias: `-replace-where'
|
||||||
|
|
||||||
See also: `-update-at'"
|
See also: `-update-at'"
|
||||||
|
(declare (important-return-value t))
|
||||||
(--map-when (funcall pred it) (funcall rep it) list))
|
(--map-when (funcall pred it) (funcall rep it) list))
|
||||||
|
|
||||||
(defalias '-replace-where '-map-when)
|
(defalias '-replace-where '-map-when)
|
||||||
|
@ -647,6 +663,7 @@ Return a copy of LIST where the first item for which PRED returns
|
||||||
non-nil is replaced with the result of calling REP on that item.
|
non-nil is replaced with the result of calling REP on that item.
|
||||||
|
|
||||||
See also: `-map-when', `-replace-first'"
|
See also: `-map-when', `-replace-first'"
|
||||||
|
(declare (important-return-value t))
|
||||||
(let (front)
|
(let (front)
|
||||||
(while (and list (not (funcall pred (car list))))
|
(while (and list (not (funcall pred (car list))))
|
||||||
(push (car list) front)
|
(push (car list) front)
|
||||||
|
@ -668,6 +685,7 @@ Return a copy of LIST where the last item for which PRED returns
|
||||||
non-nil is replaced with the result of calling REP on that item.
|
non-nil is replaced with the result of calling REP on that item.
|
||||||
|
|
||||||
See also: `-map-when', `-replace-last'"
|
See also: `-map-when', `-replace-last'"
|
||||||
|
(declare (important-return-value t))
|
||||||
(nreverse (-map-first pred rep (reverse list))))
|
(nreverse (-map-first pred rep (reverse list))))
|
||||||
|
|
||||||
(defmacro --map-last (pred rep list)
|
(defmacro --map-last (pred rep list)
|
||||||
|
@ -712,6 +730,7 @@ See also: `-map-last'"
|
||||||
(defun -mapcat (fn list)
|
(defun -mapcat (fn list)
|
||||||
"Return the concatenation of the result of mapping FN over LIST.
|
"Return the concatenation of the result of mapping FN over LIST.
|
||||||
Thus function FN should return a list."
|
Thus function FN should return a list."
|
||||||
|
(declare (important-return-value t))
|
||||||
(--mapcat (funcall fn it) list))
|
(--mapcat (funcall fn it) list))
|
||||||
|
|
||||||
(defmacro --iterate (form init n)
|
(defmacro --iterate (form init n)
|
||||||
|
@ -735,6 +754,7 @@ This means a list of the form:
|
||||||
(INIT (FUN INIT) (FUN (FUN INIT)) ...)
|
(INIT (FUN INIT) (FUN (FUN INIT)) ...)
|
||||||
|
|
||||||
N is the length of the returned list."
|
N is the length of the returned list."
|
||||||
|
(declare (important-return-value t))
|
||||||
(--iterate (funcall fun it) init n))
|
(--iterate (funcall fun it) init n))
|
||||||
|
|
||||||
(defun -flatten (l)
|
(defun -flatten (l)
|
||||||
|
@ -816,12 +836,14 @@ marked positions (for example with keywords).
|
||||||
This function's anaphoric counterpart is `--splice'.
|
This function's anaphoric counterpart is `--splice'.
|
||||||
|
|
||||||
See also: `-splice-list', `-insert-at'."
|
See also: `-splice-list', `-insert-at'."
|
||||||
|
(declare (important-return-value t))
|
||||||
(--splice (funcall pred it) (funcall fun it) list))
|
(--splice (funcall pred it) (funcall fun it) list))
|
||||||
|
|
||||||
(defun -splice-list (pred new-list list)
|
(defun -splice-list (pred new-list list)
|
||||||
"Splice NEW-LIST in place of elements matching PRED in LIST.
|
"Splice NEW-LIST in place of elements matching PRED in LIST.
|
||||||
|
|
||||||
See also: `-splice', `-insert-at'"
|
See also: `-splice', `-insert-at'"
|
||||||
|
(declare (important-return-value t))
|
||||||
(-splice pred (lambda (_) new-list) list))
|
(-splice pred (lambda (_) new-list) list))
|
||||||
|
|
||||||
(defmacro --splice-list (pred new-list list)
|
(defmacro --splice-list (pred new-list list)
|
||||||
|
@ -834,7 +856,7 @@ See also: `-splice', `-insert-at'"
|
||||||
The last 2 elements of ARGS are used as the final cons of the
|
The last 2 elements of ARGS are used as the final cons of the
|
||||||
result, so if the final element of ARGS is not a list, the result
|
result, so if the final element of ARGS is not a list, the result
|
||||||
is a dotted list. With no ARGS, return nil."
|
is a dotted list. With no ARGS, return nil."
|
||||||
(declare (pure t) (side-effect-free t))
|
(declare (side-effect-free t))
|
||||||
(let* ((len (length args))
|
(let* ((len (length args))
|
||||||
(tail (nthcdr (- len 2) args))
|
(tail (nthcdr (- len 2) args))
|
||||||
(last (cdr tail)))
|
(last (cdr tail)))
|
||||||
|
@ -849,6 +871,7 @@ is a dotted list. With no ARGS, return nil."
|
||||||
This is like `cons', but operates on the end of list.
|
This is like `cons', but operates on the end of list.
|
||||||
|
|
||||||
If any ELEMENTS are given, append them to the list as well."
|
If any ELEMENTS are given, append them to the list as well."
|
||||||
|
(declare (side-effect-free t))
|
||||||
(-concat list (list elem) elements))
|
(-concat list (list elem) elements))
|
||||||
|
|
||||||
(defmacro --first (form list)
|
(defmacro --first (form list)
|
||||||
|
@ -874,6 +897,7 @@ use `-first-item'.
|
||||||
Alias: `-find'.
|
Alias: `-find'.
|
||||||
|
|
||||||
This function's anaphoric counterpart is `--first'."
|
This function's anaphoric counterpart is `--first'."
|
||||||
|
(declare (important-return-value t))
|
||||||
(--first (funcall pred it) list))
|
(--first (funcall pred it) list))
|
||||||
|
|
||||||
(defalias '-find #'-first)
|
(defalias '-find #'-first)
|
||||||
|
@ -897,6 +921,7 @@ This is the anaphoric counterpart to `-some'."
|
||||||
Alias: `-any'.
|
Alias: `-any'.
|
||||||
|
|
||||||
This function's anaphoric counterpart is `--some'."
|
This function's anaphoric counterpart is `--some'."
|
||||||
|
(declare (important-return-value t))
|
||||||
(--some (funcall pred it) list))
|
(--some (funcall pred it) list))
|
||||||
|
|
||||||
(defalias '-any '-some)
|
(defalias '-any '-some)
|
||||||
|
@ -930,6 +955,7 @@ This function is like `-every-p', but on success returns the last
|
||||||
non-nil result of PRED instead of just t.
|
non-nil result of PRED instead of just t.
|
||||||
|
|
||||||
This function's anaphoric counterpart is `--every'."
|
This function's anaphoric counterpart is `--every'."
|
||||||
|
(declare (important-return-value t))
|
||||||
(--every (funcall pred it) list))
|
(--every (funcall pred it) list))
|
||||||
|
|
||||||
(defmacro --last (form list)
|
(defmacro --last (form list)
|
||||||
|
@ -943,6 +969,7 @@ This function's anaphoric counterpart is `--every'."
|
||||||
|
|
||||||
(defun -last (pred list)
|
(defun -last (pred list)
|
||||||
"Return the last x in LIST where (PRED x) is non-nil, else nil."
|
"Return the last x in LIST where (PRED x) is non-nil, else nil."
|
||||||
|
(declare (important-return-value t))
|
||||||
(--last (funcall pred it) list))
|
(--last (funcall pred it) list))
|
||||||
|
|
||||||
(defalias '-first-item #'car
|
(defalias '-first-item #'car
|
||||||
|
@ -1033,6 +1060,7 @@ See also: `-first-item', etc."
|
||||||
|
|
||||||
(defun -count (pred list)
|
(defun -count (pred list)
|
||||||
"Counts the number of items in LIST where (PRED item) is non-nil."
|
"Counts the number of items in LIST where (PRED item) is non-nil."
|
||||||
|
(declare (important-return-value t))
|
||||||
(--count (funcall pred it) list))
|
(--count (funcall pred it) list))
|
||||||
|
|
||||||
(defun ---truthy? (obj)
|
(defun ---truthy? (obj)
|
||||||
|
@ -1049,6 +1077,7 @@ See also: `-first-item', etc."
|
||||||
"Return t if (PRED X) is non-nil for any X in LIST, else nil.
|
"Return t if (PRED X) is non-nil for any X in LIST, else nil.
|
||||||
|
|
||||||
Alias: `-any-p', `-some?', `-some-p'"
|
Alias: `-any-p', `-some?', `-some-p'"
|
||||||
|
(declare (important-return-value t))
|
||||||
(--any? (funcall pred it) list))
|
(--any? (funcall pred it) list))
|
||||||
|
|
||||||
(defalias '-some? '-any?)
|
(defalias '-some? '-any?)
|
||||||
|
@ -1087,6 +1116,7 @@ success.
|
||||||
Alias: `-all-p', `-every-p', `-every?'.
|
Alias: `-all-p', `-every-p', `-every?'.
|
||||||
|
|
||||||
This function's anaphoric counterpart is `--all?'."
|
This function's anaphoric counterpart is `--all?'."
|
||||||
|
(declare (important-return-value t))
|
||||||
(--all? (funcall pred it) list))
|
(--all? (funcall pred it) list))
|
||||||
|
|
||||||
(defalias '-every? '-all?)
|
(defalias '-every? '-all?)
|
||||||
|
@ -1105,6 +1135,7 @@ This function's anaphoric counterpart is `--all?'."
|
||||||
"Return t if (PRED X) is nil for all X in LIST, else nil.
|
"Return t if (PRED X) is nil for all X in LIST, else nil.
|
||||||
|
|
||||||
Alias: `-none-p'"
|
Alias: `-none-p'"
|
||||||
|
(declare (important-return-value t))
|
||||||
(--none? (funcall pred it) list))
|
(--none? (funcall pred it) list))
|
||||||
|
|
||||||
(defalias '-none-p '-none?)
|
(defalias '-none-p '-none?)
|
||||||
|
@ -1127,6 +1158,7 @@ non-nil for at least one other item in LIST. Return nil if all
|
||||||
items satisfy the predicate or none of them do.
|
items satisfy the predicate or none of them do.
|
||||||
|
|
||||||
Alias: `-only-some-p'"
|
Alias: `-only-some-p'"
|
||||||
|
(declare (important-return-value t))
|
||||||
(--only-some? (funcall pred it) list))
|
(--only-some? (funcall pred it) list))
|
||||||
|
|
||||||
(defalias '-only-some-p '-only-some?)
|
(defalias '-only-some-p '-only-some?)
|
||||||
|
@ -1140,7 +1172,7 @@ modulo the length of the list.
|
||||||
|
|
||||||
If STEP is a number, only each STEPth item in the resulting
|
If STEP is a number, only each STEPth item in the resulting
|
||||||
section is returned. Defaults to 1."
|
section is returned. Defaults to 1."
|
||||||
(declare (pure t) (side-effect-free t))
|
(declare (side-effect-free t))
|
||||||
(let ((length (length list))
|
(let ((length (length list))
|
||||||
(new-list nil))
|
(new-list nil))
|
||||||
;; to defaults to the end of the list
|
;; to defaults to the end of the list
|
||||||
|
@ -1181,6 +1213,7 @@ non-nil.
|
||||||
This function's anaphoric counterpart is `--take-while'.
|
This function's anaphoric counterpart is `--take-while'.
|
||||||
|
|
||||||
For another variant, see also `-drop-while'."
|
For another variant, see also `-drop-while'."
|
||||||
|
(declare (important-return-value t))
|
||||||
(--take-while (funcall pred it) list))
|
(--take-while (funcall pred it) list))
|
||||||
|
|
||||||
(defmacro --drop-while (form list)
|
(defmacro --drop-while (form list)
|
||||||
|
@ -1205,6 +1238,7 @@ nil.
|
||||||
This function's anaphoric counterpart is `--drop-while'.
|
This function's anaphoric counterpart is `--drop-while'.
|
||||||
|
|
||||||
For another variant, see also `-take-while'."
|
For another variant, see also `-take-while'."
|
||||||
|
(declare (important-return-value t))
|
||||||
(--drop-while (funcall pred it) list))
|
(--drop-while (funcall pred it) list))
|
||||||
|
|
||||||
(defun -take (n list)
|
(defun -take (n list)
|
||||||
|
@ -1213,7 +1247,7 @@ Return a copy of LIST if it contains N items or fewer.
|
||||||
Return nil if N is zero or less.
|
Return nil if N is zero or less.
|
||||||
|
|
||||||
See also: `-take-last'."
|
See also: `-take-last'."
|
||||||
(declare (pure t) (side-effect-free t))
|
(declare (side-effect-free t))
|
||||||
(--take-while (< it-index n) list))
|
(--take-while (< it-index n) list))
|
||||||
|
|
||||||
(defun -take-last (n list)
|
(defun -take-last (n list)
|
||||||
|
@ -1222,7 +1256,7 @@ Return a copy of LIST if it contains N items or fewer.
|
||||||
Return nil if N is zero or less.
|
Return nil if N is zero or less.
|
||||||
|
|
||||||
See also: `-take'."
|
See also: `-take'."
|
||||||
(declare (pure t) (side-effect-free t))
|
(declare (side-effect-free t))
|
||||||
(copy-sequence (last list n)))
|
(copy-sequence (last list n)))
|
||||||
|
|
||||||
(defalias '-drop #'nthcdr
|
(defalias '-drop #'nthcdr
|
||||||
|
@ -1239,7 +1273,7 @@ Return a copy of LIST if N is zero or less.
|
||||||
Return nil if LIST contains N items or fewer.
|
Return nil if LIST contains N items or fewer.
|
||||||
|
|
||||||
See also: `-drop'."
|
See also: `-drop'."
|
||||||
(declare (pure t) (side-effect-free t))
|
(declare (side-effect-free t))
|
||||||
(nbutlast (copy-sequence list) n))
|
(nbutlast (copy-sequence list) n))
|
||||||
|
|
||||||
(defun -split-at (n list)
|
(defun -split-at (n list)
|
||||||
|
@ -1249,7 +1283,7 @@ new list of the first N elements of LIST, and DROP is the
|
||||||
remaining elements of LIST (not a copy). TAKE and DROP are like
|
remaining elements of LIST (not a copy). TAKE and DROP are like
|
||||||
the results of `-take' and `-drop', respectively, but the split
|
the results of `-take' and `-drop', respectively, but the split
|
||||||
is done in a single list traversal."
|
is done in a single list traversal."
|
||||||
(declare (pure t) (side-effect-free t))
|
(declare (side-effect-free t))
|
||||||
(let (result)
|
(let (result)
|
||||||
(--each-while list (< it-index n)
|
(--each-while list (< it-index n)
|
||||||
(push (pop list) result))
|
(push (pop list) result))
|
||||||
|
@ -1288,6 +1322,7 @@ Return a copy of LIST where the Nth element is replaced with the
|
||||||
result of calling FUNC on it.
|
result of calling FUNC on it.
|
||||||
|
|
||||||
See also: `-map-when'"
|
See also: `-map-when'"
|
||||||
|
(declare (important-return-value t))
|
||||||
(let ((split-list (-split-at n list)))
|
(let ((split-list (-split-at n list)))
|
||||||
(nconc (car split-list)
|
(nconc (car split-list)
|
||||||
(cons (funcall func (car (cadr split-list)))
|
(cons (funcall func (car (cadr split-list)))
|
||||||
|
@ -1361,6 +1396,7 @@ that do not. The result is like performing
|
||||||
((-take-while PRED LIST) (-drop-while PRED LIST))
|
((-take-while PRED LIST) (-drop-while PRED LIST))
|
||||||
|
|
||||||
but in no more than a single pass through LIST."
|
but in no more than a single pass through LIST."
|
||||||
|
(declare (important-return-value t))
|
||||||
(--split-with (funcall pred it) list))
|
(--split-with (funcall pred it) list))
|
||||||
|
|
||||||
(defmacro -split-on (item list)
|
(defmacro -split-on (item list)
|
||||||
|
@ -1388,6 +1424,7 @@ the results. Empty lists are also removed from the result.
|
||||||
|
|
||||||
This function can be thought of as a generalization of
|
This function can be thought of as a generalization of
|
||||||
`split-string'."
|
`split-string'."
|
||||||
|
(declare (important-return-value t))
|
||||||
(let (r s)
|
(let (r s)
|
||||||
(while list
|
(while list
|
||||||
(if (not (funcall fn (car list)))
|
(if (not (funcall fn (car list)))
|
||||||
|
@ -1414,6 +1451,7 @@ The result is like performing
|
||||||
((-filter PRED LIST) (-remove PRED LIST))
|
((-filter PRED LIST) (-remove PRED LIST))
|
||||||
|
|
||||||
but in a single pass through LIST."
|
but in a single pass through LIST."
|
||||||
|
(declare (important-return-value t))
|
||||||
(--separate (funcall pred it) list))
|
(--separate (funcall pred it) list))
|
||||||
|
|
||||||
(defun dash--partition-all-in-steps-reversed (n step list)
|
(defun dash--partition-all-in-steps-reversed (n step list)
|
||||||
|
@ -1486,6 +1524,7 @@ those items are discarded."
|
||||||
|
|
||||||
(defun -partition-by (fn list)
|
(defun -partition-by (fn list)
|
||||||
"Apply FN to each item in LIST, splitting it each time FN returns a new value."
|
"Apply FN to each item in LIST, splitting it each time FN returns a new value."
|
||||||
|
(declare (important-return-value t))
|
||||||
(--partition-by (funcall fn it) list))
|
(--partition-by (funcall fn it) list))
|
||||||
|
|
||||||
(defmacro --partition-by-header (form list)
|
(defmacro --partition-by-header (form list)
|
||||||
|
@ -1524,6 +1563,7 @@ those items are discarded."
|
||||||
value. Apply FN to each item in LIST, splitting it each time FN
|
value. Apply FN to each item in LIST, splitting it each time FN
|
||||||
returns the header value, but only after seeing at least one
|
returns the header value, but only after seeing at least one
|
||||||
other value (the body)."
|
other value (the body)."
|
||||||
|
(declare (important-return-value t))
|
||||||
(--partition-by-header (funcall fn it) list))
|
(--partition-by-header (funcall fn it) list))
|
||||||
|
|
||||||
(defmacro --partition-after-pred (form list)
|
(defmacro --partition-after-pred (form list)
|
||||||
|
@ -1550,20 +1590,24 @@ This is the anaphoric counterpart to `-partition-after-pred'."
|
||||||
"Partition LIST after each element for which PRED returns non-nil.
|
"Partition LIST after each element for which PRED returns non-nil.
|
||||||
|
|
||||||
This function's anaphoric counterpart is `--partition-after-pred'."
|
This function's anaphoric counterpart is `--partition-after-pred'."
|
||||||
|
(declare (important-return-value t))
|
||||||
(--partition-after-pred (funcall pred it) list))
|
(--partition-after-pred (funcall pred it) list))
|
||||||
|
|
||||||
(defun -partition-before-pred (pred list)
|
(defun -partition-before-pred (pred list)
|
||||||
"Partition directly before each time PRED is true on an element of LIST."
|
"Partition directly before each time PRED is true on an element of LIST."
|
||||||
|
(declare (important-return-value t))
|
||||||
(nreverse (-map #'reverse
|
(nreverse (-map #'reverse
|
||||||
(-partition-after-pred pred (reverse list)))))
|
(-partition-after-pred pred (reverse list)))))
|
||||||
|
|
||||||
(defun -partition-after-item (item list)
|
(defun -partition-after-item (item list)
|
||||||
"Partition directly after each time ITEM appears in LIST."
|
"Partition directly after each time ITEM appears in LIST."
|
||||||
|
(declare (pure t) (side-effect-free t))
|
||||||
(-partition-after-pred (lambda (ele) (equal ele item))
|
(-partition-after-pred (lambda (ele) (equal ele item))
|
||||||
list))
|
list))
|
||||||
|
|
||||||
(defun -partition-before-item (item list)
|
(defun -partition-before-item (item list)
|
||||||
"Partition directly before each time ITEM appears in LIST."
|
"Partition directly before each time ITEM appears in LIST."
|
||||||
|
(declare (pure t) (side-effect-free t))
|
||||||
(-partition-before-pred (lambda (ele) (equal ele item))
|
(-partition-before-pred (lambda (ele) (equal ele item))
|
||||||
list))
|
list))
|
||||||
|
|
||||||
|
@ -1592,11 +1636,12 @@ This function's anaphoric counterpart is `--partition-after-pred'."
|
||||||
(defun -group-by (fn list)
|
(defun -group-by (fn list)
|
||||||
"Separate LIST into an alist whose keys are FN applied to the
|
"Separate LIST into an alist whose keys are FN applied to the
|
||||||
elements of LIST. Keys are compared by `equal'."
|
elements of LIST. Keys are compared by `equal'."
|
||||||
|
(declare (important-return-value t))
|
||||||
(--group-by (funcall fn it) list))
|
(--group-by (funcall fn it) list))
|
||||||
|
|
||||||
(defun -interpose (sep list)
|
(defun -interpose (sep list)
|
||||||
"Return a new list of all elements in LIST separated by SEP."
|
"Return a new list of all elements in LIST separated by SEP."
|
||||||
(declare (pure t) (side-effect-free t))
|
(declare (side-effect-free t))
|
||||||
(let (result)
|
(let (result)
|
||||||
(when list
|
(when list
|
||||||
(!cons (car list) result)
|
(!cons (car list) result)
|
||||||
|
@ -1608,7 +1653,7 @@ elements of LIST. Keys are compared by `equal'."
|
||||||
|
|
||||||
(defun -interleave (&rest lists)
|
(defun -interleave (&rest lists)
|
||||||
"Return a new list of the first item in each list, then the second etc."
|
"Return a new list of the first item in each list, then the second etc."
|
||||||
(declare (pure t) (side-effect-free t))
|
(declare (side-effect-free t))
|
||||||
(when lists
|
(when lists
|
||||||
(let (result)
|
(let (result)
|
||||||
(while (-none? 'null lists)
|
(while (-none? 'null lists)
|
||||||
|
@ -1647,6 +1692,7 @@ shorter list.
|
||||||
This function's anaphoric counterpart is `--zip-with'.
|
This function's anaphoric counterpart is `--zip-with'.
|
||||||
|
|
||||||
For other zips, see also `-zip-lists' and `-zip-fill'."
|
For other zips, see also `-zip-lists' and `-zip-fill'."
|
||||||
|
(declare (important-return-value t))
|
||||||
(--zip-with (funcall fn it other) list1 list2))
|
(--zip-with (funcall fn it other) list1 list2))
|
||||||
|
|
||||||
(defun -zip-lists (&rest lists)
|
(defun -zip-lists (&rest lists)
|
||||||
|
@ -1844,6 +1890,7 @@ corresponding element of LIST, and RESULT is the value obtained
|
||||||
by calling FN on ITEM.
|
by calling FN on ITEM.
|
||||||
|
|
||||||
This function's anaphoric counterpart is `--annotate'."
|
This function's anaphoric counterpart is `--annotate'."
|
||||||
|
(declare (important-return-value t))
|
||||||
(--annotate (funcall fn it) list))
|
(--annotate (funcall fn it) list))
|
||||||
|
|
||||||
(defun dash--table-carry (lists restore-lists &optional re)
|
(defun dash--table-carry (lists restore-lists &optional re)
|
||||||
|
@ -1872,6 +1919,7 @@ combinations created by taking one element from each list in
|
||||||
order. The dimension of the result is (length lists).
|
order. The dimension of the result is (length lists).
|
||||||
|
|
||||||
See also: `-table-flat'"
|
See also: `-table-flat'"
|
||||||
|
(declare (important-return-value t))
|
||||||
(let ((restore-lists (copy-sequence lists))
|
(let ((restore-lists (copy-sequence lists))
|
||||||
(last-list (last lists))
|
(last-list (last lists))
|
||||||
(re (make-list (length lists) nil)))
|
(re (make-list (length lists) nil)))
|
||||||
|
@ -1898,6 +1946,7 @@ of the result. This is equivalent to calling:
|
||||||
but the implementation here is much more efficient.
|
but the implementation here is much more efficient.
|
||||||
|
|
||||||
See also: `-flatten-n', `-table'"
|
See also: `-flatten-n', `-table'"
|
||||||
|
(declare (important-return-value t))
|
||||||
(let ((restore-lists (copy-sequence lists))
|
(let ((restore-lists (copy-sequence lists))
|
||||||
(last-list (last lists))
|
(last-list (last lists))
|
||||||
re)
|
re)
|
||||||
|
@ -1927,6 +1976,7 @@ it returns non-nil, at which point the search terminates.
|
||||||
This function's anaphoric counterpart is `--find-index'.
|
This function's anaphoric counterpart is `--find-index'.
|
||||||
|
|
||||||
See also: `-first', `-find-last-index'."
|
See also: `-first', `-find-last-index'."
|
||||||
|
(declare (important-return-value t))
|
||||||
(--find-index (funcall pred it) list))
|
(--find-index (funcall pred it) list))
|
||||||
|
|
||||||
(defun -elem-index (elem list)
|
(defun -elem-index (elem list)
|
||||||
|
@ -1957,6 +2007,7 @@ the same order as they appear in LIST.
|
||||||
This function's anaphoric counterpart is `--find-indices'.
|
This function's anaphoric counterpart is `--find-indices'.
|
||||||
|
|
||||||
See also: `-find-index', `-elem-indices'."
|
See also: `-find-index', `-elem-indices'."
|
||||||
|
(declare (important-return-value t))
|
||||||
(--find-indices (funcall pred it) list))
|
(--find-indices (funcall pred it) list))
|
||||||
|
|
||||||
(defun -elem-indices (elem list)
|
(defun -elem-indices (elem list)
|
||||||
|
@ -1989,6 +2040,7 @@ current list element.
|
||||||
This function's anaphoric counterpart is `--find-last-index'.
|
This function's anaphoric counterpart is `--find-last-index'.
|
||||||
|
|
||||||
See also: `-last', `-find-index'."
|
See also: `-last', `-find-index'."
|
||||||
|
(declare (important-return-value t))
|
||||||
(--find-last-index (funcall pred it) list))
|
(--find-last-index (funcall pred it) list))
|
||||||
|
|
||||||
(defun -select-by-indices (indices list)
|
(defun -select-by-indices (indices list)
|
||||||
|
@ -2134,6 +2186,7 @@ Note: `it' need not be used in each form."
|
||||||
"Grade elements of LIST using COMPARATOR relation.
|
"Grade elements of LIST using COMPARATOR relation.
|
||||||
This yields a permutation vector such that applying this
|
This yields a permutation vector such that applying this
|
||||||
permutation to LIST sorts it in ascending order."
|
permutation to LIST sorts it in ascending order."
|
||||||
|
(declare (important-return-value t))
|
||||||
(->> (--map-indexed (cons it it-index) list)
|
(->> (--map-indexed (cons it it-index) list)
|
||||||
(-sort (lambda (it other) (funcall comparator (car it) (car other))))
|
(-sort (lambda (it other) (funcall comparator (car it) (car other))))
|
||||||
(mapcar #'cdr)))
|
(mapcar #'cdr)))
|
||||||
|
@ -2142,6 +2195,7 @@ permutation to LIST sorts it in ascending order."
|
||||||
"Grade elements of LIST using COMPARATOR relation.
|
"Grade elements of LIST using COMPARATOR relation.
|
||||||
This yields a permutation vector such that applying this
|
This yields a permutation vector such that applying this
|
||||||
permutation to LIST sorts it in descending order."
|
permutation to LIST sorts it in descending order."
|
||||||
|
(declare (important-return-value t))
|
||||||
(->> (--map-indexed (cons it it-index) list)
|
(->> (--map-indexed (cons it it-index) list)
|
||||||
(-sort (lambda (it other) (funcall comparator (car other) (car it))))
|
(-sort (lambda (it other) (funcall comparator (car other) (car it))))
|
||||||
(mapcar #'cdr)))
|
(mapcar #'cdr)))
|
||||||
|
@ -2865,7 +2919,7 @@ Return nil if `-compare-fn' is not a known test function."
|
||||||
(declare (side-effect-free error-free))
|
(declare (side-effect-free error-free))
|
||||||
;; In theory this could also recognize values that are custom
|
;; In theory this could also recognize values that are custom
|
||||||
;; `hash-table-test's, but too often the :test name is different
|
;; `hash-table-test's, but too often the :test name is different
|
||||||
;; from the equality function, so it doesn't seem worthwile.
|
;; from the equality function, so it doesn't seem worthwhile.
|
||||||
(car (memq (or -compare-fn #'equal) '(equal eq eql))))
|
(car (memq (or -compare-fn #'equal) '(equal eq eql))))
|
||||||
|
|
||||||
(defvar dash--short-list-length 32
|
(defvar dash--short-list-length 32
|
||||||
|
@ -2881,6 +2935,7 @@ The test for equality is done with `equal', or with `-compare-fn'
|
||||||
if that is non-nil.
|
if that is non-nil.
|
||||||
|
|
||||||
Alias: `-uniq'."
|
Alias: `-uniq'."
|
||||||
|
(declare (important-return-value t))
|
||||||
(let (test len)
|
(let (test len)
|
||||||
(cond ((null list) ())
|
(cond ((null list) ())
|
||||||
;; Use a hash table if `-compare-fn' is a known hash table
|
;; Use a hash table if `-compare-fn' is a known hash table
|
||||||
|
@ -2910,6 +2965,7 @@ even in the presence of bignum support."
|
||||||
|
|
||||||
The test for equality is done with `equal', or with `-compare-fn'
|
The test for equality is done with `equal', or with `-compare-fn'
|
||||||
if that is non-nil."
|
if that is non-nil."
|
||||||
|
(declare (important-return-value t))
|
||||||
(let ((lists (list list1 list2)) test len union)
|
(let ((lists (list list1 list2)) test len union)
|
||||||
(cond ((null (or list1 list2)))
|
(cond ((null (or list1 list2)))
|
||||||
;; Use a hash table if `-compare-fn' is a known hash table
|
;; Use a hash table if `-compare-fn' is a known hash table
|
||||||
|
@ -2932,6 +2988,7 @@ if that is non-nil."
|
||||||
|
|
||||||
The test for equality is done with `equal', or with `-compare-fn'
|
The test for equality is done with `equal', or with `-compare-fn'
|
||||||
if that is non-nil."
|
if that is non-nil."
|
||||||
|
(declare (important-return-value t))
|
||||||
(let (test len)
|
(let (test len)
|
||||||
(cond ((null (and list1 list2)) ())
|
(cond ((null (and list1 list2)) ())
|
||||||
;; Use a hash table if `-compare-fn' is a known hash table
|
;; Use a hash table if `-compare-fn' is a known hash table
|
||||||
|
@ -2953,6 +3010,7 @@ if that is non-nil."
|
||||||
|
|
||||||
The test for equality is done with `equal', or with `-compare-fn'
|
The test for equality is done with `equal', or with `-compare-fn'
|
||||||
if that is non-nil."
|
if that is non-nil."
|
||||||
|
(declare (important-return-value t))
|
||||||
(let (test len1 len2)
|
(let (test len1 len2)
|
||||||
(cond ((null list1) ())
|
(cond ((null list1) ())
|
||||||
((null list2) (-distinct list1))
|
((null list2) (-distinct list1))
|
||||||
|
@ -2978,6 +3036,7 @@ if that is non-nil."
|
||||||
|
|
||||||
(defun -powerset (list)
|
(defun -powerset (list)
|
||||||
"Return the power set of LIST."
|
"Return the power set of LIST."
|
||||||
|
(declare (pure t) (side-effect-free t))
|
||||||
(if (null list) (list ())
|
(if (null list) (list ())
|
||||||
(let ((last (-powerset (cdr list))))
|
(let ((last (-powerset (cdr list))))
|
||||||
(nconc (mapcar (lambda (x) (cons (car list) x)) last)
|
(nconc (mapcar (lambda (x) (cons (car list) x)) last)
|
||||||
|
@ -2993,6 +3052,7 @@ The test for equality is done with `equal', or with `-compare-fn'
|
||||||
if that is non-nil.
|
if that is non-nil.
|
||||||
|
|
||||||
See also `-count' and `-group-by'."
|
See also `-count' and `-group-by'."
|
||||||
|
(declare (important-return-value t))
|
||||||
(let (test len freqs)
|
(let (test len freqs)
|
||||||
(cond ((null list))
|
(cond ((null list))
|
||||||
((and (setq test (dash--hash-test-fn))
|
((and (setq test (dash--hash-test-fn))
|
||||||
|
@ -3112,6 +3172,7 @@ in LIST, as returned by `-frequencies'."
|
||||||
|
|
||||||
Duplicate elements of LIST are determined by `equal', or by
|
Duplicate elements of LIST are determined by `equal', or by
|
||||||
`-compare-fn' if that is non-nil."
|
`-compare-fn' if that is non-nil."
|
||||||
|
(declare (important-return-value t))
|
||||||
(cond ((null list) (list ()))
|
(cond ((null list) (list ()))
|
||||||
;; Optimization: a traversal of `list' is faster than the
|
;; Optimization: a traversal of `list' is faster than the
|
||||||
;; round trip via `dash--uniq-perms' or `dash--multi-perms'.
|
;; round trip via `dash--uniq-perms' or `dash--multi-perms'.
|
||||||
|
@ -3125,6 +3186,7 @@ Duplicate elements of LIST are determined by `equal', or by
|
||||||
|
|
||||||
(defun -inits (list)
|
(defun -inits (list)
|
||||||
"Return all prefixes of LIST."
|
"Return all prefixes of LIST."
|
||||||
|
(declare (pure t) (side-effect-free t))
|
||||||
(let ((res (list list)))
|
(let ((res (list list)))
|
||||||
(setq list (reverse list))
|
(setq list (reverse list))
|
||||||
(while list
|
(while list
|
||||||
|
@ -3132,8 +3194,9 @@ Duplicate elements of LIST are determined by `equal', or by
|
||||||
res))
|
res))
|
||||||
|
|
||||||
(defun -tails (list)
|
(defun -tails (list)
|
||||||
"Return all suffixes of LIST"
|
"Return all suffixes of LIST."
|
||||||
(-reductions-r-from 'cons nil list))
|
(declare (pure t) (side-effect-free t))
|
||||||
|
(-reductions-r-from #'cons nil list))
|
||||||
|
|
||||||
(defun -common-prefix (&rest lists)
|
(defun -common-prefix (&rest lists)
|
||||||
"Return the longest common prefix of LISTS."
|
"Return the longest common prefix of LISTS."
|
||||||
|
@ -3143,6 +3206,7 @@ Duplicate elements of LIST are determined by `equal', or by
|
||||||
|
|
||||||
(defun -common-suffix (&rest lists)
|
(defun -common-suffix (&rest lists)
|
||||||
"Return the longest common suffix of LISTS."
|
"Return the longest common suffix of LISTS."
|
||||||
|
(declare (pure t) (side-effect-free t))
|
||||||
(nreverse (apply #'-common-prefix (mapcar #'reverse lists))))
|
(nreverse (apply #'-common-prefix (mapcar #'reverse lists))))
|
||||||
|
|
||||||
(defun -contains? (list element)
|
(defun -contains? (list element)
|
||||||
|
@ -3153,6 +3217,7 @@ if that is non-nil. As with `member', the return value is
|
||||||
actually the tail of LIST whose car is ELEMENT.
|
actually the tail of LIST whose car is ELEMENT.
|
||||||
|
|
||||||
Alias: `-contains-p'."
|
Alias: `-contains-p'."
|
||||||
|
(declare (important-return-value t))
|
||||||
(funcall (dash--member-fn) element list))
|
(funcall (dash--member-fn) element list))
|
||||||
|
|
||||||
(defalias '-contains-p #'-contains?)
|
(defalias '-contains-p #'-contains?)
|
||||||
|
@ -3166,6 +3231,7 @@ elements. The test for equality is done with `equal', or with
|
||||||
`-compare-fn' if that is non-nil.
|
`-compare-fn' if that is non-nil.
|
||||||
|
|
||||||
Alias: `-same-items-p'."
|
Alias: `-same-items-p'."
|
||||||
|
(declare (important-return-value t))
|
||||||
(let (test len1 len2)
|
(let (test len1 len2)
|
||||||
(cond ((null (or list1 list2)))
|
(cond ((null (or list1 list2)))
|
||||||
((null (and list1 list2)) nil)
|
((null (and list1 list2)) nil)
|
||||||
|
@ -3231,6 +3297,7 @@ Alias: `-is-infix-p'"
|
||||||
Return the sorted list. LIST is NOT modified by side effects.
|
Return the sorted list. LIST is NOT modified by side effects.
|
||||||
COMPARATOR is called with two elements of LIST, and should return non-nil
|
COMPARATOR is called with two elements of LIST, and should return non-nil
|
||||||
if the first element should sort before the second."
|
if the first element should sort before the second."
|
||||||
|
(declare (important-return-value t))
|
||||||
(sort (copy-sequence list) comparator))
|
(sort (copy-sequence list) comparator))
|
||||||
|
|
||||||
(defmacro --sort (form list)
|
(defmacro --sort (form list)
|
||||||
|
@ -3254,7 +3321,7 @@ backward compatibility and is otherwise deprecated."
|
||||||
(defun -repeat (n x)
|
(defun -repeat (n x)
|
||||||
"Return a new list of length N with each element being X.
|
"Return a new list of length N with each element being X.
|
||||||
Return nil if N is less than 1."
|
Return nil if N is less than 1."
|
||||||
(declare (pure t) (side-effect-free t))
|
(declare (side-effect-free t))
|
||||||
(and (>= n 0) (make-list n x)))
|
(and (>= n 0) (make-list n x)))
|
||||||
|
|
||||||
(defun -sum (list)
|
(defun -sum (list)
|
||||||
|
@ -3297,6 +3364,7 @@ the greatest element of the list by the comparison function.
|
||||||
|
|
||||||
See also combinator `-on' which can transform the values before
|
See also combinator `-on' which can transform the values before
|
||||||
comparing them."
|
comparing them."
|
||||||
|
(declare (important-return-value t))
|
||||||
(--reduce (if (funcall comparator it acc) it acc) list))
|
(--reduce (if (funcall comparator it acc) it acc) list))
|
||||||
|
|
||||||
(defun -min-by (comparator list)
|
(defun -min-by (comparator list)
|
||||||
|
@ -3305,6 +3373,7 @@ the least element of the list by the comparison function.
|
||||||
|
|
||||||
See also combinator `-on' which can transform the values before
|
See also combinator `-on' which can transform the values before
|
||||||
comparing them."
|
comparing them."
|
||||||
|
(declare (important-return-value t))
|
||||||
(--reduce (if (funcall comparator it acc) acc it) list))
|
(--reduce (if (funcall comparator it acc) acc it) list))
|
||||||
|
|
||||||
(defmacro --max-by (form list)
|
(defmacro --max-by (form list)
|
||||||
|
@ -3327,7 +3396,7 @@ Starts from START and adds STEP each time. The default START is
|
||||||
zero, the default STEP is 1.
|
zero, the default STEP is 1.
|
||||||
This function takes its name from the corresponding primitive in
|
This function takes its name from the corresponding primitive in
|
||||||
the APL language."
|
the APL language."
|
||||||
(declare (pure t) (side-effect-free t))
|
(declare (side-effect-free t))
|
||||||
(unless (natnump count)
|
(unless (natnump count)
|
||||||
(signal 'wrong-type-argument (list #'natnump count)))
|
(signal 'wrong-type-argument (list #'natnump count)))
|
||||||
(or start (setq start 0))
|
(or start (setq start 0))
|
||||||
|
@ -3340,6 +3409,7 @@ the APL language."
|
||||||
"Compute the (least) fixpoint of FN with initial input LIST.
|
"Compute the (least) fixpoint of FN with initial input LIST.
|
||||||
|
|
||||||
FN is called at least once, results are compared with `equal'."
|
FN is called at least once, results are compared with `equal'."
|
||||||
|
(declare (important-return-value t))
|
||||||
(let ((re (funcall fn list)))
|
(let ((re (funcall fn list)))
|
||||||
(while (not (equal list re))
|
(while (not (equal list re))
|
||||||
(setq list re)
|
(setq list re)
|
||||||
|
@ -3361,6 +3431,7 @@ seed value and builds a (potentially infinite!) list.
|
||||||
FUN should return nil to stop the generating process, or a
|
FUN should return nil to stop the generating process, or a
|
||||||
cons (A . B), where A will be prepended to the result and B is
|
cons (A . B), where A will be prepended to the result and B is
|
||||||
the new seed."
|
the new seed."
|
||||||
|
(declare (important-return-value t))
|
||||||
(let ((last (funcall fun seed)) r)
|
(let ((last (funcall fun seed)) r)
|
||||||
(while last
|
(while last
|
||||||
(push (car last) r)
|
(push (car last) r)
|
||||||
|
@ -3407,6 +3478,7 @@ INIT-VALUE. See `-reduce-r-from'.
|
||||||
|
|
||||||
This is the same as calling `-tree-reduce-from' after `-tree-map'
|
This is the same as calling `-tree-reduce-from' after `-tree-map'
|
||||||
but is twice as fast as it only traverse the structure once."
|
but is twice as fast as it only traverse the structure once."
|
||||||
|
(declare (important-return-value t))
|
||||||
(cond
|
(cond
|
||||||
((null tree) ())
|
((null tree) ())
|
||||||
((-cons-pair? tree) (funcall fn tree))
|
((-cons-pair? tree) (funcall fn tree))
|
||||||
|
@ -3434,6 +3506,7 @@ INIT-VALUE. See `-reduce-r-from'.
|
||||||
|
|
||||||
This is the same as calling `-tree-reduce' after `-tree-map'
|
This is the same as calling `-tree-reduce' after `-tree-map'
|
||||||
but is twice as fast as it only traverse the structure once."
|
but is twice as fast as it only traverse the structure once."
|
||||||
|
(declare (important-return-value t))
|
||||||
(cond
|
(cond
|
||||||
((null tree) ())
|
((null tree) ())
|
||||||
((-cons-pair? tree) (funcall fn tree))
|
((-cons-pair? tree) (funcall fn tree))
|
||||||
|
@ -3450,6 +3523,7 @@ but is twice as fast as it only traverse the structure once."
|
||||||
|
|
||||||
(defun -tree-map (fn tree)
|
(defun -tree-map (fn tree)
|
||||||
"Apply FN to each element of TREE while preserving the tree structure."
|
"Apply FN to each element of TREE while preserving the tree structure."
|
||||||
|
(declare (important-return-value t))
|
||||||
(cond
|
(cond
|
||||||
((null tree) ())
|
((null tree) ())
|
||||||
((-cons-pair? tree) (funcall fn tree))
|
((-cons-pair? tree) (funcall fn tree))
|
||||||
|
@ -3471,6 +3545,7 @@ then on this result and second element from the list etc.
|
||||||
|
|
||||||
The initial value is ignored on cons pairs as they always contain
|
The initial value is ignored on cons pairs as they always contain
|
||||||
two elements."
|
two elements."
|
||||||
|
(declare (important-return-value t))
|
||||||
(cond
|
(cond
|
||||||
((null tree) ())
|
((null tree) ())
|
||||||
((-cons-pair? tree) tree)
|
((-cons-pair? tree) tree)
|
||||||
|
@ -3494,6 +3569,7 @@ FN is first applied to first element of the list and second
|
||||||
element, then on this result and third element from the list etc.
|
element, then on this result and third element from the list etc.
|
||||||
|
|
||||||
See `-reduce-r' for how exactly are lists of zero or one element handled."
|
See `-reduce-r' for how exactly are lists of zero or one element handled."
|
||||||
|
(declare (important-return-value t))
|
||||||
(cond
|
(cond
|
||||||
((null tree) ())
|
((null tree) ())
|
||||||
((-cons-pair? tree) tree)
|
((-cons-pair? tree) tree)
|
||||||
|
@ -3534,6 +3610,7 @@ CHILDREN is a function of one argument that returns the children
|
||||||
of the passed branch node.
|
of the passed branch node.
|
||||||
|
|
||||||
Non-branch nodes are simply copied."
|
Non-branch nodes are simply copied."
|
||||||
|
(declare (important-return-value t))
|
||||||
(cons tree
|
(cons tree
|
||||||
(and (funcall branch tree)
|
(and (funcall branch tree)
|
||||||
(-mapcat (lambda (x) (-tree-seq branch children x))
|
(-mapcat (lambda (x) (-tree-seq branch children x))
|
||||||
|
@ -3551,7 +3628,7 @@ Non-branch nodes are simply copied."
|
||||||
The new list has the same elements and structure but all cons are
|
The new list has the same elements and structure but all cons are
|
||||||
replaced with new ones. This is useful when you need to clone a
|
replaced with new ones. This is useful when you need to clone a
|
||||||
structure such as plist or alist."
|
structure such as plist or alist."
|
||||||
(declare (pure t) (side-effect-free t))
|
(declare (side-effect-free t))
|
||||||
(-tree-map #'identity list))
|
(-tree-map #'identity list))
|
||||||
|
|
||||||
;;; Combinators
|
;;; Combinators
|
||||||
|
@ -3741,6 +3818,7 @@ In types: (a -> a) -> Int -> a -> a.
|
||||||
This function satisfies the following law:
|
This function satisfies the following law:
|
||||||
|
|
||||||
(funcall (-iteratefn fn n) init) = (-last-item (-iterate fn init (1+ n)))."
|
(funcall (-iteratefn fn n) init) = (-last-item (-iterate fn init (1+ n)))."
|
||||||
|
(declare (pure t) (side-effect-free error-free))
|
||||||
(lambda (x) (--dotimes n (setq x (funcall fn x))) x))
|
(lambda (x) (--dotimes n (setq x (funcall fn x))) x))
|
||||||
|
|
||||||
(defun -counter (&optional beg end inc)
|
(defun -counter (&optional beg end inc)
|
||||||
|
@ -3752,6 +3830,7 @@ defaults to 0, INC defaults to 1, and if END is nil, the counter
|
||||||
will increment indefinitely.
|
will increment indefinitely.
|
||||||
|
|
||||||
The closure accepts any number of arguments, which are discarded."
|
The closure accepts any number of arguments, which are discarded."
|
||||||
|
(declare (pure t) (side-effect-free error-free))
|
||||||
(let ((inc (or inc 1))
|
(let ((inc (or inc 1))
|
||||||
(n (or beg 0)))
|
(n (or beg 0)))
|
||||||
(lambda (&rest _)
|
(lambda (&rest _)
|
||||||
|
@ -3789,6 +3868,7 @@ iteration halted before converging, a cons with car `halted' and
|
||||||
cdr the final output from HALT-TEST.
|
cdr the final output from HALT-TEST.
|
||||||
|
|
||||||
In types: (a -> a) -> a -> a."
|
In types: (a -> a) -> a -> a."
|
||||||
|
(declare (important-return-value t))
|
||||||
(let ((eqfn (or equal-test 'equal))
|
(let ((eqfn (or equal-test 'equal))
|
||||||
(haltfn (or halt-test
|
(haltfn (or halt-test
|
||||||
(-not
|
(-not
|
|
@ -1037,7 +1037,7 @@ Functions reducing lists to a single value (which may also be a list).
|
||||||
⇒ (nil (1))
|
⇒ (nil (1))
|
||||||
|
|
||||||
-- Function: -tails (list)
|
-- Function: -tails (list)
|
||||||
Return all suffixes of LIST
|
Return all suffixes of LIST.
|
||||||
|
|
||||||
(-tails '(1 2 3 4))
|
(-tails '(1 2 3 4))
|
||||||
⇒ ((1 2 3 4) (2 3 4) (3 4) (4) nil)
|
⇒ ((1 2 3 4) (2 3 4) (3 4) (4) nil)
|
||||||
|
@ -2222,9 +2222,9 @@ Other list functions not fit to be classified elsewhere.
|
||||||
called with two elements of LIST, and should return non-‘nil’ if
|
called with two elements of LIST, and should return non-‘nil’ if
|
||||||
the first element should sort before the second.
|
the first element should sort before the second.
|
||||||
|
|
||||||
(-sort '< '(3 1 2))
|
(-sort #'< '(3 1 2))
|
||||||
⇒ (1 2 3)
|
⇒ (1 2 3)
|
||||||
(-sort '> '(3 1 2))
|
(-sort #'> '(3 1 2))
|
||||||
⇒ (3 2 1)
|
⇒ (3 2 1)
|
||||||
(--sort (< it other) '(3 1 2))
|
(--sort (< it other) '(3 1 2))
|
||||||
⇒ (1 2 3)
|
⇒ (1 2 3)
|
||||||
|
@ -2384,8 +2384,8 @@ Functions pretending lists are trees.
|
||||||
structure but all cons are replaced with new ones. This is useful
|
structure but all cons are replaced with new ones. This is useful
|
||||||
when you need to clone a structure such as plist or alist.
|
when you need to clone a structure such as plist or alist.
|
||||||
|
|
||||||
(let* ((a '(1 2 3)) (b (-clone a))) (nreverse a) b)
|
(let* ((a (list (list 1))) (b (-clone a))) (setcar (car a) 2) b)
|
||||||
⇒ (1 2 3)
|
⇒ ((1))
|
||||||
|
|
||||||
|
|
||||||
File: dash.info, Node: Threading macros, Next: Binding, Prev: Tree operations, Up: Functions
|
File: dash.info, Node: Threading macros, Next: Binding, Prev: Tree operations, Up: Functions
|
||||||
|
@ -4792,153 +4792,153 @@ Ref: -product35429
|
||||||
Ref: -running-product35637
|
Ref: -running-product35637
|
||||||
Ref: -inits35978
|
Ref: -inits35978
|
||||||
Ref: -tails36223
|
Ref: -tails36223
|
||||||
Ref: -common-prefix36467
|
Ref: -common-prefix36468
|
||||||
Ref: -common-suffix36761
|
Ref: -common-suffix36762
|
||||||
Ref: -min37055
|
Ref: -min37056
|
||||||
Ref: -min-by37281
|
Ref: -min-by37282
|
||||||
Ref: -max37802
|
Ref: -max37803
|
||||||
Ref: -max-by38027
|
Ref: -max-by38028
|
||||||
Ref: -frequencies38553
|
Ref: -frequencies38554
|
||||||
Node: Unfolding39168
|
Node: Unfolding39169
|
||||||
Ref: -iterate39409
|
Ref: -iterate39410
|
||||||
Ref: -unfold39856
|
Ref: -unfold39857
|
||||||
Ref: -repeat40661
|
Ref: -repeat40662
|
||||||
Ref: -cycle40945
|
Ref: -cycle40946
|
||||||
Node: Predicates41342
|
Node: Predicates41343
|
||||||
Ref: -some41519
|
Ref: -some41520
|
||||||
Ref: -every41948
|
Ref: -every41949
|
||||||
Ref: -any?42662
|
Ref: -any?42663
|
||||||
Ref: -all?43011
|
Ref: -all?43012
|
||||||
Ref: -none?43753
|
Ref: -none?43754
|
||||||
Ref: -only-some?44073
|
Ref: -only-some?44074
|
||||||
Ref: -contains?44618
|
Ref: -contains?44619
|
||||||
Ref: -is-prefix?45124
|
Ref: -is-prefix?45125
|
||||||
Ref: -is-suffix?45456
|
Ref: -is-suffix?45457
|
||||||
Ref: -is-infix?45788
|
Ref: -is-infix?45789
|
||||||
Ref: -cons-pair?46148
|
Ref: -cons-pair?46149
|
||||||
Node: Partitioning46479
|
Node: Partitioning46480
|
||||||
Ref: -split-at46667
|
Ref: -split-at46668
|
||||||
Ref: -split-with47331
|
Ref: -split-with47332
|
||||||
Ref: -split-on47971
|
Ref: -split-on47972
|
||||||
Ref: -split-when48642
|
Ref: -split-when48643
|
||||||
Ref: -separate49285
|
Ref: -separate49286
|
||||||
Ref: -partition49819
|
Ref: -partition49820
|
||||||
Ref: -partition-all50268
|
Ref: -partition-all50269
|
||||||
Ref: -partition-in-steps50693
|
Ref: -partition-in-steps50694
|
||||||
Ref: -partition-all-in-steps51239
|
Ref: -partition-all-in-steps51240
|
||||||
Ref: -partition-by51753
|
Ref: -partition-by51754
|
||||||
Ref: -partition-by-header52131
|
Ref: -partition-by-header52132
|
||||||
Ref: -partition-after-pred52732
|
Ref: -partition-after-pred52733
|
||||||
Ref: -partition-before-pred53185
|
Ref: -partition-before-pred53186
|
||||||
Ref: -partition-before-item53570
|
Ref: -partition-before-item53571
|
||||||
Ref: -partition-after-item53877
|
Ref: -partition-after-item53878
|
||||||
Ref: -group-by54179
|
Ref: -group-by54180
|
||||||
Node: Indexing54612
|
Node: Indexing54613
|
||||||
Ref: -elem-index54814
|
Ref: -elem-index54815
|
||||||
Ref: -elem-indices55301
|
Ref: -elem-indices55302
|
||||||
Ref: -find-index55760
|
Ref: -find-index55761
|
||||||
Ref: -find-last-index56429
|
Ref: -find-last-index56430
|
||||||
Ref: -find-indices57080
|
Ref: -find-indices57081
|
||||||
Ref: -grade-up57842
|
Ref: -grade-up57843
|
||||||
Ref: -grade-down58249
|
Ref: -grade-down58250
|
||||||
Node: Set operations58663
|
Node: Set operations58664
|
||||||
Ref: -union58846
|
Ref: -union58847
|
||||||
Ref: -difference59276
|
Ref: -difference59277
|
||||||
Ref: -intersection59704
|
Ref: -intersection59705
|
||||||
Ref: -powerset60133
|
Ref: -powerset60134
|
||||||
Ref: -permutations60410
|
Ref: -permutations60411
|
||||||
Ref: -distinct60848
|
Ref: -distinct60849
|
||||||
Ref: -same-items?61242
|
Ref: -same-items?61243
|
||||||
Node: Other list operations61851
|
Node: Other list operations61852
|
||||||
Ref: -rotate62076
|
Ref: -rotate62077
|
||||||
Ref: -cons*62429
|
Ref: -cons*62430
|
||||||
Ref: -snoc62851
|
Ref: -snoc62852
|
||||||
Ref: -interpose63263
|
Ref: -interpose63264
|
||||||
Ref: -interleave63557
|
Ref: -interleave63558
|
||||||
Ref: -iota63923
|
Ref: -iota63924
|
||||||
Ref: -zip-with64406
|
Ref: -zip-with64407
|
||||||
Ref: -zip-pair65214
|
Ref: -zip-pair65215
|
||||||
Ref: -zip-lists65780
|
Ref: -zip-lists65781
|
||||||
Ref: -zip-lists-fill66578
|
Ref: -zip-lists-fill66579
|
||||||
Ref: -zip67288
|
Ref: -zip67289
|
||||||
Ref: -zip-fill68315
|
Ref: -zip-fill68316
|
||||||
Ref: -unzip-lists69229
|
Ref: -unzip-lists69230
|
||||||
Ref: -unzip69852
|
Ref: -unzip69853
|
||||||
Ref: -pad70845
|
Ref: -pad70846
|
||||||
Ref: -table71330
|
Ref: -table71331
|
||||||
Ref: -table-flat72116
|
Ref: -table-flat72117
|
||||||
Ref: -first73121
|
Ref: -first73122
|
||||||
Ref: -last73654
|
Ref: -last73655
|
||||||
Ref: -first-item74000
|
Ref: -first-item74001
|
||||||
Ref: -second-item74412
|
Ref: -second-item74413
|
||||||
Ref: -third-item74829
|
Ref: -third-item74830
|
||||||
Ref: -fourth-item75204
|
Ref: -fourth-item75205
|
||||||
Ref: -fifth-item75582
|
Ref: -fifth-item75583
|
||||||
Ref: -last-item75957
|
Ref: -last-item75958
|
||||||
Ref: -butlast76318
|
Ref: -butlast76319
|
||||||
Ref: -sort76563
|
Ref: -sort76564
|
||||||
Ref: -list77055
|
Ref: -list77058
|
||||||
Ref: -fix77624
|
Ref: -fix77627
|
||||||
Node: Tree operations78113
|
Node: Tree operations78116
|
||||||
Ref: -tree-seq78309
|
Ref: -tree-seq78312
|
||||||
Ref: -tree-map79170
|
Ref: -tree-map79173
|
||||||
Ref: -tree-map-nodes79610
|
Ref: -tree-map-nodes79613
|
||||||
Ref: -tree-reduce80474
|
Ref: -tree-reduce80477
|
||||||
Ref: -tree-reduce-from81356
|
Ref: -tree-reduce-from81359
|
||||||
Ref: -tree-mapreduce81956
|
Ref: -tree-mapreduce81959
|
||||||
Ref: -tree-mapreduce-from82815
|
Ref: -tree-mapreduce-from82818
|
||||||
Ref: -clone84100
|
Ref: -clone84103
|
||||||
Node: Threading macros84427
|
Node: Threading macros84441
|
||||||
Ref: ->84652
|
Ref: ->84666
|
||||||
Ref: ->>85140
|
Ref: ->>85154
|
||||||
Ref: -->85643
|
Ref: -->85657
|
||||||
Ref: -as->86199
|
Ref: -as->86213
|
||||||
Ref: -some->86653
|
Ref: -some->86667
|
||||||
Ref: -some->>87038
|
Ref: -some->>87052
|
||||||
Ref: -some-->87485
|
Ref: -some-->87499
|
||||||
Ref: -doto88052
|
Ref: -doto88066
|
||||||
Node: Binding88605
|
Node: Binding88619
|
||||||
Ref: -when-let88812
|
Ref: -when-let88826
|
||||||
Ref: -when-let*89273
|
Ref: -when-let*89287
|
||||||
Ref: -if-let89802
|
Ref: -if-let89816
|
||||||
Ref: -if-let*90168
|
Ref: -if-let*90182
|
||||||
Ref: -let90791
|
Ref: -let90805
|
||||||
Ref: -let*96881
|
Ref: -let*96895
|
||||||
Ref: -lambda97818
|
Ref: -lambda97832
|
||||||
Ref: -setq98624
|
Ref: -setq98638
|
||||||
Node: Side effects99425
|
Node: Side effects99439
|
||||||
Ref: -each99619
|
Ref: -each99633
|
||||||
Ref: -each-while100146
|
Ref: -each-while100160
|
||||||
Ref: -each-indexed100766
|
Ref: -each-indexed100780
|
||||||
Ref: -each-r101358
|
Ref: -each-r101372
|
||||||
Ref: -each-r-while101800
|
Ref: -each-r-while101814
|
||||||
Ref: -dotimes102444
|
Ref: -dotimes102458
|
||||||
Node: Destructive operations102997
|
Node: Destructive operations103011
|
||||||
Ref: !cons103215
|
Ref: !cons103229
|
||||||
Ref: !cdr103419
|
Ref: !cdr103433
|
||||||
Node: Function combinators103612
|
Node: Function combinators103626
|
||||||
Ref: -partial103816
|
Ref: -partial103830
|
||||||
Ref: -rpartial104334
|
Ref: -rpartial104348
|
||||||
Ref: -juxt104982
|
Ref: -juxt104996
|
||||||
Ref: -compose105434
|
Ref: -compose105448
|
||||||
Ref: -applify106041
|
Ref: -applify106055
|
||||||
Ref: -on106471
|
Ref: -on106485
|
||||||
Ref: -flip107243
|
Ref: -flip107257
|
||||||
Ref: -rotate-args107767
|
Ref: -rotate-args107781
|
||||||
Ref: -const108396
|
Ref: -const108410
|
||||||
Ref: -cut108738
|
Ref: -cut108752
|
||||||
Ref: -not109218
|
Ref: -not109232
|
||||||
Ref: -orfn109762
|
Ref: -orfn109776
|
||||||
Ref: -andfn110555
|
Ref: -andfn110569
|
||||||
Ref: -iteratefn111342
|
Ref: -iteratefn111356
|
||||||
Ref: -fixfn112044
|
Ref: -fixfn112058
|
||||||
Ref: -prodfn113618
|
Ref: -prodfn113632
|
||||||
Node: Development114769
|
Node: Development114783
|
||||||
Node: Contribute115058
|
Node: Contribute115072
|
||||||
Node: Contributors116070
|
Node: Contributors116084
|
||||||
Node: FDL118163
|
Node: FDL118177
|
||||||
Node: GPL143483
|
Node: GPL143497
|
||||||
Node: Index181232
|
Node: Index181246
|
||||||
|
|
||||||
End Tag Table
|
End Tag Table
|
||||||
|
|
8
code/elpa/dashboard-20230726.2018/banners/1.txt
Normal file
8
code/elpa/dashboard-20230726.2018/banners/1.txt
Normal file
|
@ -0,0 +1,8 @@
|
||||||
|
|
||||||
|
######## ## ## ### ###### ######
|
||||||
|
## ### ### ## ## ## ## ## ##
|
||||||
|
## #### #### ## ## ## ##
|
||||||
|
###### ## ### ## ## ## ## ######
|
||||||
|
## ## ## ######### ## ##
|
||||||
|
## ## ## ## ## ## ## ## ##
|
||||||
|
######## ## ## ## ## ###### ######
|
6
code/elpa/dashboard-20230726.2018/banners/2.txt
Normal file
6
code/elpa/dashboard-20230726.2018/banners/2.txt
Normal file
|
@ -0,0 +1,6 @@
|
||||||
|
_______ .___ ___. ___ ______ _______.
|
||||||
|
| ____|| \/ | / \ / | / |
|
||||||
|
| |__ | \ / | / ^ \ | ,----' | (----`
|
||||||
|
| __| | |\/| | / /_\ \ | | \ \
|
||||||
|
| |____ | | | | / _____ \ | `----.----) |
|
||||||
|
|_______||__| |__| /__/ \__\ \______|_______/
|
8
code/elpa/dashboard-20230726.2018/banners/3.txt
Normal file
8
code/elpa/dashboard-20230726.2018/banners/3.txt
Normal file
|
@ -0,0 +1,8 @@
|
||||||
|
_______ _____ ______ ________ ________ ________
|
||||||
|
|\ ___ \ |\ _ \ _ \|\ __ \|\ ____\|\ ____\
|
||||||
|
\ \ __/|\ \ \\\__\ \ \ \ \|\ \ \ \___|\ \ \___|_
|
||||||
|
\ \ \_|/_\ \ \\|__| \ \ \ __ \ \ \ \ \_____ \
|
||||||
|
\ \ \_|\ \ \ \ \ \ \ \ \ \ \ \ \____\|____|\ \
|
||||||
|
\ \_______\ \__\ \ \__\ \__\ \__\ \_______\____\_\ \
|
||||||
|
\|_______|\|__| \|__|\|__|\|__|\|_______|\_________\
|
||||||
|
\|_________|
|
17
code/elpa/dashboard-20230726.2018/banners/4.txt
Normal file
17
code/elpa/dashboard-20230726.2018/banners/4.txt
Normal file
|
@ -0,0 +1,17 @@
|
||||||
|
_ ___ _ _
|
||||||
|
_ ___ __ ___ __ _ ___
|
||||||
|
__ _ ___ __ ___
|
||||||
|
_ ___ _
|
||||||
|
_ _ __ _
|
||||||
|
___ __ _
|
||||||
|
__ _
|
||||||
|
_ _ _
|
||||||
|
_ _ _
|
||||||
|
_ _ _
|
||||||
|
__ ___
|
||||||
|
_ _ _ _
|
||||||
|
_ _
|
||||||
|
_ _
|
||||||
|
_ _
|
||||||
|
_
|
||||||
|
__
|
BIN
code/elpa/dashboard-20230726.2018/banners/emacs.png
Normal file
BIN
code/elpa/dashboard-20230726.2018/banners/emacs.png
Normal file
Binary file not shown.
After Width: | Height: | Size: 43 KiB |
BIN
code/elpa/dashboard-20230726.2018/banners/logo.png
Normal file
BIN
code/elpa/dashboard-20230726.2018/banners/logo.png
Normal file
Binary file not shown.
After Width: | Height: | Size: 32 KiB |
44
code/elpa/dashboard-20230726.2018/dashboard-autoloads.el
Normal file
44
code/elpa/dashboard-20230726.2018/dashboard-autoloads.el
Normal file
|
@ -0,0 +1,44 @@
|
||||||
|
;;; dashboard-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*-
|
||||||
|
;;
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
(add-to-list 'load-path (directory-file-name
|
||||||
|
(or (file-name-directory #$) (car load-path))))
|
||||||
|
|
||||||
|
|
||||||
|
;;;### (autoloads nil "dashboard" "dashboard.el" (0 0 0 0))
|
||||||
|
;;; Generated autoloads from dashboard.el
|
||||||
|
|
||||||
|
(autoload 'dashboard-open "dashboard" "\
|
||||||
|
Open (or refresh) the *dashboard* buffer.
|
||||||
|
|
||||||
|
\(fn &rest _)" t nil)
|
||||||
|
|
||||||
|
(autoload 'dashboard-setup-startup-hook "dashboard" "\
|
||||||
|
Setup post initialization hooks.
|
||||||
|
If a command line argument is provided, assume a filename and skip displaying
|
||||||
|
Dashboard." nil nil)
|
||||||
|
|
||||||
|
(register-definition-prefixes "dashboard" '("dashboard-"))
|
||||||
|
|
||||||
|
;;;***
|
||||||
|
|
||||||
|
;;;### (autoloads nil "dashboard-widgets" "dashboard-widgets.el"
|
||||||
|
;;;;;; (0 0 0 0))
|
||||||
|
;;; Generated autoloads from dashboard-widgets.el
|
||||||
|
|
||||||
|
(register-definition-prefixes "dashboard-widgets" '("dashboard-" "org-time-less-p" "recentf-list"))
|
||||||
|
|
||||||
|
;;;***
|
||||||
|
|
||||||
|
;;;### (autoloads nil nil ("dashboard-pkg.el") (0 0 0 0))
|
||||||
|
|
||||||
|
;;;***
|
||||||
|
|
||||||
|
;; Local Variables:
|
||||||
|
;; version-control: never
|
||||||
|
;; no-byte-compile: t
|
||||||
|
;; no-update-autoloads: t
|
||||||
|
;; coding: utf-8
|
||||||
|
;; End:
|
||||||
|
;;; dashboard-autoloads.el ends here
|
14
code/elpa/dashboard-20230726.2018/dashboard-pkg.el
Normal file
14
code/elpa/dashboard-20230726.2018/dashboard-pkg.el
Normal file
|
@ -0,0 +1,14 @@
|
||||||
|
(define-package "dashboard" "20230726.2018" "A startup screen extracted from Spacemacs"
|
||||||
|
'((emacs "26.1"))
|
||||||
|
:commit "6480e0797b41c8ce1de4f37ba8016d177c22ab04" :authors
|
||||||
|
'(("Rakan Al-Hneiti" . "rakan.alhneiti@gmail.com"))
|
||||||
|
:maintainers
|
||||||
|
'(("Jesús Martínez" . "jesusmartinez93@gmail.com"))
|
||||||
|
:maintainer
|
||||||
|
'("Jesús Martínez" . "jesusmartinez93@gmail.com")
|
||||||
|
:keywords
|
||||||
|
'("startup" "screen" "tools" "dashboard")
|
||||||
|
:url "https://github.com/emacs-dashboard/emacs-dashboard")
|
||||||
|
;; Local Variables:
|
||||||
|
;; no-byte-compile: t
|
||||||
|
;; End:
|
1500
code/elpa/dashboard-20230726.2018/dashboard-widgets.el
Normal file
1500
code/elpa/dashboard-20230726.2018/dashboard-widgets.el
Normal file
File diff suppressed because it is too large
Load diff
485
code/elpa/dashboard-20230726.2018/dashboard.el
Normal file
485
code/elpa/dashboard-20230726.2018/dashboard.el
Normal file
|
@ -0,0 +1,485 @@
|
||||||
|
;;; dashboard.el --- A startup screen extracted from Spacemacs -*- lexical-binding: t -*-
|
||||||
|
|
||||||
|
;; Copyright (c) 2016-2023 emacs-dashboard maintainers
|
||||||
|
;;
|
||||||
|
;; Author : Rakan Al-Hneiti <rakan.alhneiti@gmail.com>
|
||||||
|
;; Maintainer : Jesús Martínez <jesusmartinez93@gmail.com>
|
||||||
|
;; Shen, Jen-Chieh <jcs090218@gmail.com>
|
||||||
|
;; URL : https://github.com/emacs-dashboard/emacs-dashboard
|
||||||
|
;;
|
||||||
|
;; This file is not part of GNU Emacs.
|
||||||
|
;;
|
||||||
|
;;; License: GPLv3
|
||||||
|
;;
|
||||||
|
;; Created: October 05, 2016
|
||||||
|
;; Package-Version: 1.9.0-SNAPSHOT
|
||||||
|
;; Keywords: startup, screen, tools, dashboard
|
||||||
|
;; Package-Requires: ((emacs "26.1"))
|
||||||
|
;;; Commentary:
|
||||||
|
|
||||||
|
;; An extensible Emacs dashboard, with sections for
|
||||||
|
;; bookmarks, projects (projectile or project.el), org-agenda and more.
|
||||||
|
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
(require 'ffap)
|
||||||
|
(require 'recentf)
|
||||||
|
|
||||||
|
(require 'dashboard-widgets)
|
||||||
|
|
||||||
|
(declare-function bookmark-get-filename "ext:bookmark.el")
|
||||||
|
(declare-function bookmark-all-names "ext:bookmark.el")
|
||||||
|
(declare-function dashboard-ls--dirs "ext:dashboard-ls.el")
|
||||||
|
(declare-function dashboard-ls--files "ext:dashboard-ls.el")
|
||||||
|
(declare-function page-break-lines-mode "ext:page-break-lines.el")
|
||||||
|
(declare-function projectile-remove-known-project "ext:projectile.el")
|
||||||
|
(declare-function project-forget-projects-under "ext:project.el")
|
||||||
|
(declare-function linum-mode "linum.el")
|
||||||
|
|
||||||
|
(declare-function dashboard-refresh-buffer "dashboard.el")
|
||||||
|
|
||||||
|
(defgroup dashboard nil
|
||||||
|
"Extensible startup screen."
|
||||||
|
:group 'applications)
|
||||||
|
|
||||||
|
;; Custom splash screen
|
||||||
|
(defvar dashboard-mode-map
|
||||||
|
(let ((map (make-sparse-keymap)))
|
||||||
|
(define-key map (kbd "C-p") 'dashboard-previous-line)
|
||||||
|
(define-key map (kbd "C-n") 'dashboard-next-line)
|
||||||
|
(define-key map (kbd "<up>") 'dashboard-previous-line)
|
||||||
|
(define-key map (kbd "<down>") 'dashboard-next-line)
|
||||||
|
(define-key map (kbd "k") 'dashboard-previous-line)
|
||||||
|
(define-key map (kbd "j") 'dashboard-next-line)
|
||||||
|
(define-key map [tab] 'widget-forward)
|
||||||
|
(define-key map (kbd "C-i") 'widget-forward)
|
||||||
|
(define-key map [backtab] 'widget-backward)
|
||||||
|
(define-key map (kbd "RET") 'dashboard-return)
|
||||||
|
(define-key map [mouse-1] 'dashboard-mouse-1)
|
||||||
|
(define-key map (kbd "}") #'dashboard-next-section)
|
||||||
|
(define-key map (kbd "{") #'dashboard-previous-section)
|
||||||
|
|
||||||
|
(define-key map (kbd "<backspace>") #'dashboard-remove-item-under)
|
||||||
|
(define-key map (kbd "<delete>") #'dashboard-remove-item-under)
|
||||||
|
(define-key map (kbd "DEL") #'dashboard-remove-item-under)
|
||||||
|
|
||||||
|
(define-key map (kbd "1") #'dashboard-section-1)
|
||||||
|
(define-key map (kbd "2") #'dashboard-section-2)
|
||||||
|
(define-key map (kbd "3") #'dashboard-section-3)
|
||||||
|
(define-key map (kbd "4") #'dashboard-section-4)
|
||||||
|
(define-key map (kbd "5") #'dashboard-section-5)
|
||||||
|
(define-key map (kbd "6") #'dashboard-section-6)
|
||||||
|
(define-key map (kbd "7") #'dashboard-section-7)
|
||||||
|
(define-key map (kbd "8") #'dashboard-section-8)
|
||||||
|
(define-key map (kbd "9") #'dashboard-section-9)
|
||||||
|
map)
|
||||||
|
"Keymap for dashboard mode.")
|
||||||
|
|
||||||
|
(defcustom dashboard-after-initialize-hook nil
|
||||||
|
"Hook that is run after dashboard buffer is initialized."
|
||||||
|
:group 'dashboard
|
||||||
|
:type 'hook)
|
||||||
|
|
||||||
|
(define-derived-mode dashboard-mode special-mode "Dashboard"
|
||||||
|
"Dashboard major mode for startup screen."
|
||||||
|
:group 'dashboard
|
||||||
|
:syntax-table nil
|
||||||
|
:abbrev-table nil
|
||||||
|
(buffer-disable-undo)
|
||||||
|
(when (featurep 'whitespace) (whitespace-mode -1))
|
||||||
|
(when (featurep 'linum) (linum-mode -1))
|
||||||
|
(when (featurep 'display-line-numbers) (display-line-numbers-mode -1))
|
||||||
|
(when (featurep 'page-break-lines) (page-break-lines-mode 1))
|
||||||
|
(setq-local revert-buffer-function #'dashboard-refresh-buffer)
|
||||||
|
(setq inhibit-startup-screen t
|
||||||
|
buffer-read-only t
|
||||||
|
truncate-lines t))
|
||||||
|
|
||||||
|
(defcustom dashboard-center-content nil
|
||||||
|
"Whether to center content within the window."
|
||||||
|
:type 'boolean
|
||||||
|
:group 'dashboard)
|
||||||
|
|
||||||
|
(defconst dashboard-buffer-name "*dashboard*"
|
||||||
|
"Dashboard's buffer name.")
|
||||||
|
|
||||||
|
(defvar dashboard-force-refresh nil
|
||||||
|
"If non-nil, force refresh dashboard buffer.")
|
||||||
|
|
||||||
|
(defvar dashboard--section-starts nil
|
||||||
|
"List of section starting positions.")
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; Util
|
||||||
|
;;
|
||||||
|
(defun dashboard--goto-line (line)
|
||||||
|
"Goto LINE."
|
||||||
|
(goto-char (point-min)) (forward-line (1- line)))
|
||||||
|
|
||||||
|
(defmacro dashboard--save-excursion (&rest body)
|
||||||
|
"Execute BODY save window point."
|
||||||
|
(declare (indent 0) (debug t))
|
||||||
|
`(let ((line (line-number-at-pos nil t))
|
||||||
|
(column (current-column)))
|
||||||
|
,@body
|
||||||
|
(dashboard--goto-line line)
|
||||||
|
(move-to-column column)))
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; Core
|
||||||
|
;;
|
||||||
|
(defun dashboard--current-section ()
|
||||||
|
"Return section symbol in dashboard."
|
||||||
|
(save-excursion
|
||||||
|
(if (and (search-backward dashboard-page-separator nil t)
|
||||||
|
(search-forward dashboard-page-separator nil t))
|
||||||
|
(let ((ln (thing-at-point 'line)))
|
||||||
|
(cond ((string-match-p "Recent Files:" ln) 'recents)
|
||||||
|
((string-match-p "Bookmarks:" ln) 'bookmarks)
|
||||||
|
((string-match-p "Projects:" ln) 'projects)
|
||||||
|
((string-match-p "Agenda for " ln) 'agenda)
|
||||||
|
((string-match-p "Registers:" ln) 'registers)
|
||||||
|
((string-match-p "List Directories:" ln) 'ls-directories)
|
||||||
|
((string-match-p "List Files:" ln) 'ls-files)
|
||||||
|
(t (user-error "Unknown section from dashboard"))))
|
||||||
|
(user-error "Failed searching dashboard section"))))
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; Navigation
|
||||||
|
;;
|
||||||
|
(defun dashboard-previous-section ()
|
||||||
|
"Navigate back to previous section."
|
||||||
|
(interactive)
|
||||||
|
(let ((current-position (point)) current-section-start previous-section-start)
|
||||||
|
(dolist (elt dashboard--section-starts)
|
||||||
|
(when (and current-section-start (not previous-section-start))
|
||||||
|
(setq previous-section-start elt))
|
||||||
|
(when (and (not current-section-start) (< elt current-position))
|
||||||
|
(setq current-section-start elt)))
|
||||||
|
(goto-char (if (eq current-position current-section-start)
|
||||||
|
previous-section-start
|
||||||
|
current-section-start))))
|
||||||
|
|
||||||
|
(defun dashboard-next-section ()
|
||||||
|
"Navigate forward to next section."
|
||||||
|
(interactive)
|
||||||
|
(let ((current-position (point)) next-section-start
|
||||||
|
(section-starts (reverse dashboard--section-starts)))
|
||||||
|
(dolist (elt section-starts)
|
||||||
|
(when (and (not next-section-start)
|
||||||
|
(> elt current-position))
|
||||||
|
(setq next-section-start elt)))
|
||||||
|
(when next-section-start
|
||||||
|
(goto-char next-section-start))))
|
||||||
|
|
||||||
|
(defun dashboard--section-lines ()
|
||||||
|
"Return a list of integer represent the starting line number of each section."
|
||||||
|
(let (pb-lst)
|
||||||
|
(save-excursion
|
||||||
|
(goto-char (point-min))
|
||||||
|
(while (search-forward dashboard-page-separator nil t)
|
||||||
|
(when (ignore-errors (dashboard--current-section))
|
||||||
|
(push (line-number-at-pos) pb-lst))))
|
||||||
|
(setq pb-lst (reverse pb-lst))
|
||||||
|
pb-lst))
|
||||||
|
|
||||||
|
(defun dashboard--goto-section-by-index (index)
|
||||||
|
"Navigate to item section by INDEX."
|
||||||
|
(let* ((pg-lst (dashboard--section-lines))
|
||||||
|
(items-id (1- index))
|
||||||
|
(items-pg (nth items-id pg-lst))
|
||||||
|
(items-len (length pg-lst)))
|
||||||
|
(when (and items-pg (< items-id items-len))
|
||||||
|
(dashboard--goto-line items-pg))))
|
||||||
|
|
||||||
|
(defun dashboard-section-1 ()
|
||||||
|
"Navigate to section 1." (interactive) (dashboard--goto-section-by-index 1))
|
||||||
|
(defun dashboard-section-2 ()
|
||||||
|
"Navigate to section 2." (interactive) (dashboard--goto-section-by-index 2))
|
||||||
|
(defun dashboard-section-3 ()
|
||||||
|
"Navigate to section 3." (interactive) (dashboard--goto-section-by-index 3))
|
||||||
|
(defun dashboard-section-4 ()
|
||||||
|
"Navigate to section 4." (interactive) (dashboard--goto-section-by-index 4))
|
||||||
|
(defun dashboard-section-5 ()
|
||||||
|
"Navigate to section 5." (interactive) (dashboard--goto-section-by-index 5))
|
||||||
|
(defun dashboard-section-6 ()
|
||||||
|
"Navigate to section 6." (interactive) (dashboard--goto-section-by-index 6))
|
||||||
|
(defun dashboard-section-7 ()
|
||||||
|
"Navigate to section 7." (interactive) (dashboard--goto-section-by-index 7))
|
||||||
|
(defun dashboard-section-8 ()
|
||||||
|
"Navigate to section 8." (interactive) (dashboard--goto-section-by-index 8))
|
||||||
|
(defun dashboard-section-9 ()
|
||||||
|
"Navigate to section 9." (interactive) (dashboard--goto-section-by-index 9))
|
||||||
|
|
||||||
|
(defun dashboard-previous-line (arg)
|
||||||
|
"Move point up and position it at that line’s item.
|
||||||
|
Optional prefix ARG says how many lines to move; default is one line."
|
||||||
|
(interactive "^p")
|
||||||
|
(dashboard-next-line (- arg)))
|
||||||
|
|
||||||
|
(defun dashboard-next-line (arg)
|
||||||
|
"Move point down and position it at that line’s item.
|
||||||
|
Optional prefix ARG says how many lines to move; default is one line."
|
||||||
|
;; code heavily inspired by `dired-next-line'
|
||||||
|
(interactive "^p")
|
||||||
|
(let (line-move-visual goal-column)
|
||||||
|
(line-move arg t))
|
||||||
|
;; We never want to move point into an invisible line. Dashboard doesn’t
|
||||||
|
;; use invisible text currently but when it does we’re ready!
|
||||||
|
(while (and (invisible-p (point))
|
||||||
|
(not (if (and arg (< arg 0)) (bobp) (eobp))))
|
||||||
|
(forward-char (if (and arg (< arg 0)) -1 1)))
|
||||||
|
(beginning-of-line-text))
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; ffap
|
||||||
|
;;
|
||||||
|
(defun dashboard--goto-section (section)
|
||||||
|
"Move to SECTION declares in variable `dashboard-item-shortcuts'."
|
||||||
|
(let ((fnc (intern (format "dashboard-jump-to-%s" section))))
|
||||||
|
(dashboard-funcall-fboundp fnc)))
|
||||||
|
|
||||||
|
(defun dashboard--current-index (section &optional pos)
|
||||||
|
"Return the idex by SECTION from POS."
|
||||||
|
(let (target-ln section-line)
|
||||||
|
(save-excursion
|
||||||
|
(when pos (goto-char pos))
|
||||||
|
(setq target-ln (line-number-at-pos))
|
||||||
|
(dashboard--goto-section section)
|
||||||
|
(setq section-line (line-number-at-pos)))
|
||||||
|
(- target-ln section-line)))
|
||||||
|
|
||||||
|
(defun dashboard--section-list (section)
|
||||||
|
"Return the list from SECTION."
|
||||||
|
(cl-case section
|
||||||
|
(`recents recentf-list)
|
||||||
|
(`bookmarks (bookmark-all-names))
|
||||||
|
(`projects (dashboard-projects-backend-load-projects))
|
||||||
|
(`ls-directories (dashboard-ls--dirs))
|
||||||
|
(`ls-files (dashboard-ls--files))
|
||||||
|
(t (user-error "Unknown section for search: %s" section))))
|
||||||
|
|
||||||
|
(defun dashboard--current-item-in-path ()
|
||||||
|
"Return the path from current dashboard section in path."
|
||||||
|
(let ((section (dashboard--current-section)) path)
|
||||||
|
(cl-case section
|
||||||
|
(`bookmarks (setq path (bookmark-get-filename path)))
|
||||||
|
(t
|
||||||
|
(let ((lst (dashboard--section-list section))
|
||||||
|
(index (dashboard--current-index section)))
|
||||||
|
(setq path (nth index lst)))))
|
||||||
|
path))
|
||||||
|
|
||||||
|
(defun dashboard--on-path-item-p ()
|
||||||
|
"Return non-nil if current point is on the item path from dashboard."
|
||||||
|
(save-excursion
|
||||||
|
(when (= (point) (line-end-position)) (ignore-errors (forward-char -1)))
|
||||||
|
(eq (get-char-property (point) 'face) 'dashboard-items-face)))
|
||||||
|
|
||||||
|
(defun dashboard--ffap-guesser--adv (fnc &rest args)
|
||||||
|
"Advice execution around function `ffap-guesser'.
|
||||||
|
|
||||||
|
Argument FNC is the adviced function.
|
||||||
|
Optional argument ARGS adviced function arguments."
|
||||||
|
(cl-case major-mode
|
||||||
|
(`dashboard-mode
|
||||||
|
(or (and (dashboard--on-path-item-p)
|
||||||
|
(dashboard--current-item-in-path))
|
||||||
|
(apply fnc args))) ; fallback
|
||||||
|
(t (apply fnc args))))
|
||||||
|
(advice-add 'ffap-guesser :around #'dashboard--ffap-guesser--adv)
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; Removal
|
||||||
|
;;
|
||||||
|
(defun dashboard-remove-item-under ()
|
||||||
|
"Remove a item from the current item section."
|
||||||
|
(interactive)
|
||||||
|
(cl-case (dashboard--current-section)
|
||||||
|
(`recents (dashboard-remove-item-recentf))
|
||||||
|
(`bookmarks (dashboard-remove-item-bookmarks))
|
||||||
|
(`projects (dashboard-remove-item-projects))
|
||||||
|
(`agenda (dashboard-remove-item-agenda))
|
||||||
|
(`registers (dashboard-remove-item-registers)))
|
||||||
|
(dashboard--save-excursion (dashboard-refresh-buffer)))
|
||||||
|
|
||||||
|
(defun dashboard-remove-item-recentf ()
|
||||||
|
"Remove a file from `recentf-list'."
|
||||||
|
(interactive)
|
||||||
|
(let ((path (save-excursion (end-of-line) (ffap-guesser))))
|
||||||
|
(setq recentf-list (delete path recentf-list)))
|
||||||
|
(dashboard-mute-apply (recentf-save-list)))
|
||||||
|
|
||||||
|
(defun dashboard-remove-item-projects ()
|
||||||
|
"Remove a path from `project--list'."
|
||||||
|
(interactive)
|
||||||
|
(let ((path (save-excursion (end-of-line) (ffap-guesser))))
|
||||||
|
(dashboard-mute-apply
|
||||||
|
(cl-case dashboard-projects-backend
|
||||||
|
(`projectile (projectile-remove-known-project path))
|
||||||
|
(`project-el (project-forget-projects-under path))))))
|
||||||
|
|
||||||
|
(defun dashboard-remove-item-bookmarks ()
|
||||||
|
"Remove a bookmarks from `bookmark-alist'."
|
||||||
|
(interactive)) ; TODO: ..
|
||||||
|
|
||||||
|
(defun dashboard-remove-item-agenda ()
|
||||||
|
"Remove an agenda from `org-agenda-files'."
|
||||||
|
(interactive "P")
|
||||||
|
(let ((agenda-file (get-text-property (point) 'dashboard-agenda-file))
|
||||||
|
(agenda-loc (get-text-property (point) 'dashboard-agenda-loc)))
|
||||||
|
(with-current-buffer (find-file-noselect agenda-file)
|
||||||
|
(goto-char agenda-loc)
|
||||||
|
(call-interactively 'org-todo))))
|
||||||
|
|
||||||
|
(defun dashboard-remove-item-registers ()
|
||||||
|
"Remove a registers from `register-alist'."
|
||||||
|
(interactive)) ; TODO: ..
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; Confirmation
|
||||||
|
;;
|
||||||
|
(defun dashboard-return ()
|
||||||
|
"Hit return key in dashboard buffer."
|
||||||
|
(interactive)
|
||||||
|
(let ((start-ln (line-number-at-pos)) (fd-cnt 0) diff-line entry-pt)
|
||||||
|
(save-excursion
|
||||||
|
(while (and (not diff-line)
|
||||||
|
(not (= (point) (point-min)))
|
||||||
|
(not (get-char-property (point) 'button))
|
||||||
|
(not (= (point) (point-max))))
|
||||||
|
(forward-char 1)
|
||||||
|
(setq fd-cnt (1+ fd-cnt))
|
||||||
|
(unless (= start-ln (line-number-at-pos))
|
||||||
|
(setq diff-line t)))
|
||||||
|
(unless (= (point) (point-max))
|
||||||
|
(setq entry-pt (point))))
|
||||||
|
(when (= fd-cnt 1)
|
||||||
|
(setq entry-pt (1- (point))))
|
||||||
|
(if entry-pt
|
||||||
|
(widget-button-press entry-pt)
|
||||||
|
(call-interactively #'widget-button-press))))
|
||||||
|
|
||||||
|
(defun dashboard-mouse-1 ()
|
||||||
|
"Key for keymap `mouse-1'."
|
||||||
|
(interactive)
|
||||||
|
(let ((old-track-mouse track-mouse))
|
||||||
|
(when (call-interactively #'widget-button-click)
|
||||||
|
(setq track-mouse old-track-mouse))))
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; Insertion
|
||||||
|
;;
|
||||||
|
(defmacro dashboard--with-buffer (&rest body)
|
||||||
|
"Execute BODY in dashboard buffer."
|
||||||
|
(declare (indent 0))
|
||||||
|
`(with-current-buffer (get-buffer-create dashboard-buffer-name)
|
||||||
|
(let ((inhibit-read-only t)) ,@body)
|
||||||
|
(current-buffer)))
|
||||||
|
|
||||||
|
(defun dashboard-maximum-section-length ()
|
||||||
|
"For the just-inserted section, calculate the length of the longest line."
|
||||||
|
(let ((max-line-length 0))
|
||||||
|
(save-excursion
|
||||||
|
(dashboard-previous-section)
|
||||||
|
(while (not (eobp))
|
||||||
|
(setq max-line-length
|
||||||
|
(max max-line-length
|
||||||
|
(- (line-end-position) (line-beginning-position))))
|
||||||
|
(forward-line 1)))
|
||||||
|
max-line-length))
|
||||||
|
|
||||||
|
(defun dashboard-insert-startupify-lists ()
|
||||||
|
"Insert the list of widgets into the buffer."
|
||||||
|
(interactive)
|
||||||
|
(let ((inhibit-redisplay t)
|
||||||
|
(recentf-is-on (recentf-enabled-p))
|
||||||
|
(origial-recentf-list recentf-list)
|
||||||
|
(dashboard-num-recents (or (cdr (assoc 'recents dashboard-items)) 0))
|
||||||
|
(max-line-length 0))
|
||||||
|
(when recentf-is-on
|
||||||
|
(setq recentf-list (dashboard-subseq recentf-list dashboard-num-recents)))
|
||||||
|
(dashboard--with-buffer
|
||||||
|
(when (or dashboard-force-refresh (not (eq major-mode 'dashboard-mode)))
|
||||||
|
(erase-buffer)
|
||||||
|
(dashboard-insert-banner)
|
||||||
|
(insert "\n")
|
||||||
|
(setq dashboard--section-starts nil)
|
||||||
|
(mapc (lambda (els)
|
||||||
|
(let* ((el (or (car-safe els) els))
|
||||||
|
(list-size
|
||||||
|
(or (cdr-safe els)
|
||||||
|
dashboard-items-default-length))
|
||||||
|
(item-generator
|
||||||
|
(cdr-safe (assoc el dashboard-item-generators))))
|
||||||
|
(push (point) dashboard--section-starts)
|
||||||
|
(funcall item-generator list-size)
|
||||||
|
(goto-char (point-max))
|
||||||
|
;; add a newline so the next section-name doesn't get include
|
||||||
|
;; on the same line.
|
||||||
|
(insert "\n")
|
||||||
|
(when recentf-is-on
|
||||||
|
(setq recentf-list origial-recentf-list))
|
||||||
|
(setq max-line-length
|
||||||
|
(max max-line-length (dashboard-maximum-section-length)))))
|
||||||
|
dashboard-items)
|
||||||
|
(when dashboard-center-content
|
||||||
|
(dashboard-center-text
|
||||||
|
(if dashboard--section-starts
|
||||||
|
(car (last dashboard--section-starts))
|
||||||
|
(point))
|
||||||
|
(point-max)))
|
||||||
|
(save-excursion
|
||||||
|
(dolist (start dashboard--section-starts)
|
||||||
|
(goto-char start)
|
||||||
|
(delete-char -1) ; delete the newline we added previously
|
||||||
|
(insert dashboard-page-separator)))
|
||||||
|
(progn
|
||||||
|
(delete-char -1)
|
||||||
|
(insert dashboard-page-separator))
|
||||||
|
(dashboard-insert-footer)
|
||||||
|
(goto-char (point-min))
|
||||||
|
(dashboard-mode)))
|
||||||
|
(when recentf-is-on
|
||||||
|
(setq recentf-list origial-recentf-list))))
|
||||||
|
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(defun dashboard-open (&rest _)
|
||||||
|
"Open (or refresh) the *dashboard* buffer."
|
||||||
|
(interactive)
|
||||||
|
(let ((dashboard-force-refresh t)) (dashboard-insert-startupify-lists))
|
||||||
|
(switch-to-buffer dashboard-buffer-name))
|
||||||
|
|
||||||
|
(defalias #'dashboard-refresh-buffer #'dashboard-open)
|
||||||
|
|
||||||
|
(defun dashboard-resize-on-hook (&optional _)
|
||||||
|
"Re-render dashboard on window size change."
|
||||||
|
(let ((space-win (get-buffer-window dashboard-buffer-name))
|
||||||
|
(frame-win (frame-selected-window)))
|
||||||
|
(when (and space-win
|
||||||
|
(not (window-minibuffer-p frame-win)))
|
||||||
|
(with-selected-window space-win
|
||||||
|
(dashboard-insert-startupify-lists)))))
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(defun dashboard-setup-startup-hook ()
|
||||||
|
"Setup post initialization hooks.
|
||||||
|
If a command line argument is provided, assume a filename and skip displaying
|
||||||
|
Dashboard."
|
||||||
|
(when (< (length command-line-args) 2)
|
||||||
|
(add-hook 'window-setup-hook (lambda ()
|
||||||
|
;; 100 means `dashboard-resize-on-hook' will run last
|
||||||
|
(add-hook 'window-size-change-functions 'dashboard-resize-on-hook 100)
|
||||||
|
(dashboard-resize-on-hook)))
|
||||||
|
(add-hook 'after-init-hook (lambda ()
|
||||||
|
;; Display useful lists of items
|
||||||
|
(dashboard-insert-startupify-lists)))
|
||||||
|
(add-hook 'emacs-startup-hook (lambda ()
|
||||||
|
(switch-to-buffer dashboard-buffer-name)
|
||||||
|
(goto-char (point-min))
|
||||||
|
(redisplay)
|
||||||
|
(run-hooks 'dashboard-after-initialize-hook)))))
|
||||||
|
|
||||||
|
(provide 'dashboard)
|
||||||
|
;;; dashboard.el ends here
|
|
@ -0,0 +1,74 @@
|
||||||
|
;;; devdocs-browser-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*-
|
||||||
|
;;
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
(add-to-list 'load-path (directory-file-name
|
||||||
|
(or (file-name-directory #$) (car load-path))))
|
||||||
|
|
||||||
|
|
||||||
|
;;;### (autoloads nil "devdocs-browser" "devdocs-browser.el" (0 0
|
||||||
|
;;;;;; 0 0))
|
||||||
|
;;; Generated autoloads from devdocs-browser.el
|
||||||
|
|
||||||
|
(autoload 'devdocs-browser-list-docs "devdocs-browser" "\
|
||||||
|
Get doc metadata lists, reload cache if REFRESH-CACHE.
|
||||||
|
|
||||||
|
\(fn &optional REFRESH-CACHE)" nil nil)
|
||||||
|
|
||||||
|
(autoload 'devdocs-browser-update-docs "devdocs-browser" "\
|
||||||
|
Update doc metadata list.
|
||||||
|
To upgrade docs content, see `devdocs-browser-upgrade-doc'." t nil)
|
||||||
|
|
||||||
|
(autoload 'devdocs-browser-install-doc "devdocs-browser" "\
|
||||||
|
Install doc by SLUG-OR-NAME.
|
||||||
|
When called interactively, user can choose from the list.
|
||||||
|
When called interactively with prefix, or FORCE is t, reinstall existing doc.
|
||||||
|
|
||||||
|
\(fn SLUG-OR-NAME &optional FORCE)" t nil)
|
||||||
|
|
||||||
|
(autoload 'devdocs-browser-uninstall-doc "devdocs-browser" "\
|
||||||
|
Uninstall doc by SLUG.
|
||||||
|
When called interactively, user can choose from the list.
|
||||||
|
|
||||||
|
\(fn SLUG)" t nil)
|
||||||
|
|
||||||
|
(autoload 'devdocs-browser-upgrade-doc "devdocs-browser" "\
|
||||||
|
Upgrade doc by SLUG, return t if upgrade success.
|
||||||
|
Also download new version of offline data if
|
||||||
|
there's offline data for current version.
|
||||||
|
When called interactively, user can choose from list.
|
||||||
|
You may need to call `devdocs-browser-update-docs' first.
|
||||||
|
|
||||||
|
\(fn SLUG)" t nil)
|
||||||
|
|
||||||
|
(autoload 'devdocs-browser-upgrade-all-docs "devdocs-browser" "\
|
||||||
|
Upgrade all docs." t nil)
|
||||||
|
|
||||||
|
(autoload 'devdocs-browser-open-in "devdocs-browser" "\
|
||||||
|
Open entry in specified docs SLUG-OR-NAME-LIST.
|
||||||
|
When called interactively, user can choose from the list.
|
||||||
|
|
||||||
|
\(fn SLUG-OR-NAME-LIST)" t nil)
|
||||||
|
|
||||||
|
(autoload 'devdocs-browser-open "devdocs-browser" "\
|
||||||
|
Open entry in active docs.
|
||||||
|
Active docs are specified by `devdocs-browser-active-docs',
|
||||||
|
or `devdocs-browser-major-mode-docs-alist',
|
||||||
|
or the current doc type if called in a devdocs eww buffer.
|
||||||
|
When all of them are nil, all installed docs are used." t nil)
|
||||||
|
|
||||||
|
(register-definition-prefixes "devdocs-browser" '("devdocs-browser-"))
|
||||||
|
|
||||||
|
;;;***
|
||||||
|
|
||||||
|
;;;### (autoloads nil nil ("devdocs-browser-pkg.el") (0 0 0 0))
|
||||||
|
|
||||||
|
;;;***
|
||||||
|
|
||||||
|
;; Local Variables:
|
||||||
|
;; version-control: never
|
||||||
|
;; no-byte-compile: t
|
||||||
|
;; no-update-autoloads: t
|
||||||
|
;; coding: utf-8
|
||||||
|
;; End:
|
||||||
|
;;; devdocs-browser-autoloads.el ends here
|
|
@ -0,0 +1,14 @@
|
||||||
|
(define-package "devdocs-browser" "20230423.444" "Browse devdocs.io documents using EWW"
|
||||||
|
'((emacs "27.1"))
|
||||||
|
:commit "ef7686e4ff4ecab42e1b4a1a5d079bcf947a5b71" :authors
|
||||||
|
'(("blahgeek" . "i@blahgeek.com"))
|
||||||
|
:maintainers
|
||||||
|
'(("blahgeek" . "i@blahgeek.com"))
|
||||||
|
:maintainer
|
||||||
|
'("blahgeek" . "i@blahgeek.com")
|
||||||
|
:keywords
|
||||||
|
'("docs" "help" "tools")
|
||||||
|
:url "https://github.com/blahgeek/emacs-devdocs-browser")
|
||||||
|
;; Local Variables:
|
||||||
|
;; no-byte-compile: t
|
||||||
|
;; End:
|
808
code/elpa/devdocs-browser-20230423.444/devdocs-browser.el
Normal file
808
code/elpa/devdocs-browser-20230423.444/devdocs-browser.el
Normal file
|
@ -0,0 +1,808 @@
|
||||||
|
;;; devdocs-browser.el --- Browse devdocs.io documents using EWW -*- lexical-binding: t; -*-
|
||||||
|
|
||||||
|
;; Copyright (C) 2021
|
||||||
|
|
||||||
|
;; Author: blahgeek <i@blahgeek.com>
|
||||||
|
;; URL: https://github.com/blahgeek/emacs-devdocs-browser
|
||||||
|
;; Version: 20210525
|
||||||
|
;; Keywords: docs, help, tools
|
||||||
|
;; Package-Requires: ((emacs "27.1"))
|
||||||
|
|
||||||
|
;; 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 <https://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
;;; Commentary:
|
||||||
|
|
||||||
|
;; Browse devdocs.io documents inside Emacs using EWW.
|
||||||
|
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
(require 'files)
|
||||||
|
(require 'shr)
|
||||||
|
(require 'eww)
|
||||||
|
(require 'eldoc)
|
||||||
|
(require 'imenu)
|
||||||
|
|
||||||
|
|
||||||
|
(defgroup devdocs-browser nil
|
||||||
|
"Browse devdocs.io."
|
||||||
|
:group 'tools
|
||||||
|
:group 'web)
|
||||||
|
|
||||||
|
(defcustom devdocs-browser-cache-directory
|
||||||
|
(expand-file-name "devdocs-browser" user-emacs-directory)
|
||||||
|
"Directory to store devdocs cache files."
|
||||||
|
:type 'directory
|
||||||
|
:group 'devdocs-browser)
|
||||||
|
|
||||||
|
(defcustom devdocs-browser-base-url "https://devdocs.io/"
|
||||||
|
"Base URL to fetch json metadata files."
|
||||||
|
:type 'string)
|
||||||
|
|
||||||
|
(defcustom devdocs-browser-doc-base-url "https://documents.devdocs.io/"
|
||||||
|
"Base URL for doc contents."
|
||||||
|
:type 'string)
|
||||||
|
|
||||||
|
(defcustom devdocs-browser-major-mode-docs-alist
|
||||||
|
'((c++-mode . ("cpp"))
|
||||||
|
(c-mode . ("c"))
|
||||||
|
(go-mode . ("go"))
|
||||||
|
(python-mode . ("Python"))
|
||||||
|
(emacs-lisp-mode . ("elisp"))
|
||||||
|
(rust-mode . ("rust"))
|
||||||
|
(cmake-mode . ("CMake")))
|
||||||
|
"Alist of MAJOR-MODE and list of docset names.
|
||||||
|
When calling `devdocs-browser-open', this variable will be used
|
||||||
|
to pick a list of docsets based on the current MAJOR-MODE.
|
||||||
|
Docset name may be SLUG (e.g. 'python~3.8') or NAME (e.g. 'Python'),
|
||||||
|
if it's a NAME and multiple choices are possible,
|
||||||
|
one of the installed docs with the NAME will be used.
|
||||||
|
Also see `devdocs-browser-active-docs'."
|
||||||
|
:type '(alist :key-type function
|
||||||
|
:value-type (list string)))
|
||||||
|
|
||||||
|
(defvar-local devdocs-browser-active-docs
|
||||||
|
nil
|
||||||
|
"List of docset names used by `devdocs-browser-open' to pick docsets.
|
||||||
|
If this var is set to non-nil,
|
||||||
|
it have higher priority than `devdocs-browser-major-mode-docs-alist'.
|
||||||
|
See `devdocs-browser-major-mode-docs-alist' for the meaning of NAME.")
|
||||||
|
|
||||||
|
(defcustom devdocs-browser-highlight-lang-mode-alist '()
|
||||||
|
"Alist of language name and MAJOR-MODE, to highlight HTML pre blocks.
|
||||||
|
If language is not found in this alist,
|
||||||
|
`devdocs-browser-highlight-lang-mode-alist-default' will be used.
|
||||||
|
See https://prismjs.com/ for list of language names."
|
||||||
|
:type '(alist :key-type string
|
||||||
|
:value-type function))
|
||||||
|
|
||||||
|
(defvar devdocs-browser-highlight-lang-mode-alist-default
|
||||||
|
'(("html" . html-mode)
|
||||||
|
("xml" . xml-mode)
|
||||||
|
("css" . css-mode)
|
||||||
|
("clike" . c-mode)
|
||||||
|
("javascript" . js-mode)
|
||||||
|
("js" . js-mode)
|
||||||
|
("jsx" . js-mode)
|
||||||
|
("bash" . sh-mode)
|
||||||
|
("shell" . sh-mode)
|
||||||
|
("c" . c-mode)
|
||||||
|
("cpp" . c++-mode)
|
||||||
|
("cmake" . cmake-mode)
|
||||||
|
("go" . go-mode)
|
||||||
|
("haskell" . haskell-mode)
|
||||||
|
("hs" . haskell-mode)
|
||||||
|
("java" . java-mode)
|
||||||
|
("json" . js-mode)
|
||||||
|
("elisp" . elisp-mode)
|
||||||
|
("emacs" . elisp-mode)
|
||||||
|
("lua" . lua-mode)
|
||||||
|
("makefile" . makefile-mode)
|
||||||
|
("markdown" . markdown-mode)
|
||||||
|
("md" . markdown-mode)
|
||||||
|
("nginx" . conf-mode)
|
||||||
|
("objectivec" . objc-mode)
|
||||||
|
("objc" . objc-mode)
|
||||||
|
("perl" . perl-mode)
|
||||||
|
("protobuf" . protobuf-mode)
|
||||||
|
("python" . python-mode)
|
||||||
|
("py" . python-mode)
|
||||||
|
("ruby" . ruby-mode)
|
||||||
|
("rust" . rust-mode)
|
||||||
|
("rb" . ruby-mode)
|
||||||
|
("sql" . sql-mode)
|
||||||
|
("typescript" . typescript-mode))
|
||||||
|
"Default value for `devdocs-browser-highlight-lang-mode-alist'.")
|
||||||
|
|
||||||
|
|
||||||
|
(defun devdocs-browser--eww-fontify-pre (dom)
|
||||||
|
"Return fontified string for pre DOM."
|
||||||
|
(with-temp-buffer
|
||||||
|
(shr-generic dom)
|
||||||
|
(when (> shr-indentation 0)
|
||||||
|
(save-excursion
|
||||||
|
(goto-char (point-min))
|
||||||
|
(while (not (eobp))
|
||||||
|
(shr-indent)
|
||||||
|
(forward-line 1))))
|
||||||
|
(let* ((language (dom-attr dom 'data-language))
|
||||||
|
(mode (cdr (or (assoc language devdocs-browser-highlight-lang-mode-alist)
|
||||||
|
(assoc language devdocs-browser-highlight-lang-mode-alist-default)))))
|
||||||
|
(when (fboundp mode)
|
||||||
|
(delay-mode-hooks (funcall mode))
|
||||||
|
(font-lock-default-function mode)
|
||||||
|
(font-lock-default-fontify-region (point-min) (point-max) nil)))
|
||||||
|
(buffer-string)))
|
||||||
|
|
||||||
|
(defun devdocs-browser--eww-tag-pre (dom)
|
||||||
|
"Rendering function for pre DOM."
|
||||||
|
(let ((shr-folding-mode 'none)
|
||||||
|
(shr-current-font 'default))
|
||||||
|
(shr-ensure-newline)
|
||||||
|
(insert (devdocs-browser--eww-fontify-pre dom))
|
||||||
|
(shr-ensure-newline)))
|
||||||
|
|
||||||
|
(defun devdocs-browser--eww-tag-maybe-set-title (dom)
|
||||||
|
"Maybe set DOM as title if it's not set yet."
|
||||||
|
(when (zerop (length (plist-get eww-data :title)))
|
||||||
|
(eww-tag-title dom)))
|
||||||
|
|
||||||
|
(defun devdocs-browser--eww-tag-h1 (dom)
|
||||||
|
"Rendering function for h1 DOM. Maybe use it as title."
|
||||||
|
(devdocs-browser--eww-tag-maybe-set-title dom)
|
||||||
|
(shr-tag-h1 dom))
|
||||||
|
|
||||||
|
(defun devdocs-browser--eww-tag-h2 (dom)
|
||||||
|
"Rendering function for h2 DOM. Maybe use it as title."
|
||||||
|
(devdocs-browser--eww-tag-maybe-set-title dom)
|
||||||
|
(shr-heading dom (if shr-use-fonts
|
||||||
|
'(variable-pitch (:height 1.2 :weight bold))
|
||||||
|
'bold)))
|
||||||
|
|
||||||
|
(defun devdocs-browser--eww-tag-h3 (dom)
|
||||||
|
"Rendering function for h2 DOM. Maybe use it as title."
|
||||||
|
(devdocs-browser--eww-tag-maybe-set-title dom)
|
||||||
|
(shr-heading dom (if shr-use-fonts
|
||||||
|
'(variable-pitch (:height 1.1 :weight bold))
|
||||||
|
'bold)))
|
||||||
|
|
||||||
|
(defun devdocs-browser--eww-tag-h4 (dom)
|
||||||
|
"Rendering function for h4 DOM."
|
||||||
|
(shr-heading dom 'bold))
|
||||||
|
|
||||||
|
(defun devdocs-browser--eww-tag-h5 (dom)
|
||||||
|
"Rendering function for h5 DOM."
|
||||||
|
(shr-heading dom 'italic))
|
||||||
|
|
||||||
|
(defvar-local devdocs-browser--eww-data '()
|
||||||
|
"Plist data for current eww page, contain :doc and :path.")
|
||||||
|
|
||||||
|
(defun devdocs-browser--eww-fix-url (url)
|
||||||
|
"Fix links' URL in docs by appending suffix and mtime."
|
||||||
|
;; shr-expand-url may be call in a temp buffer
|
||||||
|
;; we need to temporary bind this buffer to access the buffer-local variable.
|
||||||
|
(with-current-buffer (window-buffer)
|
||||||
|
(let ((url-parsed (url-generic-parse-url url))
|
||||||
|
(root-url-parsed (url-generic-parse-url (plist-get eww-data :url)))
|
||||||
|
(mtime (plist-get (plist-get devdocs-browser--eww-data :doc) :mtime)))
|
||||||
|
(when (and mtime
|
||||||
|
(equal (url-type url-parsed) (url-type root-url-parsed))
|
||||||
|
(equal (url-host url-parsed) (url-host root-url-parsed))
|
||||||
|
(not (string-match-p "\\.html" url)))
|
||||||
|
(setf (url-filename url-parsed)
|
||||||
|
(if (equal (url-type url-parsed) "file")
|
||||||
|
(concat (url-filename url-parsed) ".html")
|
||||||
|
(format "%s.html?%s" (url-filename url-parsed) mtime)))
|
||||||
|
(setq url (url-recreate-url url-parsed)))))
|
||||||
|
url)
|
||||||
|
|
||||||
|
(defun devdocs-browser--eww-parse-url-path (url)
|
||||||
|
"Return URL's doc :path ('hello/world#target')."
|
||||||
|
;; see devdocs-browser--eww-open for url pattern
|
||||||
|
(when-let* ((url-parsed (url-generic-parse-url url))
|
||||||
|
(doc (plist-get devdocs-browser--eww-data :doc))
|
||||||
|
(slug (plist-get doc :slug))
|
||||||
|
(filename-suffix (if (equal (url-type url-parsed) "file")
|
||||||
|
".html"
|
||||||
|
(format ".html?%s" (plist-get doc :mtime))))
|
||||||
|
(filename-prefix (if (equal (url-type url-parsed) "file")
|
||||||
|
(devdocs-browser-offline-data-dir slug)
|
||||||
|
(concat "/" slug "/")))
|
||||||
|
(path (url-filename url-parsed)))
|
||||||
|
(when (and (string-prefix-p filename-prefix path)
|
||||||
|
(string-suffix-p filename-suffix path))
|
||||||
|
(setq path (string-remove-prefix filename-prefix path))
|
||||||
|
(setq path (string-remove-suffix filename-suffix path))
|
||||||
|
(when (url-target url-parsed)
|
||||||
|
(setq path (concat path "#" (url-target url-parsed))))
|
||||||
|
path)))
|
||||||
|
|
||||||
|
(defun devdocs-browser--eww-page-path ()
|
||||||
|
"Return current page's :path ('hello/world#target')."
|
||||||
|
(devdocs-browser--eww-parse-url-path (plist-get eww-data :url)))
|
||||||
|
|
||||||
|
(defun devdocs-browser--eww-link-eldoc (&optional _)
|
||||||
|
"Show URL link or description at current point."
|
||||||
|
(when-let ((url (get-text-property (point) 'shr-url)))
|
||||||
|
(if-let ((path (devdocs-browser--eww-parse-url-path url)))
|
||||||
|
(let* ((doc (plist-get devdocs-browser--eww-data :doc))
|
||||||
|
(index (plist-get doc :index))
|
||||||
|
(entries (plist-get index :entries))
|
||||||
|
(entry (seq-find
|
||||||
|
(lambda (x) (equal (plist-get x :path) path))
|
||||||
|
entries)))
|
||||||
|
(concat
|
||||||
|
(when entry
|
||||||
|
(propertize (plist-get entry :name) 'face 'font-lock-keyword-face))
|
||||||
|
(when entry
|
||||||
|
(format " (%s): " (plist-get entry :type)))
|
||||||
|
(propertize path 'face 'italic)))
|
||||||
|
(format "External link: %s" (propertize url 'face 'italic)))))
|
||||||
|
|
||||||
|
(defun devdocs-browser--position-by-target (target)
|
||||||
|
"Find buffer position for TARGET (url hash)."
|
||||||
|
(save-excursion
|
||||||
|
(goto-char (point-min))
|
||||||
|
(when-let ((match (text-property-search-forward 'shr-target-id target #'member)))
|
||||||
|
(prop-match-beginning match))))
|
||||||
|
|
||||||
|
(defun devdocs-browser--imenu-create-index ()
|
||||||
|
"Create index alist for current buffer for imenu.
|
||||||
|
Can be used as `imenu-create-index-function'."
|
||||||
|
(when-let* ((doc (plist-get devdocs-browser--eww-data :doc))
|
||||||
|
(entries (plist-get (plist-get doc :index) :entries))
|
||||||
|
(page-path (devdocs-browser--eww-page-path))
|
||||||
|
(page-url (url-generic-parse-url page-path)))
|
||||||
|
(seq-filter
|
||||||
|
#'identity
|
||||||
|
(mapcar
|
||||||
|
(lambda (entry)
|
||||||
|
(when-let* ((name (plist-get entry :name))
|
||||||
|
(path (plist-get entry :path))
|
||||||
|
(url (url-generic-parse-url path))
|
||||||
|
(target (url-target url))
|
||||||
|
(_ (equal (url-filename url) (url-filename page-url))))
|
||||||
|
(cons name (devdocs-browser--position-by-target target))))
|
||||||
|
entries))))
|
||||||
|
|
||||||
|
(define-obsolete-function-alias 'devdocs-browser-eww-goto-target 'imenu "20220917")
|
||||||
|
|
||||||
|
(defun devdocs-browser-eww-open-in-default-browser ()
|
||||||
|
"Open current page in devdocs.io in browser."
|
||||||
|
(interactive)
|
||||||
|
(when-let* ((doc (plist-get devdocs-browser--eww-data :doc))
|
||||||
|
(slug (plist-get doc :slug))
|
||||||
|
(path (devdocs-browser--eww-page-path))
|
||||||
|
(url (concat devdocs-browser-base-url slug "/" path)))
|
||||||
|
(browse-url-default-browser url)))
|
||||||
|
|
||||||
|
(defun devdocs-browser--eww-recenter-advice (res)
|
||||||
|
"Recenter current cursor for devdocs buffer, used for advice :filter-return (return `RES')."
|
||||||
|
(when devdocs-browser--eww-data
|
||||||
|
(recenter))
|
||||||
|
res)
|
||||||
|
|
||||||
|
(defun devdocs-browser--eww-browse-url-new-window-advice (args)
|
||||||
|
"Advice around `eww-browse-url' with ARGS, set NEW-WINDOW if URL is external."
|
||||||
|
(let ((url (car args))
|
||||||
|
(new-window (cadr args)))
|
||||||
|
(when (and devdocs-browser--eww-data
|
||||||
|
(not (devdocs-browser--eww-parse-url-path url)))
|
||||||
|
(setq new-window t))
|
||||||
|
(list url new-window)))
|
||||||
|
|
||||||
|
(define-minor-mode devdocs-browser-eww-mode
|
||||||
|
"Minor mode for browsing devdocs pages with eww."
|
||||||
|
:lighter " Devdocs"
|
||||||
|
:interactive nil
|
||||||
|
:group 'devdocs-browser
|
||||||
|
:keymap (let ((map (make-sparse-keymap)))
|
||||||
|
(define-key map (kbd "C-c C-o") #'devdocs-browser-eww-open-in-default-browser)
|
||||||
|
map)
|
||||||
|
(setq-local shr-external-rendering-functions
|
||||||
|
(append shr-external-rendering-functions
|
||||||
|
'((pre . devdocs-browser--eww-tag-pre)
|
||||||
|
(h1 . devdocs-browser--eww-tag-h1)
|
||||||
|
(h2 . devdocs-browser--eww-tag-h2)
|
||||||
|
(h3 . devdocs-browser--eww-tag-h3)
|
||||||
|
(h4 . devdocs-browser--eww-tag-h4)
|
||||||
|
(h5 . devdocs-browser--eww-tag-h5))))
|
||||||
|
(setq-local imenu-create-index-function
|
||||||
|
#'devdocs-browser--imenu-create-index)
|
||||||
|
(when (boundp 'eww-auto-rename-buffer)
|
||||||
|
(setq-local eww-auto-rename-buffer nil))
|
||||||
|
(advice-add 'shr-expand-url :filter-return #'devdocs-browser--eww-fix-url)
|
||||||
|
(advice-add 'eww-display-html :filter-return #'devdocs-browser--eww-recenter-advice)
|
||||||
|
(advice-add 'eww-browse-url :filter-args #'devdocs-browser--eww-browse-url-new-window-advice)
|
||||||
|
(add-hook 'eldoc-documentation-functions #'devdocs-browser--eww-link-eldoc nil t)
|
||||||
|
(eldoc-mode))
|
||||||
|
|
||||||
|
(defvar devdocs-browser--docs-dir "docs")
|
||||||
|
(defvar devdocs-browser--index-json-filename "index.json")
|
||||||
|
(defvar devdocs-browser--metadata-filename "metadata.el")
|
||||||
|
(defvar devdocs-browser--offline-data-json-filename "content.json")
|
||||||
|
(defvar devdocs-browser--offline-data-dir-name "content")
|
||||||
|
|
||||||
|
(defun devdocs-browser--completing-read (prompt collection &optional def)
|
||||||
|
"Helper function for `completing-read'.
|
||||||
|
PROMPT: same meaning, but this function will append ';' at the end;
|
||||||
|
COLLECTION: alist of (name . props), where props is a plist with
|
||||||
|
possibly the following keys: :value, :annotation, :group;
|
||||||
|
if :group is not nil and name starts with '<group>: ', its removed.
|
||||||
|
DEF: same meaning;"
|
||||||
|
;; convert collection to hashtables for faster completion. `complete-with-action' also supports that.
|
||||||
|
(setq collection (delq nil collection))
|
||||||
|
(let* ((collection-ht (make-hash-table :test 'equal :size (length collection)))
|
||||||
|
(annotation-function
|
||||||
|
(lambda (s)
|
||||||
|
(let ((annotation (plist-get (gethash s collection-ht) :annotation)))
|
||||||
|
(if annotation
|
||||||
|
(concat " " annotation)
|
||||||
|
nil))))
|
||||||
|
(group-function
|
||||||
|
(lambda (s transform)
|
||||||
|
(let ((group (plist-get (gethash s collection-ht) :group)))
|
||||||
|
(cond
|
||||||
|
(transform (if (and group (string-match (rx bos (literal group) ": ") s))
|
||||||
|
(replace-match "" t t s)
|
||||||
|
s))
|
||||||
|
(t group))))))
|
||||||
|
(mapc (lambda (elem) (puthash (car elem) (cdr elem) collection-ht))
|
||||||
|
collection)
|
||||||
|
(setq prompt (concat prompt
|
||||||
|
(when def
|
||||||
|
(format " (default %s)" (funcall group-function def t)))
|
||||||
|
": "))
|
||||||
|
(let ((res (completing-read
|
||||||
|
prompt
|
||||||
|
(lambda (str pred action)
|
||||||
|
(if (eq action 'metadata)
|
||||||
|
`(metadata . ((annotation-function . ,annotation-function)
|
||||||
|
(group-function . ,group-function)))
|
||||||
|
(complete-with-action action collection str pred)))
|
||||||
|
nil t ;; require-match
|
||||||
|
nil nil def)))
|
||||||
|
(or (plist-get (gethash res collection-ht) :value)
|
||||||
|
res))))
|
||||||
|
|
||||||
|
(defun devdocs-browser--json-parse-buffer ()
|
||||||
|
"Same as `json-parse-buffer', with custom settings."
|
||||||
|
(json-parse-buffer :object-type 'plist :array-type 'array))
|
||||||
|
|
||||||
|
(defun devdocs-browser--read-json (file-path)
|
||||||
|
"Read json file in FILE-PATH, if it's a relative path, find it in cache dir."
|
||||||
|
(let ((filename (expand-file-name file-path devdocs-browser-cache-directory)))
|
||||||
|
(when (file-exists-p filename)
|
||||||
|
(with-temp-buffer
|
||||||
|
(insert-file-contents filename)
|
||||||
|
(devdocs-browser--json-parse-buffer)))))
|
||||||
|
|
||||||
|
(defun devdocs-browser--fetch-json (url-path file-path &optional base-url)
|
||||||
|
"Fetch json from BASE-URL / URL-PATH, also save to FILE-PATH.
|
||||||
|
BASE-URL defaults to `devdocs-browser-base-url'."
|
||||||
|
(let ((cache-filename (expand-file-name file-path devdocs-browser-cache-directory)))
|
||||||
|
(unless (file-exists-p (file-name-directory cache-filename))
|
||||||
|
(make-directory (file-name-directory cache-filename) t))
|
||||||
|
(with-temp-file cache-filename
|
||||||
|
(erase-buffer)
|
||||||
|
(url-insert-file-contents (concat (or base-url devdocs-browser-base-url) url-path))
|
||||||
|
(devdocs-browser--json-parse-buffer))))
|
||||||
|
|
||||||
|
|
||||||
|
(defvar devdocs-browser--docs-list-cache nil "Cached docs list.")
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(defun devdocs-browser-list-docs (&optional refresh-cache)
|
||||||
|
"Get doc metadata lists, reload cache if REFRESH-CACHE."
|
||||||
|
(setq devdocs-browser--docs-list-cache
|
||||||
|
(or (and (not refresh-cache) devdocs-browser--docs-list-cache)
|
||||||
|
(and (not refresh-cache) (devdocs-browser--read-json "docs.json"))
|
||||||
|
(devdocs-browser--fetch-json "docs.json" "docs.json"))))
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(defun devdocs-browser-update-docs ()
|
||||||
|
"Update doc metadata list.
|
||||||
|
To upgrade docs content, see `devdocs-browser-upgrade-doc'."
|
||||||
|
(interactive)
|
||||||
|
(let ((count (length (devdocs-browser-list-docs t))))
|
||||||
|
(message (concat "Doc metadata updated, found total %s docs. "
|
||||||
|
"You may want to run `devdocs-browser-install-doc' "
|
||||||
|
"or `devdocs-browser-upgrade-doc'.")
|
||||||
|
count)))
|
||||||
|
|
||||||
|
(defun devdocs-browser-find-doc (slug-or-name)
|
||||||
|
"Find doc from docs list by SLUG-OR-NAME."
|
||||||
|
(let ((docs-list (devdocs-browser-list-docs)))
|
||||||
|
(seq-find (lambda (doc)
|
||||||
|
(or (equal (plist-get doc :slug) slug-or-name)
|
||||||
|
(equal (plist-get doc :name) slug-or-name)))
|
||||||
|
docs-list)))
|
||||||
|
|
||||||
|
(defvar devdocs-browser--docs-cache '() "Cached doc indexes plist.")
|
||||||
|
|
||||||
|
(defun devdocs-browser--install-doc-internal (doc)
|
||||||
|
"(Re-)install doc identified by plist DOC. Return t if success."
|
||||||
|
(let* ((slug (plist-get doc :slug))
|
||||||
|
(mtime (plist-get doc :mtime))
|
||||||
|
(docs-dir (expand-file-name devdocs-browser--docs-dir devdocs-browser-cache-directory))
|
||||||
|
(doc-dir (expand-file-name slug docs-dir))
|
||||||
|
success)
|
||||||
|
(unless (file-exists-p docs-dir)
|
||||||
|
(make-directory docs-dir t))
|
||||||
|
(when (file-exists-p doc-dir)
|
||||||
|
(delete-directory doc-dir t))
|
||||||
|
|
||||||
|
;; do not leave empty directory
|
||||||
|
(unwind-protect
|
||||||
|
(progn
|
||||||
|
(devdocs-browser--fetch-json
|
||||||
|
(format "docs/%s/index.json?%s" slug mtime)
|
||||||
|
(expand-file-name devdocs-browser--index-json-filename doc-dir))
|
||||||
|
(with-temp-file (expand-file-name devdocs-browser--metadata-filename doc-dir)
|
||||||
|
(print doc (current-buffer)))
|
||||||
|
(setq success t))
|
||||||
|
(unless success
|
||||||
|
(delete-directory doc-dir t)))
|
||||||
|
|
||||||
|
(if success
|
||||||
|
(message "Installed devdocs doc %s version %s" slug mtime)
|
||||||
|
(message "Failed to install devdocs doc %s" slug))
|
||||||
|
;; remove cache
|
||||||
|
(setq devdocs-browser--docs-cache
|
||||||
|
(lax-plist-put devdocs-browser--docs-cache slug nil))
|
||||||
|
success))
|
||||||
|
|
||||||
|
(defun devdocs-browser--doc-readable-name (doc)
|
||||||
|
"Get human readable name for DOC."
|
||||||
|
(let ((slug (plist-get doc :slug))
|
||||||
|
(name (plist-get doc :name))
|
||||||
|
(version (plist-get doc :version))
|
||||||
|
(release (plist-get doc :release))
|
||||||
|
res)
|
||||||
|
(setq res (concat slug " (" name))
|
||||||
|
(unless (zerop (length version))
|
||||||
|
(setq res (concat res " " version)))
|
||||||
|
(unless (zerop (length release))
|
||||||
|
(setq res (concat res ", " release)))
|
||||||
|
(setq res (concat res ")"))
|
||||||
|
res))
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(defun devdocs-browser-install-doc (slug-or-name &optional force)
|
||||||
|
"Install doc by SLUG-OR-NAME.
|
||||||
|
When called interactively, user can choose from the list.
|
||||||
|
When called interactively with prefix, or FORCE is t, reinstall existing doc."
|
||||||
|
(interactive
|
||||||
|
(let* ((force current-prefix-arg)
|
||||||
|
(installed-docs
|
||||||
|
(devdocs-browser-list-installed-slugs))
|
||||||
|
(selected-slug
|
||||||
|
(devdocs-browser--completing-read
|
||||||
|
"Install doc"
|
||||||
|
(mapcar (lambda (doc)
|
||||||
|
(let ((slug (plist-get doc :slug)))
|
||||||
|
(unless (and (not force)
|
||||||
|
(member slug installed-docs))
|
||||||
|
(cons (devdocs-browser--doc-readable-name doc)
|
||||||
|
`(:value ,slug)))))
|
||||||
|
(devdocs-browser-list-docs)))))
|
||||||
|
(list selected-slug force)))
|
||||||
|
(let ((doc (devdocs-browser-find-doc slug-or-name)))
|
||||||
|
(unless (and (not force)
|
||||||
|
(member (plist-get doc :slug) (devdocs-browser-list-installed-slugs)))
|
||||||
|
(devdocs-browser--install-doc-internal doc))))
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(defun devdocs-browser-uninstall-doc (slug)
|
||||||
|
"Uninstall doc by SLUG.
|
||||||
|
When called interactively, user can choose from the list."
|
||||||
|
(interactive (list (completing-read "Uninstall doc: "
|
||||||
|
(devdocs-browser-list-installed-slugs)
|
||||||
|
nil t)))
|
||||||
|
(let* ((docs-dir (expand-file-name devdocs-browser--docs-dir devdocs-browser-cache-directory))
|
||||||
|
(doc-dir (expand-file-name slug docs-dir)))
|
||||||
|
(when (file-exists-p doc-dir)
|
||||||
|
(delete-directory doc-dir t)))
|
||||||
|
(setq devdocs-browser--docs-cache
|
||||||
|
(lax-plist-put devdocs-browser--docs-cache slug nil)))
|
||||||
|
|
||||||
|
(defun devdocs-browser--upgrade-readable-name (old-doc new-doc)
|
||||||
|
"Get human readable name for upgrade from OLD-DOC to NEW-DOC."
|
||||||
|
(let ((slug (plist-get old-doc :slug))
|
||||||
|
(name (plist-get old-doc :name))
|
||||||
|
(old-version (plist-get old-doc :version))
|
||||||
|
(old-release (plist-get old-doc :release))
|
||||||
|
(old-mtime (plist-get old-doc :mtime))
|
||||||
|
(new-version (plist-get new-doc :version))
|
||||||
|
(new-release (plist-get new-doc :release))
|
||||||
|
(new-mtime (plist-get new-doc :mtime))
|
||||||
|
res)
|
||||||
|
(setq res (format "%s (%s" slug name))
|
||||||
|
(unless (equal old-version new-version)
|
||||||
|
(setq res (concat res (format " %s->%s" old-version new-version))))
|
||||||
|
(unless (equal old-release new-release)
|
||||||
|
(setq res (concat res (format ", %s->%s" old-release new-release))))
|
||||||
|
(setq res (concat res (format ", %s->%s)" old-mtime new-mtime)))
|
||||||
|
res))
|
||||||
|
|
||||||
|
(defun devdocs-browser--upgrade-readable-name-or-nil (slug)
|
||||||
|
"Get human readable name for upgrading SLUG if it needs upgrade."
|
||||||
|
(let ((old-doc (devdocs-browser--load-doc slug))
|
||||||
|
(new-doc (devdocs-browser-find-doc slug)))
|
||||||
|
(when (and new-doc
|
||||||
|
(> (plist-get new-doc :mtime) (plist-get old-doc :mtime)))
|
||||||
|
(devdocs-browser--upgrade-readable-name old-doc new-doc))))
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(defun devdocs-browser-upgrade-doc (slug)
|
||||||
|
"Upgrade doc by SLUG, return t if upgrade success.
|
||||||
|
Also download new version of offline data if
|
||||||
|
there's offline data for current version.
|
||||||
|
When called interactively, user can choose from list.
|
||||||
|
You may need to call `devdocs-browser-update-docs' first."
|
||||||
|
(interactive
|
||||||
|
(let (rows)
|
||||||
|
(dolist (slug (devdocs-browser-list-installed-slugs))
|
||||||
|
(let ((desc (devdocs-browser--upgrade-readable-name-or-nil slug)))
|
||||||
|
(when desc
|
||||||
|
(push (cons desc slug) rows))))
|
||||||
|
(if (null rows)
|
||||||
|
(progn
|
||||||
|
(message "All docs up to date")
|
||||||
|
(list nil))
|
||||||
|
(list
|
||||||
|
(cdr (assoc (completing-read "Upgrade doc: " rows nil t) rows))))))
|
||||||
|
(when (and slug (devdocs-browser--upgrade-readable-name-or-nil slug))
|
||||||
|
(let* ((has-offline-data (devdocs-browser-offline-data-dir slug))
|
||||||
|
(doc (devdocs-browser-find-doc slug))
|
||||||
|
(install-success (devdocs-browser--install-doc-internal doc)))
|
||||||
|
(when (and has-offline-data install-success)
|
||||||
|
(devdocs-browser--download-offline-data-internal doc))
|
||||||
|
install-success)))
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(defun devdocs-browser-upgrade-all-docs ()
|
||||||
|
"Upgrade all docs."
|
||||||
|
(interactive)
|
||||||
|
(let ((count 0))
|
||||||
|
(dolist (slug (devdocs-browser-list-installed-slugs))
|
||||||
|
(message "Processing %s..." slug)
|
||||||
|
(when (devdocs-browser-upgrade-doc slug)
|
||||||
|
(setq count (1+ count))))
|
||||||
|
(message "Upgraded %s docs" count)))
|
||||||
|
|
||||||
|
(defun devdocs-browser-list-installed-slugs ()
|
||||||
|
"Get a list of installed docs' slug name."
|
||||||
|
(let ((dir (expand-file-name devdocs-browser--docs-dir devdocs-browser-cache-directory)))
|
||||||
|
(when (file-exists-p dir)
|
||||||
|
(directory-files dir nil
|
||||||
|
;; ignore ".", ".." and hidden files
|
||||||
|
"^[^.].*"))))
|
||||||
|
|
||||||
|
(defun devdocs-browser-find-installed-doc (slug-or-name)
|
||||||
|
"Find installed doc by SLUG-OR-NAME."
|
||||||
|
(let ((docs-list (mapcar #'devdocs-browser-installed-doc-info
|
||||||
|
(devdocs-browser-list-installed-slugs))))
|
||||||
|
(seq-find (lambda (doc)
|
||||||
|
(or (equal (plist-get doc :slug) slug-or-name)
|
||||||
|
(equal (plist-get doc :name) slug-or-name)))
|
||||||
|
docs-list)))
|
||||||
|
|
||||||
|
(defun devdocs-browser-installed-doc-info (slug)
|
||||||
|
"Get plist info of installed doc identified by SLUG."
|
||||||
|
(cddr (devdocs-browser--load-doc slug)))
|
||||||
|
|
||||||
|
(defun devdocs-browser--load-doc (slug &optional refresh-cache)
|
||||||
|
"Load doc identified by SLUG, reload cache if REFRESH-CACHE is not nil.
|
||||||
|
Result is a plist metadata, with an extra :index field at the beginning."
|
||||||
|
(or (and (not refresh-cache) (lax-plist-get devdocs-browser--docs-cache slug))
|
||||||
|
(let* ((docs-dir (expand-file-name devdocs-browser--docs-dir
|
||||||
|
devdocs-browser-cache-directory))
|
||||||
|
(doc-dir (expand-file-name slug docs-dir))
|
||||||
|
(metadata-filename (expand-file-name devdocs-browser--metadata-filename doc-dir))
|
||||||
|
(metadata nil)
|
||||||
|
(index-filename (expand-file-name devdocs-browser--index-json-filename doc-dir))
|
||||||
|
(index (devdocs-browser--read-json index-filename))
|
||||||
|
res)
|
||||||
|
(when (file-exists-p metadata-filename)
|
||||||
|
(with-temp-buffer
|
||||||
|
(insert-file-contents metadata-filename)
|
||||||
|
(setq metadata (read (current-buffer))))
|
||||||
|
(setq res (append `(:index ,index) metadata))
|
||||||
|
(setq devdocs-browser--docs-cache
|
||||||
|
(lax-plist-put devdocs-browser--docs-cache slug res)))
|
||||||
|
res)))
|
||||||
|
|
||||||
|
(defun devdocs-browser--download-offline-data-internal (doc)
|
||||||
|
"(re-)Download and extract offline data for DOC."
|
||||||
|
(let* ((slug (plist-get doc :slug))
|
||||||
|
(mtime (plist-get doc :mtime))
|
||||||
|
(docs-dir (expand-file-name devdocs-browser--docs-dir devdocs-browser-cache-directory))
|
||||||
|
(doc-dir (expand-file-name slug docs-dir))
|
||||||
|
(data-dir (expand-file-name devdocs-browser--offline-data-dir-name doc-dir))
|
||||||
|
success)
|
||||||
|
(unless (file-exists-p doc-dir)
|
||||||
|
(make-directory doc-dir t))
|
||||||
|
(when (file-exists-p data-dir)
|
||||||
|
(delete-directory data-dir t))
|
||||||
|
|
||||||
|
;; do not leave half-complete data directory
|
||||||
|
(unwind-protect
|
||||||
|
(let ((data (devdocs-browser--fetch-json
|
||||||
|
(format "%s/db.json?%s" slug mtime)
|
||||||
|
(expand-file-name devdocs-browser--offline-data-json-filename doc-dir)
|
||||||
|
devdocs-browser-doc-base-url)))
|
||||||
|
;; write data to files
|
||||||
|
(dolist (kv (seq-partition data 2))
|
||||||
|
(when-let* ((name (substring (symbol-name (car kv)) 1))
|
||||||
|
(value (cadr kv))
|
||||||
|
;; prepent "./" to fix paths starting with literal "~" (e.g. deno)
|
||||||
|
(path (expand-file-name (concat "./" name ".html") data-dir)))
|
||||||
|
(unless (file-exists-p (file-name-directory path))
|
||||||
|
(make-directory (file-name-directory path) t))
|
||||||
|
(write-region value nil path)))
|
||||||
|
(setq success t))
|
||||||
|
(unless success
|
||||||
|
(delete-directory data-dir t)))
|
||||||
|
|
||||||
|
(if success
|
||||||
|
(message "Installed devdocs offline data %s version %s" slug mtime)
|
||||||
|
(message "Failed to install devdocs offline data %s" slug))
|
||||||
|
|
||||||
|
success))
|
||||||
|
|
||||||
|
(defun devdocs-browser-offline-data-dir (slug)
|
||||||
|
"Return doc SLUG's offline data dir if present, return nil otherwise."
|
||||||
|
(let* ((docs-dir (expand-file-name devdocs-browser--docs-dir devdocs-browser-cache-directory))
|
||||||
|
(doc-dir (expand-file-name slug docs-dir))
|
||||||
|
(data-dir (expand-file-name devdocs-browser--offline-data-dir-name doc-dir)))
|
||||||
|
(when (file-exists-p data-dir)
|
||||||
|
(file-name-as-directory data-dir))))
|
||||||
|
|
||||||
|
(defun devdocs-browser-download-offline-data (slug)
|
||||||
|
"Download offline data for doc SLUG.
|
||||||
|
Offline data contains full content pages,
|
||||||
|
which allows you to view docs without Internet connection.
|
||||||
|
It may take some time to download offline data.
|
||||||
|
When called interactively, user can choose from the list."
|
||||||
|
(interactive (list (completing-read
|
||||||
|
"Install offline data: "
|
||||||
|
(seq-filter
|
||||||
|
(lambda (slug) (null (devdocs-browser-offline-data-dir slug)))
|
||||||
|
(devdocs-browser-list-installed-slugs))
|
||||||
|
nil t)))
|
||||||
|
(when-let* ((doc (devdocs-browser--load-doc slug)))
|
||||||
|
(devdocs-browser--download-offline-data-internal doc)))
|
||||||
|
|
||||||
|
(defun devdocs-browser-remove-offline-data (slug)
|
||||||
|
"Remove offline data for doc SLUG.
|
||||||
|
When called interactively, user can choose from the list."
|
||||||
|
(interactive (list (completing-read
|
||||||
|
"Remove offline data: "
|
||||||
|
(seq-filter
|
||||||
|
#'devdocs-browser-offline-data-dir
|
||||||
|
(devdocs-browser-list-installed-slugs))
|
||||||
|
nil t)))
|
||||||
|
(when-let* ((data-dir (devdocs-browser-offline-data-dir slug)))
|
||||||
|
(delete-directory data-dir t)))
|
||||||
|
|
||||||
|
(defun devdocs-browser--eww-open (doc path)
|
||||||
|
"Open PATH for document DOC using eww."
|
||||||
|
(let* ((slug (plist-get doc :slug))
|
||||||
|
(mtime (plist-get doc :mtime))
|
||||||
|
base-url url)
|
||||||
|
;; cannot use format directly because `path' may contains #query
|
||||||
|
;; path: hello/world#query
|
||||||
|
;; url for offline: file:///home/path/to/devdocs/python~3.8/hello/world.html#query
|
||||||
|
;; url for online: https://documents.devdocs.io/python~3.8/hello/world.html?161818817#query
|
||||||
|
(let ((offline-data-dir (devdocs-browser-offline-data-dir slug)))
|
||||||
|
(if offline-data-dir
|
||||||
|
(progn
|
||||||
|
(setq base-url (concat "file://" offline-data-dir))
|
||||||
|
(setq url (url-generic-parse-url (concat "file://" offline-data-dir path)))
|
||||||
|
(setf (url-filename url) (concat (url-filename url) ".html")))
|
||||||
|
(setq base-url (concat devdocs-browser-doc-base-url slug "/"))
|
||||||
|
(setq url (url-generic-parse-url
|
||||||
|
(concat devdocs-browser-doc-base-url slug "/" path)))
|
||||||
|
(setf (url-filename url)
|
||||||
|
(format "%s.html?%s" (url-filename url) mtime))))
|
||||||
|
|
||||||
|
(pop-to-buffer (format "*devdocs-%s*" slug))
|
||||||
|
(if devdocs-browser-eww-mode
|
||||||
|
(eww-save-history)
|
||||||
|
(eww-mode)
|
||||||
|
(devdocs-browser-eww-mode))
|
||||||
|
(setq-local devdocs-browser--eww-data
|
||||||
|
(list :doc doc
|
||||||
|
:base-url base-url))
|
||||||
|
|
||||||
|
(eww (url-recreate-url url))
|
||||||
|
(recenter)))
|
||||||
|
|
||||||
|
(defun devdocs-browser--default-active-slugs (&optional no-fallback-all)
|
||||||
|
"Default active doc slugs for current buffer, fallback to all slugs if not NO-FALLBACK-ALL."
|
||||||
|
(if devdocs-browser--eww-data
|
||||||
|
(list (plist-get (plist-get devdocs-browser--eww-data :doc) :slug))
|
||||||
|
(let ((names (or devdocs-browser-active-docs
|
||||||
|
(alist-get major-mode devdocs-browser-major-mode-docs-alist)))
|
||||||
|
slugs)
|
||||||
|
(dolist (name names)
|
||||||
|
(when-let* ((doc (devdocs-browser-find-installed-doc name))
|
||||||
|
(slug (plist-get doc :slug)))
|
||||||
|
(setq slugs (push slug slugs))))
|
||||||
|
(or slugs
|
||||||
|
(and (not no-fallback-all) (devdocs-browser-list-installed-slugs))))))
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(defun devdocs-browser-open-in (slug-or-name-list)
|
||||||
|
"Open entry in specified docs SLUG-OR-NAME-LIST.
|
||||||
|
When called interactively, user can choose from the list."
|
||||||
|
(interactive
|
||||||
|
(let ((def (devdocs-browser--default-active-slugs t)))
|
||||||
|
(list (completing-read-multiple
|
||||||
|
(concat "Select doc"
|
||||||
|
(when def (format " (default %s)" def))
|
||||||
|
": ")
|
||||||
|
(devdocs-browser-list-installed-slugs)
|
||||||
|
nil t nil nil def))))
|
||||||
|
|
||||||
|
(let ((current-word-regex
|
||||||
|
(when-let ((word (thing-at-point 'word t)))
|
||||||
|
(concat "\\<" (regexp-quote word) "\\>")))
|
||||||
|
slugs rows def)
|
||||||
|
(dolist (slug-or-name slug-or-name-list)
|
||||||
|
(when-let* ((doc-simple (devdocs-browser-find-installed-doc slug-or-name))
|
||||||
|
(slug (plist-get doc-simple :slug))
|
||||||
|
(doc (devdocs-browser--load-doc slug))
|
||||||
|
(index (plist-get doc :index))
|
||||||
|
(entries (plist-get index :entries)))
|
||||||
|
(setq slugs (push slug slugs))
|
||||||
|
(let ((new-rows
|
||||||
|
(mapcar
|
||||||
|
(lambda (entry)
|
||||||
|
(let* ((name (plist-get entry :name))
|
||||||
|
(path (plist-get entry :path))
|
||||||
|
(type (plist-get entry :type))
|
||||||
|
(title (concat slug ": " name)))
|
||||||
|
(when (and (null def) current-word-regex)
|
||||||
|
(when (string-match-p current-word-regex name)
|
||||||
|
(setq def title)))
|
||||||
|
(cons title `(:value (,doc ,path)
|
||||||
|
:group ,slug
|
||||||
|
:annotation ,type))))
|
||||||
|
entries)))
|
||||||
|
(setq rows (append new-rows rows))
|
||||||
|
(push (cons (format "%s: INDEX PAGE" slug)
|
||||||
|
`(:value (,doc "index")
|
||||||
|
:group ,slug))
|
||||||
|
rows))))
|
||||||
|
(let* ((selected-value
|
||||||
|
(devdocs-browser--completing-read
|
||||||
|
(format "Devdocs browser [%s]" (mapconcat #'identity slugs ","))
|
||||||
|
rows def)))
|
||||||
|
(when selected-value
|
||||||
|
(apply #'devdocs-browser--eww-open selected-value)))))
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(defun devdocs-browser-open ()
|
||||||
|
"Open entry in active docs.
|
||||||
|
Active docs are specified by `devdocs-browser-active-docs',
|
||||||
|
or `devdocs-browser-major-mode-docs-alist',
|
||||||
|
or the current doc type if called in a devdocs eww buffer.
|
||||||
|
When all of them are nil, all installed docs are used."
|
||||||
|
(interactive)
|
||||||
|
(devdocs-browser-open-in (devdocs-browser--default-active-slugs)))
|
||||||
|
|
||||||
|
|
||||||
|
(provide 'devdocs-browser)
|
||||||
|
;;; devdocs-browser.el ends here
|
|
@ -0,0 +1,27 @@
|
||||||
|
;;; dired-hacks-utils-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*-
|
||||||
|
;;
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
(add-to-list 'load-path (directory-file-name
|
||||||
|
(or (file-name-directory #$) (car load-path))))
|
||||||
|
|
||||||
|
|
||||||
|
;;;### (autoloads nil "dired-hacks-utils" "dired-hacks-utils.el"
|
||||||
|
;;;;;; (0 0 0 0))
|
||||||
|
;;; Generated autoloads from dired-hacks-utils.el
|
||||||
|
|
||||||
|
(register-definition-prefixes "dired-hacks-utils" '("dired-"))
|
||||||
|
|
||||||
|
;;;***
|
||||||
|
|
||||||
|
;;;### (autoloads nil nil ("dired-hacks-utils-pkg.el") (0 0 0 0))
|
||||||
|
|
||||||
|
;;;***
|
||||||
|
|
||||||
|
;; Local Variables:
|
||||||
|
;; version-control: never
|
||||||
|
;; no-byte-compile: t
|
||||||
|
;; no-update-autoloads: t
|
||||||
|
;; coding: utf-8
|
||||||
|
;; End:
|
||||||
|
;;; dired-hacks-utils-autoloads.el ends here
|
|
@ -0,0 +1,13 @@
|
||||||
|
(define-package "dired-hacks-utils" "20230512.1107" "Utilities and helpers for dired-hacks collection"
|
||||||
|
'((dash "2.5.0"))
|
||||||
|
:commit "523f51b4152a3bf4e60fe57f512732c698b5c96f" :authors
|
||||||
|
'(("Matúš Goljer" . "matus.goljer@gmail.com"))
|
||||||
|
:maintainers
|
||||||
|
'(("Matúš Goljer" . "matus.goljer@gmail.com"))
|
||||||
|
:maintainer
|
||||||
|
'("Matúš Goljer" . "matus.goljer@gmail.com")
|
||||||
|
:keywords
|
||||||
|
'("files"))
|
||||||
|
;; Local Variables:
|
||||||
|
;; no-byte-compile: t
|
||||||
|
;; End:
|
273
code/elpa/dired-hacks-utils-20230512.1107/dired-hacks-utils.el
Normal file
273
code/elpa/dired-hacks-utils-20230512.1107/dired-hacks-utils.el
Normal file
|
@ -0,0 +1,273 @@
|
||||||
|
;;; dired-hacks-utils.el --- Utilities and helpers for dired-hacks collection
|
||||||
|
|
||||||
|
;; Copyright (C) 2014-2015 Matúš Goljer
|
||||||
|
|
||||||
|
;; Author: Matúš Goljer <matus.goljer@gmail.com>
|
||||||
|
;; Maintainer: Matúš Goljer <matus.goljer@gmail.com>
|
||||||
|
;; Keywords: files
|
||||||
|
;; Version: 0.0.1
|
||||||
|
;; Created: 14th February 2014
|
||||||
|
;; Package-Requires: ((dash "2.5.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 <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
;;; Commentary:
|
||||||
|
|
||||||
|
;; Utilities and helpers for `dired-hacks' collection of dired
|
||||||
|
;; improvements.
|
||||||
|
|
||||||
|
;; This package also provides these interactive functions:
|
||||||
|
;; * `dired-hacks-next-file' - go to next file, skipping empty and non-file lines
|
||||||
|
;; * `dired-hacks-previous-file' - go to previous file, skipping empty
|
||||||
|
;; and non-file lines
|
||||||
|
;; * `dired-utils-format-information-line-mode' - Format the information
|
||||||
|
;; (summary) line file sizes to be human readable (e.g. 1GB instead of 1048576).
|
||||||
|
|
||||||
|
|
||||||
|
;; See https://github.com/Fuco1/dired-hacks for the entire collection
|
||||||
|
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
(require 'dash)
|
||||||
|
(require 'dired)
|
||||||
|
|
||||||
|
(defgroup dired-hacks ()
|
||||||
|
"Collection of useful dired additions."
|
||||||
|
:group 'dired
|
||||||
|
:prefix "dired-hacks-")
|
||||||
|
|
||||||
|
(defcustom dired-hacks-file-size-formatter #'file-size-human-readable
|
||||||
|
"The function used to format file sizes.
|
||||||
|
|
||||||
|
See `dired-utils-format-file-sizes'."
|
||||||
|
:type 'function
|
||||||
|
:group 'dired-hacks)
|
||||||
|
|
||||||
|
(defcustom dired-hacks-datetime-regexp
|
||||||
|
"\\sw\\sw\\sw....\\(?:[0-9][0-9]:[0-9][0-9]\\|.[0-9]\\{4\\}\\)"
|
||||||
|
"A regexp matching the date/time in the dired listing.
|
||||||
|
|
||||||
|
It is used to determine where the filename starts. It should
|
||||||
|
*not* match any characters after the last character of the
|
||||||
|
timestamp. It is assumed that the timestamp is preceded and
|
||||||
|
followed by at least one space character. You should only use
|
||||||
|
shy groups (prefixed with ?:) because the first group is used by
|
||||||
|
the font-lock to determine what portion of the name should be
|
||||||
|
colored."
|
||||||
|
:type 'regexp
|
||||||
|
:group 'dired-hacks)
|
||||||
|
|
||||||
|
(defalias 'dired-utils--string-trim
|
||||||
|
(if (and (require 'subr-x nil t)
|
||||||
|
(fboundp 'string-trim))
|
||||||
|
#'string-trim
|
||||||
|
(lambda (string)
|
||||||
|
(let ((s string))
|
||||||
|
(when (string-match "\\`[ \t\n\r]+" s)
|
||||||
|
(setq s (replace-match "" t t s)))
|
||||||
|
(when (string-match "[ \t\n\r]+\\'" s)
|
||||||
|
(setq s (replace-match "" t t s)))
|
||||||
|
s)))
|
||||||
|
"Trim STRING of trailing whitespace.
|
||||||
|
|
||||||
|
\(fn STRING)")
|
||||||
|
|
||||||
|
(defun dired-utils-get-filename (&optional localp)
|
||||||
|
"Like `dired-get-filename' but never signal an error.
|
||||||
|
|
||||||
|
Optional arg LOCALP with value `no-dir' means don't include
|
||||||
|
directory name in result."
|
||||||
|
(dired-get-filename localp t))
|
||||||
|
|
||||||
|
(defun dired-utils-get-all-files (&optional localp)
|
||||||
|
"Return all files in this dired buffer as a list.
|
||||||
|
|
||||||
|
LOCALP has same semantics as in `dired-get-filename'."
|
||||||
|
(save-excursion
|
||||||
|
(goto-char (point-min))
|
||||||
|
(let (r)
|
||||||
|
(while (= 0 (forward-line))
|
||||||
|
(--when-let (dired-utils-get-filename localp)
|
||||||
|
(push it r)))
|
||||||
|
(nreverse r))))
|
||||||
|
|
||||||
|
(defconst dired-utils-file-attributes-keywords
|
||||||
|
'(:isdir :nlinks :uid :gid :atime :mtime :ctime :size :modes :gidchg :inode :devnum)
|
||||||
|
"List of keywords to map with `file-attributes'.")
|
||||||
|
|
||||||
|
(defconst dired-utils-info-keywords
|
||||||
|
`(:name :issym :target ,@dired-utils-file-attributes-keywords)
|
||||||
|
"List of keywords available for `dired-utils-get-info'.")
|
||||||
|
|
||||||
|
(defun dired-utils--get-keyword-info (keyword)
|
||||||
|
"Get file information about KEYWORD."
|
||||||
|
(let ((filename (dired-utils-get-filename)))
|
||||||
|
(cl-case keyword
|
||||||
|
(:name filename)
|
||||||
|
(:isdir (file-directory-p filename))
|
||||||
|
(:issym (and (file-symlink-p filename) t))
|
||||||
|
(:target (file-symlink-p filename))
|
||||||
|
(t
|
||||||
|
(nth (-elem-index keyword dired-utils-file-attributes-keywords)
|
||||||
|
(file-attributes filename))))))
|
||||||
|
|
||||||
|
(defun dired-utils-get-info (&rest keywords)
|
||||||
|
"Query for info about the file at point.
|
||||||
|
|
||||||
|
KEYWORDS is a list of attributes to query.
|
||||||
|
|
||||||
|
When querying for one attribute, its value is returned. When
|
||||||
|
querying for more than one, a list of results is returned.
|
||||||
|
|
||||||
|
The available keywords are listed in
|
||||||
|
`dired-utils-info-keywords'."
|
||||||
|
(let ((attributes (mapcar 'dired-utils--get-keyword-info keywords)))
|
||||||
|
(if (> (length attributes) 1)
|
||||||
|
attributes
|
||||||
|
(car attributes))))
|
||||||
|
|
||||||
|
(defun dired-utils-goto-line (filename)
|
||||||
|
"Go to line describing FILENAME in listing.
|
||||||
|
|
||||||
|
Should be absolute file name matched against
|
||||||
|
`dired-get-filename'."
|
||||||
|
(goto-char (point-min))
|
||||||
|
(let (stop)
|
||||||
|
(while (and (not stop)
|
||||||
|
(= (forward-line) 0))
|
||||||
|
(when (equal filename (dired-utils-get-filename))
|
||||||
|
(setq stop t)
|
||||||
|
(dired-move-to-filename)))
|
||||||
|
stop))
|
||||||
|
|
||||||
|
(defun dired-utils-match-filename-regexp (filename alist)
|
||||||
|
"Match FILENAME against each car in ALIST and return first matched cons.
|
||||||
|
|
||||||
|
Each car in ALIST is a regular expression.
|
||||||
|
|
||||||
|
The matching is done using `string-match-p'."
|
||||||
|
(let (match)
|
||||||
|
(--each-while alist (not match)
|
||||||
|
(when (string-match-p (car it) filename)
|
||||||
|
(setq match it)))
|
||||||
|
match))
|
||||||
|
|
||||||
|
(defun dired-utils-match-filename-extension (filename alist)
|
||||||
|
"Match FILENAME against each car in ALIST and return first matched cons.
|
||||||
|
|
||||||
|
Each car in ALIST is a string representing file extension
|
||||||
|
*without* the delimiting dot."
|
||||||
|
(let (done)
|
||||||
|
(--each-while alist (not done)
|
||||||
|
(when (string-match-p (concat "\\." (regexp-quote (car it)) "\\'") filename)
|
||||||
|
(setq done it)))
|
||||||
|
done))
|
||||||
|
|
||||||
|
(defun dired-utils-format-information-line ()
|
||||||
|
"Format the disk space on the Dired information line."
|
||||||
|
(save-excursion
|
||||||
|
(goto-char (point-min))
|
||||||
|
(forward-line)
|
||||||
|
(let ((inhibit-read-only t)
|
||||||
|
(limit (line-end-position)))
|
||||||
|
(while (re-search-forward "\\(?:directory\\|available\\) \\(\\<[0-9]+$\\>\\)" nil t)
|
||||||
|
(replace-match
|
||||||
|
(save-match-data
|
||||||
|
(propertize (dired-utils--string-trim
|
||||||
|
(funcall dired-hacks-file-size-formatter
|
||||||
|
(* 1024 (string-to-number (match-string 1))) t))
|
||||||
|
'invisible 'dired-hide-details-information))
|
||||||
|
t nil nil 1)))))
|
||||||
|
|
||||||
|
|
||||||
|
;;; Predicates
|
||||||
|
(defun dired-utils-is-file-p ()
|
||||||
|
"Return non-nil if the line at point is a file or a directory."
|
||||||
|
(dired-utils-get-filename 'no-dir))
|
||||||
|
|
||||||
|
(defun dired-utils-is-dir-p ()
|
||||||
|
"Return non-nil if the line at point is a directory."
|
||||||
|
(--when-let (dired-utils-get-filename)
|
||||||
|
(file-directory-p it)))
|
||||||
|
|
||||||
|
|
||||||
|
;;; Interactive
|
||||||
|
;; TODO: add wrap-around option
|
||||||
|
(defun dired-hacks-next-file (&optional arg)
|
||||||
|
"Move point to the next file.
|
||||||
|
|
||||||
|
Optional prefix ARG says how many lines to move; default is one
|
||||||
|
line."
|
||||||
|
(interactive "p")
|
||||||
|
(unless arg (setq arg 1))
|
||||||
|
(if (< arg 0)
|
||||||
|
(dired-hacks-previous-file (- arg))
|
||||||
|
(--dotimes arg
|
||||||
|
(forward-line)
|
||||||
|
(while (and (or (not (dired-utils-is-file-p))
|
||||||
|
(get-text-property (point) 'invisible))
|
||||||
|
(= (forward-line) 0))))
|
||||||
|
(if (not (= (point) (point-max)))
|
||||||
|
(dired-move-to-filename)
|
||||||
|
(forward-line -1)
|
||||||
|
(dired-move-to-filename)
|
||||||
|
nil)))
|
||||||
|
|
||||||
|
(defun dired-hacks-previous-file (&optional arg)
|
||||||
|
"Move point to the previous file.
|
||||||
|
|
||||||
|
Optional prefix ARG says how many lines to move; default is one
|
||||||
|
line."
|
||||||
|
(interactive "p")
|
||||||
|
(unless arg (setq arg 1))
|
||||||
|
(if (< arg 0)
|
||||||
|
(dired-hacks-next-file (- arg))
|
||||||
|
(--dotimes arg
|
||||||
|
(forward-line -1)
|
||||||
|
(while (and (or (not (dired-utils-is-file-p))
|
||||||
|
(get-text-property (point) 'invisible))
|
||||||
|
(= (forward-line -1) 0))))
|
||||||
|
(if (not (= (point) (point-min)))
|
||||||
|
(dired-move-to-filename)
|
||||||
|
(dired-hacks-next-file)
|
||||||
|
nil)))
|
||||||
|
|
||||||
|
(defun dired-hacks-compare-files (file-a file-b)
|
||||||
|
"Test if two files FILE-A and FILE-B are the (probably) the same."
|
||||||
|
(interactive (let ((other-dir (dired-dwim-target-directory)))
|
||||||
|
(list (read-file-name "File A: " default-directory (car (dired-get-marked-files)) t)
|
||||||
|
(read-file-name "File B: " other-dir (with-current-buffer (cdr (assoc other-dir dired-buffers))
|
||||||
|
(car (dired-get-marked-files))) t))))
|
||||||
|
(let ((md5-a (with-temp-buffer
|
||||||
|
(shell-command (format "md5sum %s" file-a) (current-buffer))
|
||||||
|
(buffer-string)))
|
||||||
|
(md5-b (with-temp-buffer
|
||||||
|
(shell-command (format "md5sum %s" file-b) (current-buffer))
|
||||||
|
(buffer-string))))
|
||||||
|
(message "%s%sFiles are %s." md5-a md5-b
|
||||||
|
(if (equal (car (split-string md5-a))
|
||||||
|
(car (split-string md5-b)))
|
||||||
|
"probably the same" "different"))))
|
||||||
|
|
||||||
|
(define-minor-mode dired-utils-format-information-line-mode
|
||||||
|
"Toggle formatting of disk space in the Dired information line."
|
||||||
|
:group 'dired-utils
|
||||||
|
:lighter ""
|
||||||
|
(if dired-utils-format-information-line-mode
|
||||||
|
(add-hook 'dired-after-readin-hook #'dired-utils-format-information-line)
|
||||||
|
(remove-hook 'dired-after-readin-hook #'dired-utils-format-information-line)))
|
||||||
|
|
||||||
|
(provide 'dired-hacks-utils)
|
||||||
|
|
||||||
|
;;; dired-hacks-utils.el ends here
|
|
@ -0,0 +1,91 @@
|
||||||
|
;;; doom-modeline-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*-
|
||||||
|
;;
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
(add-to-list 'load-path (directory-file-name
|
||||||
|
(or (file-name-directory #$) (car load-path))))
|
||||||
|
|
||||||
|
|
||||||
|
;;;### (autoloads nil "doom-modeline" "doom-modeline.el" (0 0 0 0))
|
||||||
|
;;; Generated autoloads from doom-modeline.el
|
||||||
|
|
||||||
|
(autoload 'doom-modeline-set-main-modeline "doom-modeline" "\
|
||||||
|
Set main mode-line.
|
||||||
|
If DEFAULT is non-nil, set the default mode-line for all buffers.
|
||||||
|
|
||||||
|
\(fn &optional DEFAULT)" nil nil)
|
||||||
|
|
||||||
|
(defvar doom-modeline-mode nil "\
|
||||||
|
Non-nil if Doom-Modeline mode is enabled.
|
||||||
|
See the `doom-modeline-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 `doom-modeline-mode'.")
|
||||||
|
|
||||||
|
(custom-autoload 'doom-modeline-mode "doom-modeline" nil)
|
||||||
|
|
||||||
|
(autoload 'doom-modeline-mode "doom-modeline" "\
|
||||||
|
Toggle `doom-modeline' on or off.
|
||||||
|
|
||||||
|
This is a minor mode. If called interactively, toggle the
|
||||||
|
`Doom-Modeline 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 \\='doom-modeline-mode)'.
|
||||||
|
|
||||||
|
The mode's hook is called both when the mode is enabled and when
|
||||||
|
it is disabled.
|
||||||
|
|
||||||
|
\(fn &optional ARG)" t nil)
|
||||||
|
|
||||||
|
(register-definition-prefixes "doom-modeline" '("doom-modeline-"))
|
||||||
|
|
||||||
|
;;;***
|
||||||
|
|
||||||
|
;;;### (autoloads nil "doom-modeline-core" "doom-modeline-core.el"
|
||||||
|
;;;;;; (0 0 0 0))
|
||||||
|
;;; Generated autoloads from doom-modeline-core.el
|
||||||
|
|
||||||
|
(register-definition-prefixes "doom-modeline-core" '("doom-modeline"))
|
||||||
|
|
||||||
|
;;;***
|
||||||
|
|
||||||
|
;;;### (autoloads nil "doom-modeline-env" "doom-modeline-env.el"
|
||||||
|
;;;;;; (0 0 0 0))
|
||||||
|
;;; Generated autoloads from doom-modeline-env.el
|
||||||
|
(autoload 'doom-modeline-env-setup-python "doom-modeline-env")
|
||||||
|
(autoload 'doom-modeline-env-setup-ruby "doom-modeline-env")
|
||||||
|
(autoload 'doom-modeline-env-setup-perl "doom-modeline-env")
|
||||||
|
(autoload 'doom-modeline-env-setup-go "doom-modeline-env")
|
||||||
|
(autoload 'doom-modeline-env-setup-elixir "doom-modeline-env")
|
||||||
|
(autoload 'doom-modeline-env-setup-rust "doom-modeline-env")
|
||||||
|
|
||||||
|
(register-definition-prefixes "doom-modeline-env" '("doom-modeline-"))
|
||||||
|
|
||||||
|
;;;***
|
||||||
|
|
||||||
|
;;;### (autoloads nil "doom-modeline-segments" "doom-modeline-segments.el"
|
||||||
|
;;;;;; (0 0 0 0))
|
||||||
|
;;; Generated autoloads from doom-modeline-segments.el
|
||||||
|
|
||||||
|
(register-definition-prefixes "doom-modeline-segments" '("doom-modeline-"))
|
||||||
|
|
||||||
|
;;;***
|
||||||
|
|
||||||
|
;;;### (autoloads nil nil ("doom-modeline-pkg.el") (0 0 0 0))
|
||||||
|
|
||||||
|
;;;***
|
||||||
|
|
||||||
|
;; Local Variables:
|
||||||
|
;; version-control: never
|
||||||
|
;; no-byte-compile: t
|
||||||
|
;; no-update-autoloads: t
|
||||||
|
;; coding: utf-8
|
||||||
|
;; End:
|
||||||
|
;;; doom-modeline-autoloads.el ends here
|
1472
code/elpa/doom-modeline-20230726.1624/doom-modeline-core.el
Normal file
1472
code/elpa/doom-modeline-20230726.1624/doom-modeline-core.el
Normal file
File diff suppressed because it is too large
Load diff
276
code/elpa/doom-modeline-20230726.1624/doom-modeline-env.el
Normal file
276
code/elpa/doom-modeline-20230726.1624/doom-modeline-env.el
Normal file
|
@ -0,0 +1,276 @@
|
||||||
|
;;; doom-modeline-env.el --- A environment parser for doom-modeline -*- lexical-binding: t -*-
|
||||||
|
|
||||||
|
;; Copyright (C) 2019-2023 Vincent Zhang, Justin Barclay
|
||||||
|
|
||||||
|
;; This file is not part of GNU Emacs.
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; 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 <https://www.gnu.org/licenses/>.
|
||||||
|
;;
|
||||||
|
;;; Commentary:
|
||||||
|
;;
|
||||||
|
;; Parse programming environment.
|
||||||
|
;;
|
||||||
|
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
(require 'subr-x)
|
||||||
|
(require 'doom-modeline-core)
|
||||||
|
|
||||||
|
|
||||||
|
;; Externals
|
||||||
|
(defvar python-shell-interpreter)
|
||||||
|
|
||||||
|
|
||||||
|
;; Customization
|
||||||
|
|
||||||
|
(defgroup doom-modeline-env nil
|
||||||
|
"The environment parser for `doom-modeline'."
|
||||||
|
:group 'doom-modeline
|
||||||
|
:link '(url-link :tag "Homepage" "https://github.com/seagle0128/doom-modeline"))
|
||||||
|
|
||||||
|
(defcustom doom-modeline-env-load-string doom-modeline-ellipsis
|
||||||
|
"What to display as the version while a new one is being loaded."
|
||||||
|
:type 'string
|
||||||
|
:group 'doom-modeline-env)
|
||||||
|
|
||||||
|
(defcustom doom-modeline-before-update-env-hook nil
|
||||||
|
"Hooks that run before the modeline version string is updated."
|
||||||
|
:type 'hook
|
||||||
|
:group 'doom-modeline-env)
|
||||||
|
|
||||||
|
(defcustom doom-modeline-after-update-env-hook nil
|
||||||
|
"Hooks that run after the modeline version string is updated."
|
||||||
|
:type 'hook
|
||||||
|
:group 'doom-modeline-env)
|
||||||
|
|
||||||
|
|
||||||
|
;; Variables
|
||||||
|
|
||||||
|
;; Show version string for multi-version managers like rvm, rbenv, pyenv, etc.
|
||||||
|
(defvar-local doom-modeline-env--version nil
|
||||||
|
"The version to display with major-mode in mode-line.
|
||||||
|
Example: \"2.6.0\"")
|
||||||
|
|
||||||
|
(defvar-local doom-modeline-env--command nil
|
||||||
|
"A program that we're looking to extract version information from.
|
||||||
|
Example: \"ruby\"")
|
||||||
|
|
||||||
|
(defvar-local doom-modeline-env--command-args nil
|
||||||
|
"A list of arguments for the command to extract the version from.
|
||||||
|
Example: \\='(\"--version\")")
|
||||||
|
|
||||||
|
(defvar-local doom-modeline-env--parser nil
|
||||||
|
"A function that returns version number from a command --version (or similar).
|
||||||
|
Example: \\='doom-modeline-env--ruby")
|
||||||
|
|
||||||
|
|
||||||
|
;; Functions & Macros
|
||||||
|
|
||||||
|
(defun doom-modeline-update-env ()
|
||||||
|
"Update environment info on mode-line."
|
||||||
|
(when (and doom-modeline-env-version
|
||||||
|
doom-modeline-env--command
|
||||||
|
(executable-find doom-modeline-env--command)
|
||||||
|
doom-modeline-env--command-args
|
||||||
|
doom-modeline-env--parser)
|
||||||
|
(let ((default-directory (doom-modeline-project-root))
|
||||||
|
(buffer (current-buffer)))
|
||||||
|
(run-hooks 'doom-modeline-before-update-env-hook)
|
||||||
|
(setq doom-modeline-env--version doom-modeline-env-load-string)
|
||||||
|
(doom-modeline-env--get
|
||||||
|
doom-modeline-env--command
|
||||||
|
doom-modeline-env--command-args
|
||||||
|
(lambda (prog-version)
|
||||||
|
(with-current-buffer buffer
|
||||||
|
(setq doom-modeline-env--version
|
||||||
|
(funcall doom-modeline-env--parser prog-version))
|
||||||
|
(run-hooks 'doom-modeline-after-update-env-hook)))))))
|
||||||
|
|
||||||
|
(add-hook 'find-file-hook #'doom-modeline-update-env)
|
||||||
|
(with-no-warnings
|
||||||
|
(if (boundp 'after-focus-change-function)
|
||||||
|
(add-function
|
||||||
|
:after after-focus-change-function
|
||||||
|
(lambda ()
|
||||||
|
(if (frame-focus-state)
|
||||||
|
(doom-modeline-update-env))))
|
||||||
|
(add-hook 'focus-in-hook #'doom-modeline-update-env)))
|
||||||
|
|
||||||
|
(defun doom-modeline-env--get (prog args callback)
|
||||||
|
"Start a sub process using PROG and apply the ARGS to the sub process.
|
||||||
|
Once it receives information from STDOUT, it closes off the subprocess and
|
||||||
|
passes on the information into the CALLBACK.
|
||||||
|
Example:
|
||||||
|
(doom-modeline-env--get
|
||||||
|
\"ruby\"
|
||||||
|
\\='(\"--version\")
|
||||||
|
(lambda (line)
|
||||||
|
(message (doom-modeline-parser--ruby line)))"
|
||||||
|
(when-let ((proc (ignore-errors
|
||||||
|
(apply 'start-process
|
||||||
|
;; Flaten process-args into a single list so we can handle
|
||||||
|
;; variadic length args
|
||||||
|
(append
|
||||||
|
(list "doom-modeline-env" nil prog)
|
||||||
|
args))))
|
||||||
|
(parser callback))
|
||||||
|
(set-process-filter proc
|
||||||
|
(lambda (_proc line)
|
||||||
|
(ignore-errors
|
||||||
|
(funcall parser line))))))
|
||||||
|
|
||||||
|
(cl-defmacro doom-modeline-def-env (name &key hooks command parser)
|
||||||
|
"Define a handler for updating & displaying a version string for a language.
|
||||||
|
|
||||||
|
NAME is an unquoted symbol representing the handler's unique ID.
|
||||||
|
HOOKS is a list of hook symbols where this handler should be triggered.
|
||||||
|
COMMAND should be a function that returns a shell command and its arguments (as
|
||||||
|
a list). It is run on HOOKS. It takes no arguments.
|
||||||
|
PARSER should be a function for parsing COMMAND's output line-by-line, to
|
||||||
|
extract the version string."
|
||||||
|
(declare (indent defun))
|
||||||
|
(unless (and hooks command parser)
|
||||||
|
(error "'%s' env is missing either :hooks, :command or :parser" name))
|
||||||
|
(let ((parse-fn (intern (format "doom-modeline-env--%s-parse" name)))
|
||||||
|
(action-fn (intern (format "doom-modeline-env--%s-args" name)))
|
||||||
|
(setup-fn (intern (format "doom-modeline-env-setup-%s" name)))
|
||||||
|
(update-fn (intern (format "doom-modeline-env-update-%s" name)))
|
||||||
|
(enable-var (intern (format "doom-modeline-env-enable-%s" name)))
|
||||||
|
(command-var (intern (format "doom-modeline-env-%s-command" name)))
|
||||||
|
(parser-var (intern (format "doom-modeline-env-%s-parser-fn" name)))
|
||||||
|
(exe-var (intern (format "doom-modeline-env-%s-executable" name))))
|
||||||
|
(macroexp-progn
|
||||||
|
`((defcustom ,enable-var t
|
||||||
|
,(format "Whether to display the version string for %s buffers." name)
|
||||||
|
:type 'boolean
|
||||||
|
:group 'doom-modeline-env)
|
||||||
|
(defvar ,command-var ',action-fn
|
||||||
|
,(concat "A function that returns the shell command and arguments (as a list) to\n"
|
||||||
|
"produce a version string."))
|
||||||
|
(defvar ,parser-var ',parse-fn
|
||||||
|
,(format "The function to parse each line of `%s'\'s output." command-var))
|
||||||
|
(defcustom ,exe-var nil
|
||||||
|
,(format (concat "What executable to use for the version indicator in %s buffers.\n\n"
|
||||||
|
"If nil, the default binary for this language is used.")
|
||||||
|
name)
|
||||||
|
:type 'string
|
||||||
|
:group 'doom-modeline-env)
|
||||||
|
(defalias ',parse-fn ,parser
|
||||||
|
(format "The line parser for %s buffers.\n\nUsed by `%s'."
|
||||||
|
',name ',update-fn))
|
||||||
|
(defalias ',action-fn ,command
|
||||||
|
(format "The command resolver for %s buffers.\n\nUsed by `%s'."
|
||||||
|
',name ',update-fn))
|
||||||
|
(defalias ',setup-fn
|
||||||
|
(lambda ()
|
||||||
|
(if enable-local-variables
|
||||||
|
(add-hook 'hack-local-variables-hook #',update-fn nil t)
|
||||||
|
(,update-fn)))
|
||||||
|
(format "Prepares the modeline to later display the %s version string."
|
||||||
|
',name))
|
||||||
|
(defalias ',update-fn
|
||||||
|
(lambda ()
|
||||||
|
(when ,enable-var
|
||||||
|
(when-let* ((command-list (funcall ,command-var))
|
||||||
|
(exe (executable-find (car command-list))))
|
||||||
|
(setq doom-modeline-env--command exe
|
||||||
|
doom-modeline-env--command-args (cdr command-list)
|
||||||
|
doom-modeline-env--parser ,parser-var)
|
||||||
|
(doom-modeline-update-env))))
|
||||||
|
(format "Updates the %s version string in the modeline." ',name))
|
||||||
|
(let ((hooks ',(eval hooks)))
|
||||||
|
(dolist (hook (if (listp hooks) hooks (list hooks)))
|
||||||
|
(add-hook hook #',setup-fn)))))))
|
||||||
|
|
||||||
|
|
||||||
|
;; Bootstrap
|
||||||
|
;; Versions, support Python, Ruby, Perl and Golang, etc.
|
||||||
|
|
||||||
|
;;;###autoload (autoload 'doom-modeline-env-setup-python "doom-modeline-env")
|
||||||
|
(doom-modeline-def-env python
|
||||||
|
:hooks 'python-mode-hook
|
||||||
|
:command (lambda () (cond ((and (fboundp 'pipenv-project-p)
|
||||||
|
(pipenv-project-p))
|
||||||
|
(list "pipenv" "run"
|
||||||
|
(or doom-modeline-env-python-executable
|
||||||
|
python-shell-interpreter
|
||||||
|
"python")
|
||||||
|
"--version"))
|
||||||
|
((executable-find "pyenv") (list "pyenv" "version-name"))
|
||||||
|
((list (or doom-modeline-env-python-executable
|
||||||
|
python-shell-interpreter
|
||||||
|
"python")
|
||||||
|
"--version"))))
|
||||||
|
:parser (lambda (line) (let ((version (split-string line)))
|
||||||
|
(if (length> version 1)
|
||||||
|
(cadr version)
|
||||||
|
(car version)))))
|
||||||
|
|
||||||
|
;;;###autoload (autoload 'doom-modeline-env-setup-ruby "doom-modeline-env")
|
||||||
|
(doom-modeline-def-env ruby
|
||||||
|
:hooks '(ruby-mode-hook enh-ruby-mode-hook)
|
||||||
|
:command (lambda () (list (or doom-modeline-env-ruby-executable "ruby") "--version"))
|
||||||
|
:parser (lambda (line)
|
||||||
|
(car (split-string
|
||||||
|
(cadr
|
||||||
|
(split-string line))
|
||||||
|
"p"))))
|
||||||
|
|
||||||
|
;;;###autoload (autoload 'doom-modeline-env-setup-perl "doom-modeline-env")
|
||||||
|
(doom-modeline-def-env perl
|
||||||
|
:hooks 'perl-mode-hook
|
||||||
|
:command (lambda () (list (or doom-modeline-env-perl-executable "perl") "--version"))
|
||||||
|
:parser (lambda (line)
|
||||||
|
(cadr
|
||||||
|
(split-string
|
||||||
|
(car
|
||||||
|
(split-string
|
||||||
|
(cadr
|
||||||
|
(split-string line "("))
|
||||||
|
")"))
|
||||||
|
"v"))))
|
||||||
|
|
||||||
|
;;;###autoload (autoload 'doom-modeline-env-setup-go "doom-modeline-env")
|
||||||
|
(doom-modeline-def-env go
|
||||||
|
:hooks 'go-mode-hook
|
||||||
|
:command (lambda () (list (or doom-modeline-env-go-executable "go") "version"))
|
||||||
|
:parser (lambda (line)
|
||||||
|
(cadr
|
||||||
|
(split-string
|
||||||
|
(cadr
|
||||||
|
(cdr
|
||||||
|
(split-string line)))
|
||||||
|
"go"))))
|
||||||
|
|
||||||
|
;;;###autoload (autoload 'doom-modeline-env-setup-elixir "doom-modeline-env")
|
||||||
|
(doom-modeline-def-env elixir
|
||||||
|
:hooks 'elixir-mode-hook
|
||||||
|
:command (lambda () (list (or doom-modeline-env-elixir-executable "elixir") "--version"))
|
||||||
|
:parser (lambda (line) (cadr (split-string line))))
|
||||||
|
|
||||||
|
;;;###autoload (autoload 'doom-modeline-env-setup-rust "doom-modeline-env")
|
||||||
|
(doom-modeline-def-env rust
|
||||||
|
:hooks 'rust-mode-hook
|
||||||
|
:command (lambda () (list (or doom-modeline-env-rust-executable "rustc") "--version"))
|
||||||
|
:parser (lambda (line)
|
||||||
|
(car
|
||||||
|
(split-string
|
||||||
|
(cadr
|
||||||
|
(split-string line))
|
||||||
|
"-"))))
|
||||||
|
|
||||||
|
(provide 'doom-modeline-env)
|
||||||
|
|
||||||
|
;;; doom-modeline-env.el ends here
|
17
code/elpa/doom-modeline-20230726.1624/doom-modeline-pkg.el
Normal file
17
code/elpa/doom-modeline-20230726.1624/doom-modeline-pkg.el
Normal file
|
@ -0,0 +1,17 @@
|
||||||
|
(define-package "doom-modeline" "20230726.1624" "A minimal and modern mode-line"
|
||||||
|
'((emacs "25.1")
|
||||||
|
(compat "28.1.1.1")
|
||||||
|
(nerd-icons "0.0.1")
|
||||||
|
(shrink-path "0.2.0"))
|
||||||
|
:commit "59c18bc343b850617c4eaddc0d3a696bed9cdc80" :authors
|
||||||
|
'(("Vincent Zhang" . "seagle0128@gmail.com"))
|
||||||
|
:maintainers
|
||||||
|
'(("Vincent Zhang" . "seagle0128@gmail.com"))
|
||||||
|
:maintainer
|
||||||
|
'("Vincent Zhang" . "seagle0128@gmail.com")
|
||||||
|
:keywords
|
||||||
|
'("faces" "mode-line")
|
||||||
|
:url "https://github.com/seagle0128/doom-modeline")
|
||||||
|
;; Local Variables:
|
||||||
|
;; no-byte-compile: t
|
||||||
|
;; End:
|
3096
code/elpa/doom-modeline-20230726.1624/doom-modeline-segments.el
Normal file
3096
code/elpa/doom-modeline-20230726.1624/doom-modeline-segments.el
Normal file
File diff suppressed because it is too large
Load diff
249
code/elpa/doom-modeline-20230726.1624/doom-modeline.el
Normal file
249
code/elpa/doom-modeline-20230726.1624/doom-modeline.el
Normal file
|
@ -0,0 +1,249 @@
|
||||||
|
;;; doom-modeline.el --- A minimal and modern mode-line -*- lexical-binding: t; -*-
|
||||||
|
|
||||||
|
;; Copyright (C) 2018-2023 Vincent Zhang
|
||||||
|
|
||||||
|
;; Author: Vincent Zhang <seagle0128@gmail.com>
|
||||||
|
;; Homepage: https://github.com/seagle0128/doom-modeline
|
||||||
|
;; Version: 4.0.0
|
||||||
|
;; Package-Requires: ((emacs "25.1") (compat "28.1.1.1") (nerd-icons "0.0.1") (shrink-path "0.2.0"))
|
||||||
|
;; Keywords: faces mode-line
|
||||||
|
|
||||||
|
;; This file is not part of GNU Emacs.
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; 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 <https://www.gnu.org/licenses/>.
|
||||||
|
;;
|
||||||
|
|
||||||
|
;;; Commentary:
|
||||||
|
;;
|
||||||
|
;; This package offers a fancy and fast mode-line inspired by minimalism design.
|
||||||
|
;;
|
||||||
|
;; It's integrated into Doom Emacs (https://github.com/hlissner/doom-emacs) and
|
||||||
|
;; Centaur Emacs (https://github.com/seagle0128/.emacs.d).
|
||||||
|
;;
|
||||||
|
;; The doom-modeline offers:
|
||||||
|
;; - A match count panel (for anzu, iedit, multiple-cursors, symbol-overlay,
|
||||||
|
;; evil-search and evil-substitute)
|
||||||
|
;; - An indicator for recording a macro
|
||||||
|
;; - Current environment version (e.g. python, ruby, go, etc.) in the major-mode
|
||||||
|
;; - A customizable mode-line height (see doom-modeline-height)
|
||||||
|
;; - A minor modes segment which is compatible with minions
|
||||||
|
;; - An error/warning count segment for flymake/flycheck
|
||||||
|
;; - A workspace number segment for eyebrowse
|
||||||
|
;; - A perspective name segment for persp-mode
|
||||||
|
;; - A window number segment for winum and window-numbering
|
||||||
|
;; - An indicator for modal editing state, including evil, overwrite, god, ryo
|
||||||
|
;; and xah-fly-keys, etc.
|
||||||
|
;; - An indicator for battery status
|
||||||
|
;; - An indicator for current input method
|
||||||
|
;; - An indicator for debug state
|
||||||
|
;; - An indicator for remote host
|
||||||
|
;; - An indicator for LSP state with lsp-mode or eglot
|
||||||
|
;; - An indicator for github notifications
|
||||||
|
;; - An indicator for unread emails with mu4e-alert
|
||||||
|
;; - An indicator for unread emails with gnus (basically builtin)
|
||||||
|
;; - An indicator for irc notifications with circe, rcirc or erc.
|
||||||
|
;; - An indicator for buffer position which is compatible with nyan-mode or poke-line
|
||||||
|
;; - An indicator for party parrot
|
||||||
|
;; - An indicator for PDF page number with pdf-tools
|
||||||
|
;; - An indicator for markdown/org previews with grip
|
||||||
|
;; - Truncated file name, file icon, buffer state and project name in buffer
|
||||||
|
;; information segment, which is compatible with project, find-file-in-project
|
||||||
|
;; and projectile
|
||||||
|
;; - New mode-line for Info-mode buffers
|
||||||
|
;; - New package mode-line for paradox
|
||||||
|
;; - New mode-line for helm buffers
|
||||||
|
;; - New mode-line for git-timemachine buffers
|
||||||
|
;;
|
||||||
|
;; Installation:
|
||||||
|
;; From melpa, `M-x package-install RET doom-modeline RET`.
|
||||||
|
;; In `init.el`,
|
||||||
|
;; (require 'doom-modeline)
|
||||||
|
;; (doom-modeline-mode 1)
|
||||||
|
;; or
|
||||||
|
;; (use-package doom-modeline
|
||||||
|
;; :ensure t
|
||||||
|
;; :hook (after-init . doom-modeline-mode))
|
||||||
|
;;
|
||||||
|
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
(require 'doom-modeline-core)
|
||||||
|
(require 'doom-modeline-segments)
|
||||||
|
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; Mode lines
|
||||||
|
;;
|
||||||
|
|
||||||
|
(doom-modeline-def-modeline 'main
|
||||||
|
'(bar workspace-name window-number modals matches follow buffer-info remote-host buffer-position word-count parrot selection-info)
|
||||||
|
'(compilation objed-state misc-info persp-name battery grip irc mu4e gnus github debug repl lsp minor-modes input-method indent-info buffer-encoding major-mode process vcs checker time))
|
||||||
|
|
||||||
|
(doom-modeline-def-modeline 'minimal
|
||||||
|
'(bar matches buffer-info-simple)
|
||||||
|
'(media-info major-mode time))
|
||||||
|
|
||||||
|
(doom-modeline-def-modeline 'special
|
||||||
|
'(bar window-number modals matches buffer-info remote-host buffer-position word-count parrot selection-info)
|
||||||
|
'(compilation objed-state misc-info battery irc-buffers debug minor-modes input-method indent-info buffer-encoding major-mode process time))
|
||||||
|
|
||||||
|
(doom-modeline-def-modeline 'project
|
||||||
|
'(bar window-number modals buffer-default-directory remote-host buffer-position)
|
||||||
|
'(compilation misc-info battery irc mu4e gnus github debug minor-modes input-method major-mode process time))
|
||||||
|
|
||||||
|
(doom-modeline-def-modeline 'dashboard
|
||||||
|
'(bar window-number buffer-default-directory-simple remote-host)
|
||||||
|
'(compilation misc-info battery irc mu4e gnus github debug minor-modes input-method major-mode process time))
|
||||||
|
|
||||||
|
(doom-modeline-def-modeline 'vcs
|
||||||
|
'(bar window-number modals matches buffer-info remote-host buffer-position parrot selection-info)
|
||||||
|
'(compilation misc-info battery irc mu4e gnus github debug minor-modes buffer-encoding major-mode process time))
|
||||||
|
|
||||||
|
(doom-modeline-def-modeline 'package
|
||||||
|
'(bar window-number package)
|
||||||
|
'(compilation misc-info major-mode process time))
|
||||||
|
|
||||||
|
(doom-modeline-def-modeline 'info
|
||||||
|
'(bar window-number buffer-info info-nodes buffer-position parrot selection-info)
|
||||||
|
'(compilation misc-info buffer-encoding major-mode time))
|
||||||
|
|
||||||
|
(doom-modeline-def-modeline 'media
|
||||||
|
'(bar window-number buffer-size buffer-info)
|
||||||
|
'(compilation misc-info media-info major-mode process vcs time))
|
||||||
|
|
||||||
|
(doom-modeline-def-modeline 'message
|
||||||
|
'(bar window-number modals matches buffer-info-simple buffer-position word-count parrot selection-info)
|
||||||
|
'(compilation objed-state misc-info battery debug minor-modes input-method indent-info buffer-encoding major-mode time))
|
||||||
|
|
||||||
|
(doom-modeline-def-modeline 'pdf
|
||||||
|
'(bar window-number matches buffer-info pdf-pages)
|
||||||
|
'(compilation misc-info major-mode process vcs time))
|
||||||
|
|
||||||
|
(doom-modeline-def-modeline 'org-src
|
||||||
|
'(bar window-number modals matches buffer-info buffer-position word-count parrot selection-info)
|
||||||
|
'(compilation objed-state misc-info debug lsp minor-modes input-method indent-info buffer-encoding major-mode process checker time))
|
||||||
|
|
||||||
|
(doom-modeline-def-modeline 'helm
|
||||||
|
'(bar helm-buffer-id helm-number helm-follow helm-prefix-argument)
|
||||||
|
'(helm-help time))
|
||||||
|
|
||||||
|
(doom-modeline-def-modeline 'timemachine
|
||||||
|
'(bar window-number modals matches git-timemachine buffer-position word-count parrot selection-info)
|
||||||
|
'(misc-info minor-modes indent-info buffer-encoding major-mode time))
|
||||||
|
|
||||||
|
(doom-modeline-def-modeline 'calculator
|
||||||
|
'(window-number modals matches calc buffer-position)
|
||||||
|
'(misc-info minor-modes major-mode process))
|
||||||
|
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; Interfaces
|
||||||
|
;;
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(defun doom-modeline-set-main-modeline (&optional default)
|
||||||
|
"Set main mode-line.
|
||||||
|
If DEFAULT is non-nil, set the default mode-line for all buffers."
|
||||||
|
(doom-modeline-set-modeline 'main default))
|
||||||
|
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; Minor mode
|
||||||
|
;;
|
||||||
|
|
||||||
|
;; Suppress warnings
|
||||||
|
(defvar 2C-mode-line-format)
|
||||||
|
(defvar helm-ag-show-status-function)
|
||||||
|
(declare-function helm-display-mode-line "ext:helm-core")
|
||||||
|
|
||||||
|
(defvar doom-modeline-mode-map (make-sparse-keymap))
|
||||||
|
|
||||||
|
(defvar doom-modeline-mode-alist
|
||||||
|
'((message-mode . message)
|
||||||
|
(git-commit-mode . message)
|
||||||
|
(magit-mode . vcs)
|
||||||
|
(dashboard-mode . dashboard)
|
||||||
|
(Info-mode . info)
|
||||||
|
(image-mode . media)
|
||||||
|
(pdf-view-mode . pdf)
|
||||||
|
(org-src-mode . org-src)
|
||||||
|
(paradox-menu-mode . package)
|
||||||
|
(xwidget-webkit-mode . minimal)
|
||||||
|
(git-timemachine-mode . timemachine)
|
||||||
|
(calc-mode . calculator)
|
||||||
|
(calc-trail-mode . calculator)
|
||||||
|
(circe-mode . special)
|
||||||
|
(erc-mode . special)
|
||||||
|
(rcirc-mode . special))
|
||||||
|
"Alist of major modes and mode-lines.")
|
||||||
|
|
||||||
|
(defun doom-modeline-auto-set-modeline ()
|
||||||
|
"Set mode-line base on major-mode."
|
||||||
|
(catch 'found
|
||||||
|
(dolist (x doom-modeline-mode-alist)
|
||||||
|
(when (derived-mode-p (car x))
|
||||||
|
(doom-modeline-set-modeline (cdr x))
|
||||||
|
(throw 'found x)))))
|
||||||
|
|
||||||
|
(defun doom-modeline-set-helm-modeline (&rest _) ; To advice helm
|
||||||
|
"Set helm mode-line."
|
||||||
|
(doom-modeline-set-modeline 'helm))
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(define-minor-mode doom-modeline-mode
|
||||||
|
"Toggle `doom-modeline' on or off."
|
||||||
|
:group 'doom-modeline
|
||||||
|
:global t
|
||||||
|
:lighter nil
|
||||||
|
:keymap doom-modeline-mode-map
|
||||||
|
(if doom-modeline-mode
|
||||||
|
(progn
|
||||||
|
(doom-modeline-refresh-bars) ; Create bars
|
||||||
|
(doom-modeline-set-main-modeline t) ; Set default mode-line
|
||||||
|
|
||||||
|
;; Apply to all existing buffers.
|
||||||
|
(dolist (buf (buffer-list))
|
||||||
|
(with-current-buffer buf
|
||||||
|
(unless (doom-modeline-auto-set-modeline)
|
||||||
|
(doom-modeline-set-main-modeline))))
|
||||||
|
|
||||||
|
;; For two-column editing
|
||||||
|
(setq 2C-mode-line-format (doom-modeline 'special))
|
||||||
|
|
||||||
|
;; Automatically set mode-lines
|
||||||
|
(add-hook 'after-change-major-mode-hook #'doom-modeline-auto-set-modeline)
|
||||||
|
|
||||||
|
;; Special handles
|
||||||
|
(advice-add #'helm-display-mode-line :after #'doom-modeline-set-helm-modeline)
|
||||||
|
(setq helm-ag-show-status-function #'doom-modeline-set-helm-modeline))
|
||||||
|
(progn
|
||||||
|
;; Restore mode-line
|
||||||
|
(let ((original-format (doom-modeline--original-value 'mode-line-format)))
|
||||||
|
(setq-default mode-line-format original-format)
|
||||||
|
(dolist (buf (buffer-list))
|
||||||
|
(with-current-buffer buf
|
||||||
|
(setq mode-line-format original-format))))
|
||||||
|
|
||||||
|
;; For two-column editing
|
||||||
|
(setq 2C-mode-line-format (doom-modeline--original-value '2C-mode-line-format))
|
||||||
|
|
||||||
|
;; Cleanup
|
||||||
|
(remove-hook 'after-change-major-mode-hook #'doom-modeline-auto-set-modeline)
|
||||||
|
(advice-remove #'helm-display-mode-line #'doom-modeline-set-helm-modeline)
|
||||||
|
(setq helm-ag-show-status-function (default-value 'helm-ag-show-status-function)))))
|
||||||
|
|
||||||
|
(provide 'doom-modeline)
|
||||||
|
|
||||||
|
;;; doom-modeline.el ends here
|
72
code/elpa/elisp-refs-20230419.405/elisp-refs-autoloads.el
Normal file
72
code/elpa/elisp-refs-20230419.405/elisp-refs-autoloads.el
Normal file
|
@ -0,0 +1,72 @@
|
||||||
|
;;; elisp-refs-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*-
|
||||||
|
;;
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
(add-to-list 'load-path (directory-file-name
|
||||||
|
(or (file-name-directory #$) (car load-path))))
|
||||||
|
|
||||||
|
|
||||||
|
;;;### (autoloads nil "elisp-refs" "elisp-refs.el" (0 0 0 0))
|
||||||
|
;;; Generated autoloads from elisp-refs.el
|
||||||
|
|
||||||
|
(autoload 'elisp-refs-function "elisp-refs" "\
|
||||||
|
Display all the references to function SYMBOL, in all loaded
|
||||||
|
elisp files.
|
||||||
|
|
||||||
|
If called with a prefix, prompt for a directory to limit the search.
|
||||||
|
|
||||||
|
This searches for functions, not macros. For that, see
|
||||||
|
`elisp-refs-macro'.
|
||||||
|
|
||||||
|
\(fn SYMBOL &optional PATH-PREFIX)" t nil)
|
||||||
|
|
||||||
|
(autoload 'elisp-refs-macro "elisp-refs" "\
|
||||||
|
Display all the references to macro SYMBOL, in all loaded
|
||||||
|
elisp files.
|
||||||
|
|
||||||
|
If called with a prefix, prompt for a directory to limit the search.
|
||||||
|
|
||||||
|
This searches for macros, not functions. For that, see
|
||||||
|
`elisp-refs-function'.
|
||||||
|
|
||||||
|
\(fn SYMBOL &optional PATH-PREFIX)" t nil)
|
||||||
|
|
||||||
|
(autoload 'elisp-refs-special "elisp-refs" "\
|
||||||
|
Display all the references to special form SYMBOL, in all loaded
|
||||||
|
elisp files.
|
||||||
|
|
||||||
|
If called with a prefix, prompt for a directory to limit the search.
|
||||||
|
|
||||||
|
\(fn SYMBOL &optional PATH-PREFIX)" t nil)
|
||||||
|
|
||||||
|
(autoload 'elisp-refs-variable "elisp-refs" "\
|
||||||
|
Display all the references to variable SYMBOL, in all loaded
|
||||||
|
elisp files.
|
||||||
|
|
||||||
|
If called with a prefix, prompt for a directory to limit the search.
|
||||||
|
|
||||||
|
\(fn SYMBOL &optional PATH-PREFIX)" t nil)
|
||||||
|
|
||||||
|
(autoload 'elisp-refs-symbol "elisp-refs" "\
|
||||||
|
Display all the references to SYMBOL in all loaded elisp files.
|
||||||
|
|
||||||
|
If called with a prefix, prompt for a directory to limit the
|
||||||
|
search.
|
||||||
|
|
||||||
|
\(fn SYMBOL &optional PATH-PREFIX)" t nil)
|
||||||
|
|
||||||
|
(register-definition-prefixes "elisp-refs" '("elisp-"))
|
||||||
|
|
||||||
|
;;;***
|
||||||
|
|
||||||
|
;;;### (autoloads nil nil ("elisp-refs-pkg.el") (0 0 0 0))
|
||||||
|
|
||||||
|
;;;***
|
||||||
|
|
||||||
|
;; Local Variables:
|
||||||
|
;; version-control: never
|
||||||
|
;; no-byte-compile: t
|
||||||
|
;; no-update-autoloads: t
|
||||||
|
;; coding: utf-8
|
||||||
|
;; End:
|
||||||
|
;;; elisp-refs-autoloads.el ends here
|
14
code/elpa/elisp-refs-20230419.405/elisp-refs-pkg.el
Normal file
14
code/elpa/elisp-refs-20230419.405/elisp-refs-pkg.el
Normal file
|
@ -0,0 +1,14 @@
|
||||||
|
(define-package "elisp-refs" "20230419.405" "find callers of elisp functions or macros"
|
||||||
|
'((dash "2.12.0")
|
||||||
|
(s "1.11.0"))
|
||||||
|
:commit "bf3cca8f74065b1b31036f461e3a093b162311bd" :authors
|
||||||
|
'(("Wilfred Hughes" . "me@wilfred.me.uk"))
|
||||||
|
:maintainers
|
||||||
|
'(("Wilfred Hughes" . "me@wilfred.me.uk"))
|
||||||
|
:maintainer
|
||||||
|
'("Wilfred Hughes" . "me@wilfred.me.uk")
|
||||||
|
:keywords
|
||||||
|
'("lisp"))
|
||||||
|
;; Local Variables:
|
||||||
|
;; no-byte-compile: t
|
||||||
|
;; End:
|
913
code/elpa/elisp-refs-20230419.405/elisp-refs.el
Normal file
913
code/elpa/elisp-refs-20230419.405/elisp-refs.el
Normal file
|
@ -0,0 +1,913 @@
|
||||||
|
;;; elisp-refs.el --- find callers of elisp functions or macros -*- lexical-binding: t; -*-
|
||||||
|
|
||||||
|
;; Copyright (C) 2016-2020 Wilfred Hughes <me@wilfred.me.uk>
|
||||||
|
|
||||||
|
;; Author: Wilfred Hughes <me@wilfred.me.uk>
|
||||||
|
;; Version: 1.6
|
||||||
|
;; Keywords: lisp
|
||||||
|
;; Package-Requires: ((dash "2.12.0") (s "1.11.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 <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
;;; Commentary:
|
||||||
|
|
||||||
|
;; elisp-refs.el is an Emacs package for finding references to
|
||||||
|
;; functions, macros or variables. Unlike a dumb text search,
|
||||||
|
;; elisp-refs.el actually parses the code, so it's never confused by
|
||||||
|
;; comments or `foo-bar' matching `foo'.
|
||||||
|
;;
|
||||||
|
;; See https://github.com/Wilfred/refs.el/blob/master/README.md for
|
||||||
|
;; more information.
|
||||||
|
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
(require 'dash)
|
||||||
|
(require 's)
|
||||||
|
(require 'format)
|
||||||
|
(eval-when-compile (require 'cl-lib))
|
||||||
|
|
||||||
|
(defvar symbols-with-pos-enabled)
|
||||||
|
(declare-function symbol-with-pos-p nil (object))
|
||||||
|
(declare-function symbol-with-pos-pos nil (ls))
|
||||||
|
|
||||||
|
;;; Internal
|
||||||
|
|
||||||
|
(defvar elisp-refs-verbose t)
|
||||||
|
|
||||||
|
(defun elisp-refs--format-int (integer)
|
||||||
|
"Format INTEGER as a string, with , separating thousands."
|
||||||
|
(let ((number (abs integer))
|
||||||
|
(parts nil))
|
||||||
|
(while (> number 999)
|
||||||
|
(push (format "%03d" (mod number 1000))
|
||||||
|
parts)
|
||||||
|
(setq number (/ number 1000)))
|
||||||
|
(push (format "%d" number) parts)
|
||||||
|
(concat
|
||||||
|
(if (< integer 0) "-" "")
|
||||||
|
(s-join "," parts))))
|
||||||
|
|
||||||
|
(defsubst elisp-refs--start-pos (end-pos)
|
||||||
|
"Find the start position of form ending at END-POS
|
||||||
|
in the current buffer."
|
||||||
|
(let ((parse-sexp-ignore-comments t))
|
||||||
|
(scan-sexps end-pos -1)))
|
||||||
|
|
||||||
|
(defun elisp-refs--sexp-positions (buffer start-pos end-pos)
|
||||||
|
"Return a list of start and end positions of all the sexps
|
||||||
|
between START-POS and END-POS (inclusive) in BUFFER.
|
||||||
|
|
||||||
|
Positions exclude quote characters, so given 'foo or `foo, we
|
||||||
|
report the position of the symbol foo.
|
||||||
|
|
||||||
|
Not recursive, so we don't consider subelements of nested sexps."
|
||||||
|
(let ((positions nil))
|
||||||
|
(with-current-buffer buffer
|
||||||
|
(condition-case _err
|
||||||
|
(catch 'done
|
||||||
|
(while t
|
||||||
|
(let* ((sexp-end-pos (let ((parse-sexp-ignore-comments t))
|
||||||
|
(scan-sexps start-pos 1))))
|
||||||
|
;; If we've reached a sexp beyond the range requested,
|
||||||
|
;; or if there are no sexps left, we're done.
|
||||||
|
(when (or (null sexp-end-pos) (> sexp-end-pos end-pos))
|
||||||
|
(throw 'done nil))
|
||||||
|
;; Otherwise, this sexp is in the range requested.
|
||||||
|
(push (list (elisp-refs--start-pos sexp-end-pos) sexp-end-pos)
|
||||||
|
positions)
|
||||||
|
(setq start-pos sexp-end-pos))))
|
||||||
|
;; Terminate when we see "Containing expression ends prematurely"
|
||||||
|
(scan-error nil)))
|
||||||
|
(nreverse positions)))
|
||||||
|
|
||||||
|
(defun elisp-refs--read-buffer-form (symbols-with-pos)
|
||||||
|
"Read a form from the current buffer, starting at point.
|
||||||
|
Returns a list:
|
||||||
|
\(form form-start-pos form-end-pos symbol-positions read-start-pos)
|
||||||
|
|
||||||
|
In Emacs 28 and earlier, SYMBOL-POSITIONS is a list of 0-indexed
|
||||||
|
symbol positions relative to READ-START-POS, according to
|
||||||
|
`read-symbol-positions-list'.
|
||||||
|
|
||||||
|
In Emacs 29+, SYMBOL-POSITIONS is nil. If SYMBOLS-WITH-POS is
|
||||||
|
non-nil, forms are read with `read-positioning-symbols'."
|
||||||
|
(let* ((read-with-symbol-positions t)
|
||||||
|
(read-start-pos (point))
|
||||||
|
(form (if (and symbols-with-pos (fboundp 'read-positioning-symbols))
|
||||||
|
(read-positioning-symbols (current-buffer))
|
||||||
|
(read (current-buffer))))
|
||||||
|
(symbols (if (boundp 'read-symbol-positions-list)
|
||||||
|
read-symbol-positions-list
|
||||||
|
nil))
|
||||||
|
(end-pos (point))
|
||||||
|
(start-pos (elisp-refs--start-pos end-pos)))
|
||||||
|
(list form start-pos end-pos symbols read-start-pos)))
|
||||||
|
|
||||||
|
(defvar elisp-refs--path nil
|
||||||
|
"A buffer-local variable used by `elisp-refs--contents-buffer'.
|
||||||
|
Internal implementation detail.")
|
||||||
|
|
||||||
|
(defun elisp-refs--read-all-buffer-forms (buffer symbols-with-pos)
|
||||||
|
"Read all the forms in BUFFER, along with their positions."
|
||||||
|
(with-current-buffer buffer
|
||||||
|
(goto-char (point-min))
|
||||||
|
(let ((forms nil))
|
||||||
|
(condition-case err
|
||||||
|
(while t
|
||||||
|
(push (elisp-refs--read-buffer-form symbols-with-pos) forms))
|
||||||
|
(error
|
||||||
|
(if (or (equal (car err) 'end-of-file)
|
||||||
|
;; TODO: this shouldn't occur in valid elisp files,
|
||||||
|
;; but it's happening in helm-utils.el.
|
||||||
|
(equal (car err) 'scan-error))
|
||||||
|
;; Reached end of file, we're done.
|
||||||
|
(nreverse forms)
|
||||||
|
;; Some unexpected error, propagate.
|
||||||
|
(error "Unexpected error whilst reading %s position %s: %s"
|
||||||
|
(abbreviate-file-name elisp-refs--path) (point) err)))))))
|
||||||
|
|
||||||
|
(defun elisp-refs--proper-list-p (val)
|
||||||
|
"Is VAL a proper list?"
|
||||||
|
(if (fboundp 'proper-list-p)
|
||||||
|
;; `proper-list-p' was added in Emacs 27.1.
|
||||||
|
;; http://git.savannah.gnu.org/cgit/emacs.git/commit/?id=2fde6275b69fd113e78243790bf112bbdd2fe2bf
|
||||||
|
(with-no-warnings (proper-list-p val))
|
||||||
|
;; Earlier Emacs versions only had format-proper-list-p.
|
||||||
|
(with-no-warnings (format-proper-list-p val))))
|
||||||
|
|
||||||
|
(defun elisp-refs--walk (buffer form start-pos end-pos symbol match-p &optional path)
|
||||||
|
"Walk FORM, a nested list, and return a list of sublists (with
|
||||||
|
their positions) where MATCH-P returns t. FORM is traversed
|
||||||
|
depth-first (pre-order traversal, left-to-right).
|
||||||
|
|
||||||
|
MATCH-P is called with three arguments:
|
||||||
|
\(SYMBOL CURRENT-FORM PATH).
|
||||||
|
|
||||||
|
PATH is the first element of all the enclosing forms of
|
||||||
|
CURRENT-FORM, innermost first, along with the index of the
|
||||||
|
current form.
|
||||||
|
|
||||||
|
For example if we are looking at h in (e f (g h)), PATH takes the
|
||||||
|
value ((g . 1) (e . 2)).
|
||||||
|
|
||||||
|
START-POS and END-POS should be the position of FORM within BUFFER."
|
||||||
|
(cond
|
||||||
|
((funcall match-p symbol form path)
|
||||||
|
;; If this form matches, just return it, along with the position.
|
||||||
|
(list (list form start-pos end-pos)))
|
||||||
|
;; Otherwise, recurse on the subforms.
|
||||||
|
((consp form)
|
||||||
|
(let ((matches nil)
|
||||||
|
;; Find the positions of the subforms.
|
||||||
|
(subforms-positions
|
||||||
|
(if (eq (car-safe form) '\`)
|
||||||
|
;; Kludge: `elisp-refs--sexp-positions' excludes the ` when
|
||||||
|
;; calculating positions. So, to find the inner
|
||||||
|
;; positions when walking from `(...) to (...), we
|
||||||
|
;; don't need to increment the start position.
|
||||||
|
(cons nil (elisp-refs--sexp-positions buffer start-pos end-pos))
|
||||||
|
;; Calculate the positions after the opening paren.
|
||||||
|
(elisp-refs--sexp-positions buffer (1+ start-pos) end-pos))))
|
||||||
|
;; For each subform, recurse if it's a list, or a matching symbol.
|
||||||
|
(--each (-zip-pair form subforms-positions)
|
||||||
|
(-let [(subform subform-start subform-end) it]
|
||||||
|
(when (or
|
||||||
|
(and (consp subform) (elisp-refs--proper-list-p subform))
|
||||||
|
(and (symbolp subform) (eq subform symbol)))
|
||||||
|
(-when-let (subform-matches
|
||||||
|
(elisp-refs--walk
|
||||||
|
buffer subform
|
||||||
|
subform-start subform-end
|
||||||
|
symbol match-p
|
||||||
|
(cons (cons (car-safe form) it-index) path)))
|
||||||
|
(push subform-matches matches)))))
|
||||||
|
|
||||||
|
;; Concat the results from all the subforms.
|
||||||
|
(apply #'append (nreverse matches))))))
|
||||||
|
|
||||||
|
;; TODO: condition-case (condition-case ... (error ...)) is not a call
|
||||||
|
;; TODO: (cl-destructuring-bind (foo &rest bar) ...) is not a call
|
||||||
|
;; TODO: letf, cl-letf, -let, -let*
|
||||||
|
(defun elisp-refs--function-p (symbol form path)
|
||||||
|
"Return t if FORM looks like a function call to SYMBOL."
|
||||||
|
(cond
|
||||||
|
((not (consp form))
|
||||||
|
nil)
|
||||||
|
;; Ignore (defun _ (SYMBOL ...) ...)
|
||||||
|
((or (equal (car path) '(defsubst . 2))
|
||||||
|
(equal (car path) '(defun . 2))
|
||||||
|
(equal (car path) '(defmacro . 2))
|
||||||
|
(equal (car path) '(cl-defun . 2)))
|
||||||
|
nil)
|
||||||
|
;; Ignore (lambda (SYMBOL ...) ...)
|
||||||
|
((equal (car path) '(lambda . 1))
|
||||||
|
nil)
|
||||||
|
;; Ignore (let (SYMBOL ...) ...)
|
||||||
|
;; and (let* (SYMBOL ...) ...)
|
||||||
|
((or
|
||||||
|
(equal (car path) '(let . 1))
|
||||||
|
(equal (car path) '(let* . 1)))
|
||||||
|
nil)
|
||||||
|
;; Ignore (let ((SYMBOL ...)) ...)
|
||||||
|
((or
|
||||||
|
(equal (cl-second path) '(let . 1))
|
||||||
|
(equal (cl-second path) '(let* . 1)))
|
||||||
|
nil)
|
||||||
|
;; Ignore (declare-function NAME (ARGS...))
|
||||||
|
((equal (car path) '(declare-function . 3))
|
||||||
|
nil)
|
||||||
|
;; (SYMBOL ...)
|
||||||
|
((eq (car form) symbol)
|
||||||
|
t)
|
||||||
|
;; (foo ... #'SYMBOL ...)
|
||||||
|
((--any-p (equal it (list 'function symbol)) form)
|
||||||
|
t)
|
||||||
|
;; (funcall 'SYMBOL ...)
|
||||||
|
((and (eq (car form) 'funcall)
|
||||||
|
(equal `',symbol (cl-second form)))
|
||||||
|
t)
|
||||||
|
;; (apply 'SYMBOL ...)
|
||||||
|
((and (eq (car form) 'apply)
|
||||||
|
(equal `',symbol (cl-second form)))
|
||||||
|
t)))
|
||||||
|
|
||||||
|
(defun elisp-refs--macro-p (symbol form path)
|
||||||
|
"Return t if FORM looks like a macro call to SYMBOL."
|
||||||
|
(cond
|
||||||
|
((not (consp form))
|
||||||
|
nil)
|
||||||
|
;; Ignore (defun _ (SYMBOL ...) ...)
|
||||||
|
((or (equal (car path) '(defsubst . 2))
|
||||||
|
(equal (car path) '(defun . 2))
|
||||||
|
(equal (car path) '(defmacro . 2)))
|
||||||
|
nil)
|
||||||
|
;; Ignore (lambda (SYMBOL ...) ...)
|
||||||
|
((equal (car path) '(lambda . 1))
|
||||||
|
nil)
|
||||||
|
;; Ignore (let (SYMBOL ...) ...)
|
||||||
|
;; and (let* (SYMBOL ...) ...)
|
||||||
|
((or
|
||||||
|
(equal (car path) '(let . 1))
|
||||||
|
(equal (car path) '(let* . 1)))
|
||||||
|
nil)
|
||||||
|
;; Ignore (let ((SYMBOL ...)) ...)
|
||||||
|
((or
|
||||||
|
(equal (cl-second path) '(let . 1))
|
||||||
|
(equal (cl-second path) '(let* . 1)))
|
||||||
|
nil)
|
||||||
|
;; (SYMBOL ...)
|
||||||
|
((eq (car form) symbol)
|
||||||
|
t)))
|
||||||
|
|
||||||
|
;; Looking for a special form is exactly the same as looking for a
|
||||||
|
;; macro.
|
||||||
|
(defalias 'elisp-refs--special-p 'elisp-refs--macro-p)
|
||||||
|
|
||||||
|
(defun elisp-refs--variable-p (symbol form path)
|
||||||
|
"Return t if this looks like a variable reference to SYMBOL.
|
||||||
|
We consider parameters to be variables too."
|
||||||
|
(cond
|
||||||
|
((consp form)
|
||||||
|
nil)
|
||||||
|
;; Ignore (defun _ (SYMBOL ...) ...)
|
||||||
|
((or (equal (car path) '(defsubst . 1))
|
||||||
|
(equal (car path) '(defun . 1))
|
||||||
|
(equal (car path) '(defmacro . 1))
|
||||||
|
(equal (car path) '(cl-defun . 1)))
|
||||||
|
nil)
|
||||||
|
;; (let (SYMBOL ...) ...) is a variable, not a function call.
|
||||||
|
((or
|
||||||
|
(equal (cl-second path) '(let . 1))
|
||||||
|
(equal (cl-second path) '(let* . 1)))
|
||||||
|
t)
|
||||||
|
;; (lambda (SYMBOL ...) ...) is a variable
|
||||||
|
((equal (cl-second path) '(lambda . 1))
|
||||||
|
t)
|
||||||
|
;; (let ((SYMBOL ...)) ...) is also a variable.
|
||||||
|
((or
|
||||||
|
(equal (cl-third path) '(let . 1))
|
||||||
|
(equal (cl-third path) '(let* . 1)))
|
||||||
|
t)
|
||||||
|
;; Ignore (SYMBOL ...) otherwise, we assume it's a function/macro
|
||||||
|
;; call.
|
||||||
|
((equal (car path) (cons symbol 0))
|
||||||
|
nil)
|
||||||
|
((eq form symbol)
|
||||||
|
t)))
|
||||||
|
|
||||||
|
;; TODO: benchmark building a list with `push' rather than using
|
||||||
|
;; mapcat.
|
||||||
|
(defun elisp-refs--read-and-find (buffer symbol match-p)
|
||||||
|
"Read all the forms in BUFFER, and return a list of all forms that
|
||||||
|
contain SYMBOL where MATCH-P returns t.
|
||||||
|
|
||||||
|
For every matching form found, we return the form itself along
|
||||||
|
with its start and end position."
|
||||||
|
(-non-nil
|
||||||
|
(--mapcat
|
||||||
|
(-let [(form start-pos end-pos symbol-positions _read-start-pos) it]
|
||||||
|
;; Optimisation: if we have a list of positions for the current
|
||||||
|
;; form (Emacs 28 and earlier), and it doesn't contain the
|
||||||
|
;; symbol we're looking for, don't bother walking the form.
|
||||||
|
(when (or (null symbol-positions) (assq symbol symbol-positions))
|
||||||
|
(elisp-refs--walk buffer form start-pos end-pos symbol match-p)))
|
||||||
|
(elisp-refs--read-all-buffer-forms buffer nil))))
|
||||||
|
|
||||||
|
(defun elisp-refs--walk-positioned-symbols (forms symbol)
|
||||||
|
"Given a nested list of FORMS, return a list of all positions of SYMBOL.
|
||||||
|
Assumes `symbol-with-pos-pos' is defined (Emacs 29+)."
|
||||||
|
(cond
|
||||||
|
((symbol-with-pos-p forms)
|
||||||
|
(let ((symbols-with-pos-enabled t))
|
||||||
|
(if (eq forms symbol)
|
||||||
|
(list (list symbol
|
||||||
|
(symbol-with-pos-pos forms)
|
||||||
|
(+ (symbol-with-pos-pos forms) (length (symbol-name symbol))))))))
|
||||||
|
((elisp-refs--proper-list-p forms)
|
||||||
|
;; Proper list, use `--mapcat` to reduce how much we recurse.
|
||||||
|
(--mapcat (elisp-refs--walk-positioned-symbols it symbol) forms))
|
||||||
|
((consp forms)
|
||||||
|
;; Improper list, we have to recurse on head and tail.
|
||||||
|
(append (elisp-refs--walk-positioned-symbols (car forms) symbol)
|
||||||
|
(elisp-refs--walk-positioned-symbols (cdr forms) symbol)))
|
||||||
|
((vectorp forms)
|
||||||
|
(--mapcat (elisp-refs--walk-positioned-symbols it symbol) forms))))
|
||||||
|
|
||||||
|
(defun elisp-refs--read-and-find-symbol (buffer symbol)
|
||||||
|
"Read all the forms in BUFFER, and return a list of all
|
||||||
|
positions of SYMBOL."
|
||||||
|
(let* ((symbols-with-pos (fboundp 'symbol-with-pos-pos))
|
||||||
|
(forms (elisp-refs--read-all-buffer-forms buffer symbols-with-pos)))
|
||||||
|
|
||||||
|
(if symbols-with-pos
|
||||||
|
(elisp-refs--walk-positioned-symbols forms symbol)
|
||||||
|
(-non-nil
|
||||||
|
(--mapcat
|
||||||
|
(-let [(_ _ _ symbol-positions read-start-pos) it]
|
||||||
|
(--map
|
||||||
|
(-let [(sym . offset) it]
|
||||||
|
(when (eq sym symbol)
|
||||||
|
(-let* ((start-pos (+ read-start-pos offset))
|
||||||
|
(end-pos (+ start-pos (length (symbol-name sym)))))
|
||||||
|
(list sym start-pos end-pos))))
|
||||||
|
symbol-positions))
|
||||||
|
forms)))))
|
||||||
|
|
||||||
|
(defun elisp-refs--filter-obarray (pred)
|
||||||
|
"Return a list of all the items in `obarray' where PRED returns t."
|
||||||
|
(let (symbols)
|
||||||
|
(mapatoms (lambda (symbol)
|
||||||
|
(when (and (funcall pred symbol)
|
||||||
|
(not (equal (symbol-name symbol) "")))
|
||||||
|
(push symbol symbols))))
|
||||||
|
symbols))
|
||||||
|
|
||||||
|
(defun elisp-refs--loaded-paths ()
|
||||||
|
"Return a list of all files that have been loaded in Emacs.
|
||||||
|
Where the file was a .elc, return the path to the .el file instead."
|
||||||
|
(let ((elc-paths (-non-nil (mapcar #'-first-item load-history))))
|
||||||
|
(-non-nil
|
||||||
|
(--map
|
||||||
|
(let ((el-name (format "%s.el" (file-name-sans-extension it)))
|
||||||
|
(el-gz-name (format "%s.el.gz" (file-name-sans-extension it))))
|
||||||
|
(cond ((file-exists-p el-name) el-name)
|
||||||
|
((file-exists-p el-gz-name) el-gz-name)
|
||||||
|
;; Ignore files where we can't find a .el file.
|
||||||
|
(t nil)))
|
||||||
|
elc-paths))))
|
||||||
|
|
||||||
|
(defun elisp-refs--contents-buffer (path)
|
||||||
|
"Read PATH into a disposable buffer, and return it.
|
||||||
|
Works around the fact that Emacs won't allow multiple buffers
|
||||||
|
visiting the same file."
|
||||||
|
(let ((fresh-buffer (generate-new-buffer (format " *refs-%s*" path)))
|
||||||
|
;; Be defensive against users overriding encoding
|
||||||
|
;; configurations (Helpful bugs #75 and #147).
|
||||||
|
(coding-system-for-read nil)
|
||||||
|
(file-name-handler-alist
|
||||||
|
'(("\\(?:\\.dz\\|\\.txz\\|\\.xz\\|\\.lzma\\|\\.lz\\|\\.g?z\\|\\.\\(?:tgz\\|svgz\\|sifz\\)\\|\\.tbz2?\\|\\.bz2\\|\\.Z\\)\\(?:~\\|\\.~[-[:alnum:]:#@^._]+\\(?:~[[:digit:]]+\\)?~\\)?\\'" .
|
||||||
|
jka-compr-handler)
|
||||||
|
("\\`/:" . file-name-non-special))))
|
||||||
|
(with-current-buffer fresh-buffer
|
||||||
|
(setq-local elisp-refs--path path)
|
||||||
|
(insert-file-contents path)
|
||||||
|
;; We don't enable emacs-lisp-mode because it slows down this
|
||||||
|
;; function significantly. We just need the syntax table for
|
||||||
|
;; scan-sexps to do the right thing with comments.
|
||||||
|
(set-syntax-table emacs-lisp-mode-syntax-table))
|
||||||
|
fresh-buffer))
|
||||||
|
|
||||||
|
(defvar elisp-refs--highlighting-buffer
|
||||||
|
nil
|
||||||
|
"A temporary buffer used for highlighting.
|
||||||
|
Since `elisp-refs--syntax-highlight' is a hot function, we
|
||||||
|
don't want to create lots of temporary buffers.")
|
||||||
|
|
||||||
|
(defun elisp-refs--syntax-highlight (str)
|
||||||
|
"Apply font-lock properties to a string STR of Emacs lisp code."
|
||||||
|
;; Ensure we have a highlighting buffer to work with.
|
||||||
|
(unless (and elisp-refs--highlighting-buffer
|
||||||
|
(buffer-live-p elisp-refs--highlighting-buffer))
|
||||||
|
(setq elisp-refs--highlighting-buffer
|
||||||
|
(generate-new-buffer " *refs-highlighting*"))
|
||||||
|
(with-current-buffer elisp-refs--highlighting-buffer
|
||||||
|
(delay-mode-hooks (emacs-lisp-mode))))
|
||||||
|
|
||||||
|
(with-current-buffer elisp-refs--highlighting-buffer
|
||||||
|
(erase-buffer)
|
||||||
|
(insert str)
|
||||||
|
(if (fboundp 'font-lock-ensure)
|
||||||
|
(font-lock-ensure)
|
||||||
|
(with-no-warnings
|
||||||
|
(font-lock-fontify-buffer)))
|
||||||
|
(buffer-string)))
|
||||||
|
|
||||||
|
(defun elisp-refs--replace-tabs (string)
|
||||||
|
"Replace tabs in STRING with spaces."
|
||||||
|
;; This is important for unindenting, as we may unindent by less
|
||||||
|
;; than one whole tab.
|
||||||
|
(s-replace "\t" (s-repeat tab-width " ") string))
|
||||||
|
|
||||||
|
(defun elisp-refs--lines (string)
|
||||||
|
"Return a list of all the lines in STRING.
|
||||||
|
'a\nb' -> ('a\n' 'b')"
|
||||||
|
(let ((lines nil))
|
||||||
|
(while (> (length string) 0)
|
||||||
|
(let ((index (s-index-of "\n" string)))
|
||||||
|
(if index
|
||||||
|
(progn
|
||||||
|
(push (substring string 0 (1+ index)) lines)
|
||||||
|
(setq string (substring string (1+ index))))
|
||||||
|
(push string lines)
|
||||||
|
(setq string ""))))
|
||||||
|
(nreverse lines)))
|
||||||
|
|
||||||
|
(defun elisp-refs--map-lines (string fn)
|
||||||
|
"Execute FN for each line in string, and join the result together."
|
||||||
|
(let ((result nil))
|
||||||
|
(dolist (line (elisp-refs--lines string))
|
||||||
|
(push (funcall fn line) result))
|
||||||
|
(apply #'concat (nreverse result))))
|
||||||
|
|
||||||
|
(defun elisp-refs--unindent-rigidly (string)
|
||||||
|
"Given an indented STRING, unindent rigidly until
|
||||||
|
at least one line has no indent.
|
||||||
|
|
||||||
|
STRING should have a 'elisp-refs-start-pos property. The returned
|
||||||
|
string will have this property updated to reflect the unindent."
|
||||||
|
(let* ((lines (s-lines string))
|
||||||
|
;; Get the leading whitespace for each line.
|
||||||
|
(indents (--map (car (s-match (rx bos (+ whitespace)) it))
|
||||||
|
lines))
|
||||||
|
(min-indent (-min (--map (length it) indents))))
|
||||||
|
(propertize
|
||||||
|
(elisp-refs--map-lines
|
||||||
|
string
|
||||||
|
(lambda (line) (substring line min-indent)))
|
||||||
|
'elisp-refs-unindented min-indent)))
|
||||||
|
|
||||||
|
(defun elisp-refs--containing-lines (buffer start-pos end-pos)
|
||||||
|
"Return a string, all the lines in BUFFER that are between
|
||||||
|
START-POS and END-POS (inclusive).
|
||||||
|
|
||||||
|
For the characters that are between START-POS and END-POS,
|
||||||
|
propertize them."
|
||||||
|
(let (expanded-start-pos expanded-end-pos)
|
||||||
|
(with-current-buffer buffer
|
||||||
|
;; Expand START-POS and END-POS to line boundaries.
|
||||||
|
(goto-char start-pos)
|
||||||
|
(beginning-of-line)
|
||||||
|
(setq expanded-start-pos (point))
|
||||||
|
(goto-char end-pos)
|
||||||
|
(end-of-line)
|
||||||
|
(setq expanded-end-pos (point))
|
||||||
|
|
||||||
|
;; Extract the rest of the line before and after the section we're interested in.
|
||||||
|
(let* ((before-match (buffer-substring expanded-start-pos start-pos))
|
||||||
|
(after-match (buffer-substring end-pos expanded-end-pos))
|
||||||
|
;; Concat the extra text with the actual match, ensuring we
|
||||||
|
;; highlight the match as code, but highlight the rest as as
|
||||||
|
;; comments.
|
||||||
|
(text (concat
|
||||||
|
(propertize before-match
|
||||||
|
'face 'font-lock-comment-face)
|
||||||
|
(elisp-refs--syntax-highlight (buffer-substring start-pos end-pos))
|
||||||
|
(propertize after-match
|
||||||
|
'face 'font-lock-comment-face))))
|
||||||
|
(-> text
|
||||||
|
(elisp-refs--replace-tabs)
|
||||||
|
(elisp-refs--unindent-rigidly)
|
||||||
|
(propertize 'elisp-refs-start-pos expanded-start-pos
|
||||||
|
'elisp-refs-path elisp-refs--path))))))
|
||||||
|
|
||||||
|
(defun elisp-refs--find-file (button)
|
||||||
|
"Open the file referenced by BUTTON."
|
||||||
|
(find-file (button-get button 'path))
|
||||||
|
(goto-char (point-min)))
|
||||||
|
|
||||||
|
(define-button-type 'elisp-refs-path-button
|
||||||
|
'action 'elisp-refs--find-file
|
||||||
|
'follow-link t
|
||||||
|
'help-echo "Open file")
|
||||||
|
|
||||||
|
(defun elisp-refs--path-button (path)
|
||||||
|
"Return a button that navigates to PATH."
|
||||||
|
(with-temp-buffer
|
||||||
|
(insert-text-button
|
||||||
|
(abbreviate-file-name path)
|
||||||
|
:type 'elisp-refs-path-button
|
||||||
|
'path path)
|
||||||
|
(buffer-string)))
|
||||||
|
|
||||||
|
(defun elisp-refs--describe (button)
|
||||||
|
"Show *Help* for the symbol referenced by BUTTON."
|
||||||
|
(let ((symbol (button-get button 'symbol))
|
||||||
|
(kind (button-get button 'kind)))
|
||||||
|
(cond ((eq kind 'symbol)
|
||||||
|
(describe-symbol symbol))
|
||||||
|
((eq kind 'variable)
|
||||||
|
(describe-variable symbol))
|
||||||
|
(t
|
||||||
|
;; Emacs uses `describe-function' for functions, macros and
|
||||||
|
;; special forms.
|
||||||
|
(describe-function symbol)))))
|
||||||
|
|
||||||
|
(define-button-type 'elisp-refs-describe-button
|
||||||
|
'action 'elisp-refs--describe
|
||||||
|
'follow-link t
|
||||||
|
'help-echo "Describe")
|
||||||
|
|
||||||
|
(defun elisp-refs--describe-button (symbol kind)
|
||||||
|
"Return a button that shows *Help* for SYMBOL.
|
||||||
|
KIND should be 'function, 'macro, 'variable, 'special or 'symbol."
|
||||||
|
(with-temp-buffer
|
||||||
|
(insert (symbol-name kind) " ")
|
||||||
|
(insert-text-button
|
||||||
|
(symbol-name symbol)
|
||||||
|
:type 'elisp-refs-describe-button
|
||||||
|
'symbol symbol
|
||||||
|
'kind kind)
|
||||||
|
(buffer-string)))
|
||||||
|
|
||||||
|
(defun elisp-refs--pluralize (number thing)
|
||||||
|
"Human-friendly description of NUMBER occurrences of THING."
|
||||||
|
(format "%s %s%s"
|
||||||
|
(elisp-refs--format-int number)
|
||||||
|
thing
|
||||||
|
(if (equal number 1) "" "s")))
|
||||||
|
|
||||||
|
(defun elisp-refs--format-count (symbol ref-count file-count
|
||||||
|
searched-file-count prefix)
|
||||||
|
(let* ((file-str (if (zerop file-count)
|
||||||
|
""
|
||||||
|
(format " in %s" (elisp-refs--pluralize file-count "file"))))
|
||||||
|
(found-str (format "Found %s to %s%s."
|
||||||
|
(elisp-refs--pluralize ref-count "reference")
|
||||||
|
symbol
|
||||||
|
file-str))
|
||||||
|
(searched-str (if prefix
|
||||||
|
(format "Searched %s in %s."
|
||||||
|
(elisp-refs--pluralize searched-file-count "loaded file")
|
||||||
|
(elisp-refs--path-button (file-name-as-directory prefix)))
|
||||||
|
(format "Searched all %s loaded in Emacs."
|
||||||
|
(elisp-refs--pluralize searched-file-count "file")))))
|
||||||
|
(s-word-wrap 70 (format "%s %s" found-str searched-str))))
|
||||||
|
|
||||||
|
;; TODO: if we have multiple matches on one line, we repeatedly show
|
||||||
|
;; that line. That's slightly confusing.
|
||||||
|
(defun elisp-refs--show-results (symbol description results
|
||||||
|
searched-file-count prefix)
|
||||||
|
"Given a RESULTS list where each element takes the form \(forms . buffer\),
|
||||||
|
render a friendly results buffer."
|
||||||
|
(let ((buf (get-buffer-create (format "*refs: %s*" symbol))))
|
||||||
|
(switch-to-buffer buf)
|
||||||
|
(let ((inhibit-read-only t))
|
||||||
|
(erase-buffer)
|
||||||
|
(save-excursion
|
||||||
|
;; Insert the header.
|
||||||
|
(insert
|
||||||
|
(elisp-refs--format-count
|
||||||
|
description
|
||||||
|
(-sum (--map (length (car it)) results))
|
||||||
|
(length results)
|
||||||
|
searched-file-count
|
||||||
|
prefix)
|
||||||
|
"\n\n")
|
||||||
|
;; Insert the results.
|
||||||
|
(--each results
|
||||||
|
(-let* (((forms . buf) it)
|
||||||
|
(path (with-current-buffer buf elisp-refs--path)))
|
||||||
|
(insert
|
||||||
|
(propertize "File: " 'face 'bold)
|
||||||
|
(elisp-refs--path-button path) "\n")
|
||||||
|
(--each forms
|
||||||
|
(-let [(_ start-pos end-pos) it]
|
||||||
|
(insert (elisp-refs--containing-lines buf start-pos end-pos)
|
||||||
|
"\n")))
|
||||||
|
(insert "\n")))
|
||||||
|
;; Prepare the buffer for the user.
|
||||||
|
(elisp-refs-mode)))
|
||||||
|
;; Cleanup buffers created when highlighting results.
|
||||||
|
(when elisp-refs--highlighting-buffer
|
||||||
|
(kill-buffer elisp-refs--highlighting-buffer))))
|
||||||
|
|
||||||
|
(defun elisp-refs--loaded-bufs ()
|
||||||
|
"Return a list of open buffers, one for each path in `load-path'."
|
||||||
|
(mapcar #'elisp-refs--contents-buffer (elisp-refs--loaded-paths)))
|
||||||
|
|
||||||
|
(defun elisp-refs--search-1 (bufs match-fn)
|
||||||
|
"Call MATCH-FN on each buffer in BUFS, reporting progress
|
||||||
|
and accumulating results.
|
||||||
|
|
||||||
|
BUFS should be disposable: we make no effort to preserve their
|
||||||
|
state during searching.
|
||||||
|
|
||||||
|
MATCH-FN should return a list where each element takes the form:
|
||||||
|
\(form start-pos end-pos)."
|
||||||
|
(let* (;; Our benchmark suggests we spend a lot of time in GC, and
|
||||||
|
;; performance improves if we GC less frequently.
|
||||||
|
(gc-cons-percentage 0.8)
|
||||||
|
(total-bufs (length bufs)))
|
||||||
|
(let ((searched 0)
|
||||||
|
(forms-and-bufs nil))
|
||||||
|
(dolist (buf bufs)
|
||||||
|
(let* ((matching-forms (funcall match-fn buf)))
|
||||||
|
;; If there were any matches in this buffer, push the
|
||||||
|
;; matches along with the buffer into our results
|
||||||
|
;; list.
|
||||||
|
(when matching-forms
|
||||||
|
(push (cons matching-forms buf) forms-and-bufs))
|
||||||
|
;; Give feedback to the user on our progress, because
|
||||||
|
;; searching takes several seconds.
|
||||||
|
(when (and (zerop (mod searched 10))
|
||||||
|
elisp-refs-verbose)
|
||||||
|
(message "Searched %s/%s files" searched total-bufs))
|
||||||
|
(cl-incf searched)))
|
||||||
|
(when elisp-refs-verbose
|
||||||
|
(message "Searched %s/%s files" total-bufs total-bufs))
|
||||||
|
forms-and-bufs)))
|
||||||
|
|
||||||
|
(defun elisp-refs--search (symbol description match-fn &optional path-prefix)
|
||||||
|
"Find references to SYMBOL in all loaded files; call MATCH-FN on each buffer.
|
||||||
|
When PATH-PREFIX, limit to loaded files whose path starts with that prefix.
|
||||||
|
|
||||||
|
Display the results in a hyperlinked buffer.
|
||||||
|
|
||||||
|
MATCH-FN should return a list where each element takes the form:
|
||||||
|
\(form start-pos end-pos)."
|
||||||
|
(let* ((loaded-paths (elisp-refs--loaded-paths))
|
||||||
|
(matching-paths (if path-prefix
|
||||||
|
(--filter (s-starts-with? path-prefix it) loaded-paths)
|
||||||
|
loaded-paths))
|
||||||
|
(loaded-src-bufs (mapcar #'elisp-refs--contents-buffer matching-paths)))
|
||||||
|
;; Use unwind-protect to ensure we always cleanup temporary
|
||||||
|
;; buffers, even if the user hits C-g.
|
||||||
|
(unwind-protect
|
||||||
|
(progn
|
||||||
|
(let ((forms-and-bufs
|
||||||
|
(elisp-refs--search-1 loaded-src-bufs match-fn)))
|
||||||
|
(elisp-refs--show-results symbol description forms-and-bufs
|
||||||
|
(length loaded-src-bufs) path-prefix)))
|
||||||
|
;; Clean up temporary buffers.
|
||||||
|
(--each loaded-src-bufs (kill-buffer it)))))
|
||||||
|
|
||||||
|
(defun elisp-refs--completing-read-symbol (prompt &optional filter)
|
||||||
|
"Read an interned symbol from the minibuffer,
|
||||||
|
defaulting to the symbol at point. PROMPT is the string to prompt
|
||||||
|
with.
|
||||||
|
|
||||||
|
If FILTER is given, only offer symbols where (FILTER sym) returns
|
||||||
|
t."
|
||||||
|
(let ((filter (or filter (lambda (_) t))))
|
||||||
|
(read
|
||||||
|
(completing-read prompt
|
||||||
|
(elisp-refs--filter-obarray filter)
|
||||||
|
nil nil nil nil
|
||||||
|
(-if-let (sym (thing-at-point 'symbol))
|
||||||
|
(when (funcall filter (read sym))
|
||||||
|
sym))))))
|
||||||
|
|
||||||
|
;;; Commands
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(defun elisp-refs-function (symbol &optional path-prefix)
|
||||||
|
"Display all the references to function SYMBOL, in all loaded
|
||||||
|
elisp files.
|
||||||
|
|
||||||
|
If called with a prefix, prompt for a directory to limit the search.
|
||||||
|
|
||||||
|
This searches for functions, not macros. For that, see
|
||||||
|
`elisp-refs-macro'."
|
||||||
|
(interactive
|
||||||
|
(list (elisp-refs--completing-read-symbol "Function: " #'functionp)
|
||||||
|
(when current-prefix-arg
|
||||||
|
(read-directory-name "Limit search to loaded files in: "))))
|
||||||
|
(when (not (functionp symbol))
|
||||||
|
(if (macrop symbol)
|
||||||
|
(user-error "%s is a macro. Did you mean elisp-refs-macro?"
|
||||||
|
symbol)
|
||||||
|
(user-error "%s is not a function. Did you mean elisp-refs-symbol?"
|
||||||
|
symbol)))
|
||||||
|
(elisp-refs--search symbol
|
||||||
|
(elisp-refs--describe-button symbol 'function)
|
||||||
|
(lambda (buf)
|
||||||
|
(elisp-refs--read-and-find buf symbol #'elisp-refs--function-p))
|
||||||
|
path-prefix))
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(defun elisp-refs-macro (symbol &optional path-prefix)
|
||||||
|
"Display all the references to macro SYMBOL, in all loaded
|
||||||
|
elisp files.
|
||||||
|
|
||||||
|
If called with a prefix, prompt for a directory to limit the search.
|
||||||
|
|
||||||
|
This searches for macros, not functions. For that, see
|
||||||
|
`elisp-refs-function'."
|
||||||
|
(interactive
|
||||||
|
(list (elisp-refs--completing-read-symbol "Macro: " #'macrop)
|
||||||
|
(when current-prefix-arg
|
||||||
|
(read-directory-name "Limit search to loaded files in: "))))
|
||||||
|
(when (not (macrop symbol))
|
||||||
|
(if (functionp symbol)
|
||||||
|
(user-error "%s is a function. Did you mean elisp-refs-function?"
|
||||||
|
symbol)
|
||||||
|
(user-error "%s is not a function. Did you mean elisp-refs-symbol?"
|
||||||
|
symbol)))
|
||||||
|
(elisp-refs--search symbol
|
||||||
|
(elisp-refs--describe-button symbol 'macro)
|
||||||
|
(lambda (buf)
|
||||||
|
(elisp-refs--read-and-find buf symbol #'elisp-refs--macro-p))
|
||||||
|
path-prefix))
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(defun elisp-refs-special (symbol &optional path-prefix)
|
||||||
|
"Display all the references to special form SYMBOL, in all loaded
|
||||||
|
elisp files.
|
||||||
|
|
||||||
|
If called with a prefix, prompt for a directory to limit the search."
|
||||||
|
(interactive
|
||||||
|
(list (elisp-refs--completing-read-symbol "Special form: " #'special-form-p)
|
||||||
|
(when current-prefix-arg
|
||||||
|
(read-directory-name "Limit search to loaded files in: "))))
|
||||||
|
(elisp-refs--search symbol
|
||||||
|
(elisp-refs--describe-button symbol 'special-form)
|
||||||
|
(lambda (buf)
|
||||||
|
(elisp-refs--read-and-find buf symbol #'elisp-refs--special-p))
|
||||||
|
path-prefix))
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(defun elisp-refs-variable (symbol &optional path-prefix)
|
||||||
|
"Display all the references to variable SYMBOL, in all loaded
|
||||||
|
elisp files.
|
||||||
|
|
||||||
|
If called with a prefix, prompt for a directory to limit the search."
|
||||||
|
(interactive
|
||||||
|
;; This is awkward. We don't want to just offer defvar variables,
|
||||||
|
;; because then we can't search for code which uses `let' to bind
|
||||||
|
;; symbols. There doesn't seem to be a good way to only offer
|
||||||
|
;; variables that have been bound at some point.
|
||||||
|
(list (elisp-refs--completing-read-symbol "Variable: " )
|
||||||
|
(when current-prefix-arg
|
||||||
|
(read-directory-name "Limit search to loaded files in: "))))
|
||||||
|
(elisp-refs--search symbol
|
||||||
|
(elisp-refs--describe-button symbol 'variable)
|
||||||
|
(lambda (buf)
|
||||||
|
(elisp-refs--read-and-find buf symbol #'elisp-refs--variable-p))
|
||||||
|
path-prefix))
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(defun elisp-refs-symbol (symbol &optional path-prefix)
|
||||||
|
"Display all the references to SYMBOL in all loaded elisp files.
|
||||||
|
|
||||||
|
If called with a prefix, prompt for a directory to limit the
|
||||||
|
search."
|
||||||
|
(interactive
|
||||||
|
(list (elisp-refs--completing-read-symbol "Symbol: " )
|
||||||
|
(when current-prefix-arg
|
||||||
|
(read-directory-name "Limit search to loaded files in: "))))
|
||||||
|
(elisp-refs--search symbol
|
||||||
|
(elisp-refs--describe-button symbol 'symbol)
|
||||||
|
(lambda (buf)
|
||||||
|
(elisp-refs--read-and-find-symbol buf symbol))
|
||||||
|
path-prefix))
|
||||||
|
|
||||||
|
;;; Mode
|
||||||
|
|
||||||
|
(defvar elisp-refs-mode-map
|
||||||
|
(let ((map (make-sparse-keymap)))
|
||||||
|
;; TODO: it would be nice for TAB to navigate to file buttons too,
|
||||||
|
;; like *Help* does.
|
||||||
|
(set-keymap-parent map special-mode-map)
|
||||||
|
(define-key map (kbd "<tab>") #'elisp-refs-next-match)
|
||||||
|
(define-key map (kbd "<backtab>") #'elisp-refs-prev-match)
|
||||||
|
(define-key map (kbd "n") #'elisp-refs-next-match)
|
||||||
|
(define-key map (kbd "p") #'elisp-refs-prev-match)
|
||||||
|
(define-key map (kbd "q") #'kill-this-buffer)
|
||||||
|
(define-key map (kbd "RET") #'elisp-refs-visit-match)
|
||||||
|
map)
|
||||||
|
"Keymap for `elisp-refs-mode'.")
|
||||||
|
|
||||||
|
(define-derived-mode elisp-refs-mode special-mode "Refs"
|
||||||
|
"Major mode for refs results buffers.")
|
||||||
|
|
||||||
|
(defun elisp--refs-visit-match (open-fn)
|
||||||
|
"Go to the search result at point.
|
||||||
|
Open file with function OPEN_FN. `find-file` or `find-file-other-window`"
|
||||||
|
(interactive)
|
||||||
|
(let* ((path (get-text-property (point) 'elisp-refs-path))
|
||||||
|
(pos (get-text-property (point) 'elisp-refs-start-pos))
|
||||||
|
(unindent (get-text-property (point) 'elisp-refs-unindented))
|
||||||
|
(column-offset (current-column))
|
||||||
|
(line-offset -1))
|
||||||
|
(when (null path)
|
||||||
|
(user-error "No match here"))
|
||||||
|
|
||||||
|
;; If point is not on the first line of the match, work out how
|
||||||
|
;; far away the first line is.
|
||||||
|
(save-excursion
|
||||||
|
(while (equal pos (get-text-property (point) 'elisp-refs-start-pos))
|
||||||
|
(forward-line -1)
|
||||||
|
(cl-incf line-offset)))
|
||||||
|
|
||||||
|
(funcall open-fn path)
|
||||||
|
(goto-char pos)
|
||||||
|
;; Move point so we're on the same char in the buffer that we were
|
||||||
|
;; on in the results buffer.
|
||||||
|
(forward-line line-offset)
|
||||||
|
(beginning-of-line)
|
||||||
|
(let ((target-offset (+ column-offset unindent))
|
||||||
|
(i 0))
|
||||||
|
(while (< i target-offset)
|
||||||
|
(if (looking-at "\t")
|
||||||
|
(cl-incf i tab-width)
|
||||||
|
(cl-incf i))
|
||||||
|
(forward-char 1)))))
|
||||||
|
|
||||||
|
(defun elisp-refs-visit-match ()
|
||||||
|
"Goto the search result at point."
|
||||||
|
(interactive)
|
||||||
|
(elisp--refs-visit-match #'find-file))
|
||||||
|
|
||||||
|
(defun elisp-refs-visit-match-other-window ()
|
||||||
|
"Goto the search result at point, opening in another window."
|
||||||
|
(interactive)
|
||||||
|
(elisp--refs-visit-match #'find-file-other-window))
|
||||||
|
|
||||||
|
|
||||||
|
(defun elisp-refs--move-to-match (direction)
|
||||||
|
"Move point one match forwards.
|
||||||
|
If DIRECTION is -1, moves backwards instead."
|
||||||
|
(let* ((start-pos (point))
|
||||||
|
(match-pos (get-text-property start-pos 'elisp-refs-start-pos))
|
||||||
|
current-match-pos)
|
||||||
|
(condition-case _err
|
||||||
|
(progn
|
||||||
|
;; Move forward/backwards until we're on the next/previous match.
|
||||||
|
(catch 'done
|
||||||
|
(while t
|
||||||
|
(setq current-match-pos
|
||||||
|
(get-text-property (point) 'elisp-refs-start-pos))
|
||||||
|
(when (and current-match-pos
|
||||||
|
(not (equal match-pos current-match-pos)))
|
||||||
|
(throw 'done nil))
|
||||||
|
(forward-char direction)))
|
||||||
|
;; Move to the beginning of that match.
|
||||||
|
(while (equal (get-text-property (point) 'elisp-refs-start-pos)
|
||||||
|
(get-text-property (1- (point)) 'elisp-refs-start-pos))
|
||||||
|
(forward-char -1))
|
||||||
|
;; Move forward until we're on the first char of match within that
|
||||||
|
;; line.
|
||||||
|
(while (or
|
||||||
|
(looking-at " ")
|
||||||
|
(eq (get-text-property (point) 'face)
|
||||||
|
'font-lock-comment-face))
|
||||||
|
(forward-char 1)))
|
||||||
|
;; If we're at the last result, don't move point.
|
||||||
|
(end-of-buffer
|
||||||
|
(progn
|
||||||
|
(goto-char start-pos)
|
||||||
|
(signal 'end-of-buffer nil))))))
|
||||||
|
|
||||||
|
(defun elisp-refs-prev-match ()
|
||||||
|
"Move to the previous search result in the Refs buffer."
|
||||||
|
(interactive)
|
||||||
|
(elisp-refs--move-to-match -1))
|
||||||
|
|
||||||
|
(defun elisp-refs-next-match ()
|
||||||
|
"Move to the next search result in the Refs buffer."
|
||||||
|
(interactive)
|
||||||
|
(elisp-refs--move-to-match 1))
|
||||||
|
|
||||||
|
(provide 'elisp-refs)
|
||||||
|
;;; elisp-refs.el ends here
|
|
@ -1,9 +1,11 @@
|
||||||
(define-package "f" "20220911.711" "Modern API for working with files and directories"
|
(define-package "f" "20230704.1346" "Modern API for working with files and directories"
|
||||||
'((emacs "24.1")
|
'((emacs "24.1")
|
||||||
(s "1.7.0")
|
(s "1.7.0")
|
||||||
(dash "2.2.0"))
|
(dash "2.2.0"))
|
||||||
:commit "d50dca48929575642912bb5bbb2585709ba38f82" :authors
|
:commit "19e1da061e759b05e8c480b426287a063ca39484" :authors
|
||||||
'(("Johan Andersson" . "johan.rejeep@gmail.com"))
|
'(("Johan Andersson" . "johan.rejeep@gmail.com"))
|
||||||
|
:maintainers
|
||||||
|
'(("Lucien Cartier-Tilet" . "lucien@phundrak.com"))
|
||||||
:maintainer
|
:maintainer
|
||||||
'("Lucien Cartier-Tilet" . "lucien@phundrak.com")
|
'("Lucien Cartier-Tilet" . "lucien@phundrak.com")
|
||||||
:keywords
|
:keywords
|
|
@ -29,7 +29,8 @@
|
||||||
;;; Code:
|
;;; Code:
|
||||||
|
|
||||||
(when (version<= "28.1" emacs-version)
|
(when (version<= "28.1" emacs-version)
|
||||||
(require 'shortdoc)
|
(when (< emacs-major-version 29)
|
||||||
|
(require 'shortdoc))
|
||||||
|
|
||||||
(define-short-documentation-group f
|
(define-short-documentation-group f
|
||||||
"Paths"
|
"Paths"
|
||||||
|
@ -283,10 +284,16 @@
|
||||||
:result nil)
|
:result nil)
|
||||||
|
|
||||||
(f-hidden-p
|
(f-hidden-p
|
||||||
:no-eval (f-hidden-p "/path/to/foo")
|
:eval (f-hidden-p "path/to/foo")
|
||||||
:result nil
|
:eval (f-hidden-p ".path/to/foo")
|
||||||
:no-eval (f-hidden-p "/path/to/.foo")
|
:eval (f-hidden-p "path/.to/foo")
|
||||||
:result t)
|
:eval (f-hidden-p "path/to/.foo")
|
||||||
|
:eval (f-hidden-p ".path/to/foo" 'any)
|
||||||
|
:eval (f-hidden-p "path/.to/foo" 'any)
|
||||||
|
:eval (f-hidden-p "path/to/.foo" 'any)
|
||||||
|
:eval (f-hidden-p ".path/to/foo" 'last)
|
||||||
|
:eval (f-hidden-p "path/.to/foo" 'last)
|
||||||
|
:eval (f-hidden-p "path/to/.foo" 'last))
|
||||||
|
|
||||||
(f-empty-p
|
(f-empty-p
|
||||||
:no-eval (f-empty-p "/path/to/empty-file")
|
:no-eval (f-empty-p "/path/to/empty-file")
|
||||||
|
@ -298,6 +305,30 @@
|
||||||
:no-eval (f-empty-p "/path/to/dir-with-contents/")
|
:no-eval (f-empty-p "/path/to/dir-with-contents/")
|
||||||
:result nil)
|
:result nil)
|
||||||
|
|
||||||
|
(f-older-p
|
||||||
|
:noeval (f-older-p "older-file.txt" "newer-file.txt")
|
||||||
|
:result t
|
||||||
|
:noeval (f-older-p "newer-file.txt" "older-file.txt")
|
||||||
|
:result nil
|
||||||
|
:noeval (f-older-p "same-time1.txt" "same-time2.txt")
|
||||||
|
:result nil)
|
||||||
|
|
||||||
|
(f-newer-p
|
||||||
|
:noeval (f-newer-p "newer-file.txt" "older-file.txt")
|
||||||
|
:result t
|
||||||
|
:noeval (f-newer-p "older-file.txt" "newer-file.txt")
|
||||||
|
:result nil
|
||||||
|
:noeval (f-newer-p "same-time1.txt" "same-time2.txt")
|
||||||
|
:result nil)
|
||||||
|
|
||||||
|
(f-same-time-p
|
||||||
|
:noeval (f-same-time-p "same-time1.txt" "same-time2.txt")
|
||||||
|
:result t
|
||||||
|
:noeval (f-same-time-p "newer-file.txt" "older-file.txt")
|
||||||
|
:result nil
|
||||||
|
:noeval (f-same-time-p "older-file.txt" "newer-file.txt")
|
||||||
|
:result nil)
|
||||||
|
|
||||||
"Stats"
|
"Stats"
|
||||||
(f-size
|
(f-size
|
||||||
:no-eval* (f-size "path/to/file.txt")
|
:no-eval* (f-size "path/to/file.txt")
|
||||||
|
@ -309,16 +340,46 @@
|
||||||
:eval (f-depth "/usr/local/bin"))
|
:eval (f-depth "/usr/local/bin"))
|
||||||
|
|
||||||
(f-change-time
|
(f-change-time
|
||||||
:no-eval* (f-change-time "path/to/file.txt")
|
:no-eval (f-change-time "path/to/file.txt")
|
||||||
:no-eval* (f-change-time "path/to/dir"))
|
:result (25517 48756 26337 111000)
|
||||||
|
:no-eval (f-change-time "path/to/dir")
|
||||||
|
:result (25517 57887 344657 210000)
|
||||||
|
:no-eval (f-change-time "path/to/file.txt" t)
|
||||||
|
:result (1672330868026337111 . 1000000000)
|
||||||
|
:no-eval (f-change-time "path/to/dir" t)
|
||||||
|
:result (1672339999344657210 . 1000000000)
|
||||||
|
:no-eval (f-change-time "path/to/file.txt" 'seconds)
|
||||||
|
:result 1672330868
|
||||||
|
:no-eval (f-change-time "path/to/dir" 'seconds)
|
||||||
|
:result 1672339999)
|
||||||
|
|
||||||
(f-modification-time
|
(f-modification-time
|
||||||
:no-eval* (f-modification-time "path/to/file.txt")
|
:no-eval (f-modification-time "path/to/file.txt")
|
||||||
:no-eval* (f-modification-time "path/to/dir"))
|
:result (25517 48756 26337 111000)
|
||||||
|
:no-eval (f-modification-time "path/to/dir")
|
||||||
|
:result (25517 57887 344657 210000)
|
||||||
|
:no-eval (f-modification-time "path/to/file.txt" t)
|
||||||
|
:result (1672330868026337111 . 1000000000)
|
||||||
|
:no-eval (f-modification-time "path/to/dir" t)
|
||||||
|
:result (1672339999344657210 . 1000000000)
|
||||||
|
:no-eval (f-modification-time "path/to/file.txt" 'seconds)
|
||||||
|
:result 1672330868
|
||||||
|
:no-eval (f-modification-time "path/to/dir" 'seconds)
|
||||||
|
:result 1672339999)
|
||||||
|
|
||||||
(f-access-time
|
(f-access-time
|
||||||
:no-eval* (f-access-time "path/to/file.txt")
|
:no-eval (f-access-time "path/to/file.txt")
|
||||||
:no-eval* (f-access-time "path/to/dir"))
|
:result (25517 48756 26337 111000)
|
||||||
|
:no-eval (f-access-time "path/to/dir")
|
||||||
|
:result (25517 57887 344657 210000)
|
||||||
|
:no-eval (f-access-time "path/to/file.txt" t)
|
||||||
|
:result (1672330868026337111 . 1000000000)
|
||||||
|
:no-eval (f-access-time "path/to/dir" t)
|
||||||
|
:result (1672339999344657210 . 1000000000)
|
||||||
|
:no-eval (f-access-time "path/to/file.txt" 'seconds)
|
||||||
|
:result 1672330868
|
||||||
|
:no-eval (f-access-time "path/to/dir" 'seconds)
|
||||||
|
:result 1672339999)
|
||||||
|
|
||||||
"Misc"
|
"Misc"
|
||||||
(f-this-file
|
(f-this-file
|
||||||
|
@ -328,8 +389,8 @@
|
||||||
:eval (f-path-separator))
|
:eval (f-path-separator))
|
||||||
|
|
||||||
(f-glob
|
(f-glob
|
||||||
:noeval* (f-glob "path/to/*.el")
|
:no-eval* (f-glob "path/to/*.el")
|
||||||
:noeval* (f-glob "*.el" "path/to"))
|
:no-eval* (f-glob "*.el" "path/to"))
|
||||||
|
|
||||||
(f-entries
|
(f-entries
|
||||||
:no-eval* (f-entries "path/to/dir")
|
:no-eval* (f-entries "path/to/dir")
|
|
@ -28,6 +28,11 @@
|
||||||
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
||||||
;; Boston, MA 02110-1301, USA.
|
;; Boston, MA 02110-1301, USA.
|
||||||
|
|
||||||
|
;;; Commentary:
|
||||||
|
;;
|
||||||
|
;; Much inspired by magnar's excellent s.el and dash.el, f.el is a
|
||||||
|
;; modern API for working with files and directories in Emacs.
|
||||||
|
|
||||||
;;; Code:
|
;;; Code:
|
||||||
|
|
||||||
|
|
||||||
|
@ -68,7 +73,7 @@ will discard all the preceeding arguments and make this absolute
|
||||||
path the new root of the generated path."
|
path the new root of the generated path."
|
||||||
(let (path
|
(let (path
|
||||||
(relative (f-relative-p (car args))))
|
(relative (f-relative-p (car args))))
|
||||||
(-map
|
(mapc
|
||||||
(lambda (arg)
|
(lambda (arg)
|
||||||
(setq path (cond ((not path) arg)
|
(setq path (cond ((not path) arg)
|
||||||
((f-absolute-p arg)
|
((f-absolute-p arg)
|
||||||
|
@ -209,9 +214,9 @@ This function expects no duplicate paths."
|
||||||
(defun f-read-bytes (path &optional beg end)
|
(defun f-read-bytes (path &optional beg end)
|
||||||
"Read binary data from PATH.
|
"Read binary data from PATH.
|
||||||
|
|
||||||
Return the binary data as unibyte string. The optional second and
|
Return the binary data as unibyte string. The optional second
|
||||||
third arguments BEG and END specify what portion of the file to
|
and third arguments BEG and END specify what portion of the file
|
||||||
read."
|
to read."
|
||||||
(with-temp-buffer
|
(with-temp-buffer
|
||||||
(set-buffer-multibyte nil)
|
(set-buffer-multibyte nil)
|
||||||
(setq buffer-file-coding-system 'binary)
|
(setq buffer-file-coding-system 'binary)
|
||||||
|
@ -449,16 +454,49 @@ The extension, in a file name, is the part that follows the last
|
||||||
(defun f-descendant-of-p (path-a path-b)
|
(defun f-descendant-of-p (path-a path-b)
|
||||||
"Return t if PATH-A is desendant of PATH-B."
|
"Return t if PATH-A is desendant of PATH-B."
|
||||||
(unless (f-same-p path-a path-b)
|
(unless (f-same-p path-a path-b)
|
||||||
(string-prefix-p (f-full path-b)
|
(let ((path-a (f-split (f-full path-a)))
|
||||||
(f-full path-a))))
|
(path-b (f-split (f-full path-b)))
|
||||||
|
(parent-p t))
|
||||||
|
(while (and path-b parent-p)
|
||||||
|
(if (string= (car path-a) (car path-b))
|
||||||
|
(setq path-a (cdr path-a)
|
||||||
|
path-b (cdr path-b))
|
||||||
|
(setq parent-p nil)))
|
||||||
|
parent-p)))
|
||||||
|
|
||||||
(defalias 'f-descendant-of? 'f-descendant-of-p)
|
(defalias 'f-descendant-of? 'f-descendant-of-p)
|
||||||
|
|
||||||
(defun f-hidden-p (path)
|
(defun f-hidden-p (path &optional behavior)
|
||||||
"Return t if PATH is hidden, nil otherwise."
|
"Return t if PATH is hidden, nil otherwise.
|
||||||
(unless (f-exists-p path)
|
|
||||||
(error "Path does not exist: %s" path))
|
BEHAVIOR controls when a path should be considered as hidden
|
||||||
(string= (substring path 0 1) "."))
|
depending on its value. Beware, if PATH begins with \"./\", the
|
||||||
|
current dir \".\" will not be considered as hidden.
|
||||||
|
|
||||||
|
When BEHAVIOR is nil, it will only check if the path begins with
|
||||||
|
a dot, as in .a/b/c, and return t if there is one. This is the
|
||||||
|
old behavior of f.el left as default for backward-compatibility
|
||||||
|
purposes.
|
||||||
|
|
||||||
|
When BEHAVIOR is ANY, return t if any of the elements of PATH is
|
||||||
|
hidden, nil otherwise.
|
||||||
|
|
||||||
|
When BEHAVIOR is LAST, return t only if the last element of PATH
|
||||||
|
is hidden, nil otherwise.
|
||||||
|
|
||||||
|
TODO: Hidden directories and files on Windows are marked
|
||||||
|
differently than on *NIX systems. This should be properly
|
||||||
|
implemented."
|
||||||
|
(let ((split-path (f-split path))
|
||||||
|
(check-hidden (lambda (elt)
|
||||||
|
(and (string= (substring elt 0 1) ".")
|
||||||
|
(not (member elt '("." "..")))))))
|
||||||
|
(pcase behavior
|
||||||
|
('any (-any check-hidden split-path))
|
||||||
|
('last (apply check-hidden (last split-path)))
|
||||||
|
(otherwise (if (null otherwise)
|
||||||
|
(funcall check-hidden (car split-path))
|
||||||
|
(error "Invalid value %S for argument BEHAVIOR" otherwise))))))
|
||||||
|
|
||||||
(defalias 'f-hidden? 'f-hidden-p)
|
(defalias 'f-hidden? 'f-hidden-p)
|
||||||
|
|
||||||
|
@ -491,26 +529,142 @@ detect the depth.
|
||||||
'/' will be zero depth, '/usr' will be one depth. And so on."
|
'/' will be zero depth, '/usr' will be one depth. And so on."
|
||||||
(- (length (f-split (f-expand path))) 1))
|
(- (length (f-split (f-expand path))) 1))
|
||||||
|
|
||||||
(defun f-change-time (path)
|
;; For Emacs 28 and below, forward-declare ‘current-time-list’, which was
|
||||||
|
;; introduced in Emacs 29.
|
||||||
|
(defvar current-time-list)
|
||||||
|
|
||||||
|
(defun f--get-time (path timestamp-p fn)
|
||||||
|
"Helper function, get time-related information for PATH.
|
||||||
|
Helper for `f-change-time', `f-modification-time',
|
||||||
|
`f-access-time'. It is meant to be called internally, avoid
|
||||||
|
calling it manually unless you have to.
|
||||||
|
|
||||||
|
If TIMESTAMP-P is non-nil, return the date requested as a
|
||||||
|
timestamp. If the value is \\='seconds, return the timestamp as
|
||||||
|
a timestamp with a one-second precision. Otherwise, the
|
||||||
|
timestamp is returned in a (TICKS . HZ) format, see
|
||||||
|
`current-time' if using Emacs 29 or newer.
|
||||||
|
|
||||||
|
Otherwise, if TIMESTAMP-P is nil, return the default style of
|
||||||
|
`current-time'.
|
||||||
|
|
||||||
|
FN is the function specified by the caller function to retrieve
|
||||||
|
the correct data from PATH."
|
||||||
|
(let* ((current-time-list (not timestamp-p))
|
||||||
|
(date (apply fn (list (file-attributes path))))
|
||||||
|
(emacs29-or-newer-p (version<= "29" emacs-version)))
|
||||||
|
(cond
|
||||||
|
((and (eq timestamp-p 'seconds) emacs29-or-newer-p)
|
||||||
|
(/ (car date) (cdr date)))
|
||||||
|
((or (and (not (eq timestamp-p 'seconds)) emacs29-or-newer-p)
|
||||||
|
(and (not timestamp-p) (not emacs29-or-newer-p)))
|
||||||
|
date)
|
||||||
|
((and (eq timestamp-p 'seconds) (not emacs29-or-newer-p))
|
||||||
|
(+ (* (nth 0 date) (expt 2 16))
|
||||||
|
(nth 1 date)))
|
||||||
|
((and timestamp-p (not emacs29-or-newer-p))
|
||||||
|
`(,(+ (* (nth 0 date) (expt 2 16) 1000)
|
||||||
|
(* (nth 1 date) 1000)
|
||||||
|
(nth 3 date))
|
||||||
|
. 1000)))))
|
||||||
|
|
||||||
|
(defun f-change-time (path &optional timestamp-p)
|
||||||
"Return the last status change time of PATH.
|
"Return the last status change time of PATH.
|
||||||
|
|
||||||
The status change time (ctime) of PATH in the same format as
|
The status change time (ctime) of PATH in the same format as
|
||||||
`current-time'. See `file-attributes' for technical details."
|
`current-time'. For details on TIMESTAMP-P and the format of the
|
||||||
(nth 6 (file-attributes path)))
|
returned value, see `f--get-time'."
|
||||||
|
(f--get-time path
|
||||||
|
timestamp-p
|
||||||
|
(if (fboundp 'file-attribute-status-change-time)
|
||||||
|
#'file-attribute-status-change-time
|
||||||
|
(lambda (f) (nth 6 f)))))
|
||||||
|
|
||||||
(defun f-modification-time (path)
|
(defun f-modification-time (path &optional timestamp-p)
|
||||||
"Return the last modification time of PATH.
|
"Return the last modification time of PATH.
|
||||||
|
|
||||||
The modification time (mtime) of PATH in the same format as
|
The modification time (mtime) of PATH in the same format as
|
||||||
`current-time'. See `file-attributes' for technical details."
|
`current-time'. For details on TIMESTAMP-P and the format of the
|
||||||
(nth 5 (file-attributes path)))
|
returned value, see `f--get-time'."
|
||||||
|
(f--get-time path
|
||||||
|
timestamp-p
|
||||||
|
(if (fboundp 'file-attribute-modification-time)
|
||||||
|
#'file-attribute-modification-time
|
||||||
|
(lambda (f) (nth 5 f)))))
|
||||||
|
|
||||||
(defun f-access-time (path)
|
(defun f-access-time (path &optional timestamp-p)
|
||||||
"Return the last access time of PATH.
|
"Return the last access time of PATH.
|
||||||
|
|
||||||
The access time (atime) of PATH is in the same format as
|
The access time (atime) of PATH is in the same format as
|
||||||
`current-time'. See `file-attributes' for technical details."
|
`current-time'. For details on TIMESTAMP-P and the format of the
|
||||||
(nth 4 (file-attributes path)))
|
returned value, see `f--get-time'."
|
||||||
|
(f--get-time path
|
||||||
|
timestamp-p
|
||||||
|
(if (fboundp 'file-attribute-access-time)
|
||||||
|
#'file-attribute-access-time
|
||||||
|
(lambda (f) (nth 4 f)))))
|
||||||
|
|
||||||
|
(defun f--three-way-compare (a b)
|
||||||
|
"Three way comparison.
|
||||||
|
|
||||||
|
Return -1 if A < B.
|
||||||
|
Return 0 if A = B.
|
||||||
|
Return 1 if A > B."
|
||||||
|
(cond ((< a b) -1)
|
||||||
|
((= a b) 0)
|
||||||
|
((> a b) 1)))
|
||||||
|
|
||||||
|
;; TODO: How to properly test this function?
|
||||||
|
(defun f--date-compare (file other method)
|
||||||
|
"Three-way comparison of the date of FILE and OTHER.
|
||||||
|
|
||||||
|
This function can return three values:
|
||||||
|
* 1 means FILE is newer than OTHER
|
||||||
|
* 0 means FILE and NEWER share the same date
|
||||||
|
* -1 means FILE is older than OTHER
|
||||||
|
|
||||||
|
The statistics used for the date comparison depends on METHOD.
|
||||||
|
When METHOD is null, compare their modification time. Otherwise,
|
||||||
|
compare their change time when METHOD is \\='change, or compare
|
||||||
|
their last access time when METHOD is \\='access."
|
||||||
|
(let* ((fn-method (cond
|
||||||
|
((eq 'change method) #'f-change-time)
|
||||||
|
((eq 'access method) #'f-access-time)
|
||||||
|
((null method) #'f-modification-time)
|
||||||
|
(t (error "Unknown method %S" method))))
|
||||||
|
(date-file (apply fn-method (list file)))
|
||||||
|
(date-other (apply fn-method (list other)))
|
||||||
|
(dates (-zip-pair date-file date-other)))
|
||||||
|
(message "[DEBUG]: file: %s\t\tother: %s" file other)
|
||||||
|
(message "[DEBUG]: dates: %S" dates)
|
||||||
|
(-reduce-from (lambda (acc elt)
|
||||||
|
(if (= acc 0)
|
||||||
|
(f--three-way-compare (car elt) (cdr elt))
|
||||||
|
acc))
|
||||||
|
0
|
||||||
|
dates)))
|
||||||
|
|
||||||
|
(defun f-older-p (file other &optional method)
|
||||||
|
"Compare if FILE is older than OTHER.
|
||||||
|
|
||||||
|
For more info on METHOD, see `f--date-compare'."
|
||||||
|
(< (f--date-compare file other method) 0))
|
||||||
|
|
||||||
|
(defalias 'f-older? #'f-older-p)
|
||||||
|
|
||||||
|
(defun f-newer-p (file other &optional method)
|
||||||
|
"Compare if FILE is newer than OTHER.
|
||||||
|
|
||||||
|
For more info on METHOD, see `f--date-compare'."
|
||||||
|
(> (f--date-compare file other method) 0))
|
||||||
|
|
||||||
|
(defalias 'f-newer? #'f-newer-p)
|
||||||
|
|
||||||
|
(defun f-same-time-p (file other &optional method)
|
||||||
|
"Check if FILE and OTHER share the same access or modification time.
|
||||||
|
|
||||||
|
For more info on METHOD, see `f--date-compare'."
|
||||||
|
(= (f--date-compare file other method) 0))
|
||||||
|
|
||||||
|
(defalias 'f-same-time? #'f-same-time-p)
|
||||||
|
|
||||||
|
|
||||||
;;;; Misc
|
;;;; Misc
|
||||||
|
@ -544,7 +698,7 @@ The access time (atime) of PATH is in the same format as
|
||||||
(member (f-filename file) '("." "..")))
|
(member (f-filename file) '("." "..")))
|
||||||
(directory-files path t))))
|
(directory-files path t))))
|
||||||
(cond (recursive
|
(cond (recursive
|
||||||
(-map
|
(mapc
|
||||||
(lambda (entry)
|
(lambda (entry)
|
||||||
(if (f-file-p entry)
|
(if (f-file-p entry)
|
||||||
(setq result (cons entry result))
|
(setq result (cons entry result))
|
|
@ -1,2 +0,0 @@
|
||||||
;;; Generated package description from go-mode.el -*- no-byte-compile: t -*-
|
|
||||||
(define-package "go-mode" "20220727.115" "Major mode for the Go programming language" '((emacs "26.1")) :commit "08aa90d52f0e7d2ad02f961b554e13329672d7cb" :authors '(("The go-mode Authors")) :maintainer '("The go-mode Authors") :keywords '("languages" "go") :url "https://github.com/dominikh/go-mode.el")
|
|
|
@ -30,7 +30,6 @@ The following extra functions are defined:
|
||||||
- `gofmt'
|
- `gofmt'
|
||||||
- `godoc' and `godoc-at-point'
|
- `godoc' and `godoc-at-point'
|
||||||
- `go-import-add'
|
- `go-import-add'
|
||||||
- `go-remove-unused-imports'
|
|
||||||
- `go-goto-arguments'
|
- `go-goto-arguments'
|
||||||
- `go-goto-docstring'
|
- `go-goto-docstring'
|
||||||
- `go-goto-function'
|
- `go-goto-function'
|
||||||
|
@ -42,11 +41,9 @@ The following extra functions are defined:
|
||||||
- `go-download-play'
|
- `go-download-play'
|
||||||
- `godef-describe' and `godef-jump'
|
- `godef-describe' and `godef-jump'
|
||||||
- `go-coverage'
|
- `go-coverage'
|
||||||
- `go-set-project'
|
|
||||||
- `go-reset-gopath'
|
|
||||||
|
|
||||||
If you want to automatically run `gofmt' before saving a file,
|
If you want to automatically run `gofmt' before saving a file,
|
||||||
add the following hook to your emacs configuration:
|
add the following hook to your Emacs configuration:
|
||||||
|
|
||||||
\(add-hook 'before-save-hook #'gofmt-before-save)
|
\(add-hook 'before-save-hook #'gofmt-before-save)
|
||||||
|
|
||||||
|
@ -110,6 +107,10 @@ A major mode for editor go.work files.
|
||||||
|
|
||||||
(register-definition-prefixes "go-mode" '("go-" "god" "gofmt"))
|
(register-definition-prefixes "go-mode" '("go-" "god" "gofmt"))
|
||||||
|
|
||||||
|
;;;***
|
||||||
|
|
||||||
|
;;;### (autoloads nil nil ("go-mode-pkg.el") (0 0 0 0))
|
||||||
|
|
||||||
;;;***
|
;;;***
|
||||||
|
|
||||||
;; Local Variables:
|
;; Local Variables:
|
14
code/elpa/go-mode-20230624.2315/go-mode-pkg.el
Normal file
14
code/elpa/go-mode-20230624.2315/go-mode-pkg.el
Normal file
|
@ -0,0 +1,14 @@
|
||||||
|
(define-package "go-mode" "20230624.2315" "Major mode for the Go programming language"
|
||||||
|
'((emacs "26.1"))
|
||||||
|
:commit "f21347ae9cf68ea33031bf5125896e8f16c8183c" :authors
|
||||||
|
'(("The go-mode Authors"))
|
||||||
|
:maintainers
|
||||||
|
'(("The go-mode Authors"))
|
||||||
|
:maintainer
|
||||||
|
'("The go-mode Authors")
|
||||||
|
:keywords
|
||||||
|
'("languages" "go")
|
||||||
|
:url "https://github.com/dominikh/go-mode.el")
|
||||||
|
;; Local Variables:
|
||||||
|
;; no-byte-compile: t
|
||||||
|
;; End:
|
|
@ -8,8 +8,6 @@
|
||||||
|
|
||||||
;; Author: The go-mode Authors
|
;; Author: The go-mode Authors
|
||||||
;; Version: 1.6.0
|
;; Version: 1.6.0
|
||||||
;; Package-Version: 20220727.115
|
|
||||||
;; Package-Commit: 08aa90d52f0e7d2ad02f961b554e13329672d7cb
|
|
||||||
;; Keywords: languages go
|
;; Keywords: languages go
|
||||||
;; Package-Requires: ((emacs "26.1"))
|
;; Package-Requires: ((emacs "26.1"))
|
||||||
;; URL: https://github.com/dominikh/go-mode.el
|
;; URL: https://github.com/dominikh/go-mode.el
|
||||||
|
@ -99,9 +97,10 @@ constant is changed.")
|
||||||
(defconst go--case-or-default-regexp (concat "\\(" go--case-regexp "\\|" "[[:space:]]*default:\\)"))
|
(defconst go--case-or-default-regexp (concat "\\(" go--case-regexp "\\|" "[[:space:]]*default:\\)"))
|
||||||
|
|
||||||
(defconst go-builtins
|
(defconst go-builtins
|
||||||
'("append" "cap" "close" "complex" "copy"
|
'("append" "cap" "clear" "close" "complex"
|
||||||
"delete" "imag" "len" "make" "new"
|
"copy" "delete" "imag" "len" "make"
|
||||||
"panic" "print" "println" "real" "recover")
|
"max" "min" "new" "panic" "print"
|
||||||
|
"println" "real" "recover")
|
||||||
"All built-in functions in the Go language. Used for font locking.")
|
"All built-in functions in the Go language. Used for font locking.")
|
||||||
|
|
||||||
(defconst go-mode-keywords
|
(defconst go-mode-keywords
|
||||||
|
@ -216,11 +215,12 @@ look like others."
|
||||||
:type '(repeat function)
|
:type '(repeat function)
|
||||||
:group 'go)
|
:group 'go)
|
||||||
|
|
||||||
|
(make-obsolete-variable 'go-guess-gopath-functions "GOPATH has been deprecated in favour of Go modules." "1.7.0")
|
||||||
|
|
||||||
(defcustom go-confirm-playground-uploads t
|
(defcustom go-confirm-playground-uploads t
|
||||||
"Ask before uploading code to the public Go Playground.
|
"Ask before uploading code to the public Go Playground.
|
||||||
|
|
||||||
Set this to nil to upload without prompting.
|
Set this to nil to upload without prompting."
|
||||||
"
|
|
||||||
:type 'boolean
|
:type 'boolean
|
||||||
:group 'go)
|
:group 'go)
|
||||||
|
|
||||||
|
@ -545,7 +545,6 @@ statements."
|
||||||
["Jump to Definition" godef-jump t]
|
["Jump to Definition" godef-jump t]
|
||||||
"---"
|
"---"
|
||||||
["Add Import" go-import-add t]
|
["Add Import" go-import-add t]
|
||||||
["Remove Unused Imports" go-remove-unused-imports t]
|
|
||||||
["Go to Imports" go-goto-imports t]
|
["Go to Imports" go-goto-imports t]
|
||||||
"---"
|
"---"
|
||||||
("Playground"
|
("Playground"
|
||||||
|
@ -1026,8 +1025,7 @@ open paren, the next line will have an additional indent.
|
||||||
For example:
|
For example:
|
||||||
foo ||
|
foo ||
|
||||||
foo && // this continuation line opens another indent
|
foo && // this continuation line opens another indent
|
||||||
foo
|
foo"
|
||||||
"
|
|
||||||
(save-excursion
|
(save-excursion
|
||||||
(let (prev-op (all-tighter t))
|
(let (prev-op (all-tighter t))
|
||||||
|
|
||||||
|
@ -1242,7 +1240,17 @@ INDENT is the normal indent of this line, i.e. that of the case body."
|
||||||
(goto-char (- (point-max) pos))))))
|
(goto-char (- (point-max) pos))))))
|
||||||
|
|
||||||
(defun go-beginning-of-defun (&optional count)
|
(defun go-beginning-of-defun (&optional count)
|
||||||
(unless (bolp)
|
(when (and (not (go-in-string-or-comment-p))
|
||||||
|
(not (bolp))
|
||||||
|
(save-excursion
|
||||||
|
(beginning-of-line)
|
||||||
|
(looking-at go-func-meth-regexp)))
|
||||||
|
;; Point is already somewhere on the function definition. Move to the end of line so that searching backwards finds
|
||||||
|
;; it. We don't go to the end of line unconditionally because that confuses evil-mode
|
||||||
|
;; (https://github.com/dominikh/go-mode.el/issues/186)
|
||||||
|
;;
|
||||||
|
;; If point is already at the beginning of line and looking at a function, then we want go-beginning-of-defun to
|
||||||
|
;; jump to the previous function instead.
|
||||||
(end-of-line))
|
(end-of-line))
|
||||||
(setq count (or count 1))
|
(setq count (or count 1))
|
||||||
(let (first failure)
|
(let (first failure)
|
||||||
|
@ -1309,8 +1317,7 @@ until you see the end. For example:
|
||||||
func foo(int, string) {}
|
func foo(int, string) {}
|
||||||
|
|
||||||
// names and types (don't know so until you see the \"int\").
|
// names and types (don't know so until you see the \"int\").
|
||||||
func foo(i, j int) {}
|
func foo(i, j int) {}"
|
||||||
"
|
|
||||||
(setq go--fontify-param-has-name (eq
|
(setq go--fontify-param-has-name (eq
|
||||||
(go--parameter-list-type (point-max))
|
(go--parameter-list-type (point-max))
|
||||||
'present))
|
'present))
|
||||||
|
@ -1339,8 +1346,7 @@ func foo(i, j int) {}
|
||||||
|
|
||||||
This is used as an anchored font lock keyword POST-MATCH-FORM. We
|
This is used as an anchored font lock keyword POST-MATCH-FORM. We
|
||||||
move point back to the opening \"(\" so we find nested param
|
move point back to the opening \"(\" so we find nested param
|
||||||
lists.
|
lists."
|
||||||
"
|
|
||||||
(goto-char go--fontify-param-beg))
|
(goto-char go--fontify-param-beg))
|
||||||
|
|
||||||
(defun go--match-param-start (end)
|
(defun go--match-param-start (end)
|
||||||
|
@ -1733,7 +1739,6 @@ The following extra functions are defined:
|
||||||
- `gofmt'
|
- `gofmt'
|
||||||
- `godoc' and `godoc-at-point'
|
- `godoc' and `godoc-at-point'
|
||||||
- `go-import-add'
|
- `go-import-add'
|
||||||
- `go-remove-unused-imports'
|
|
||||||
- `go-goto-arguments'
|
- `go-goto-arguments'
|
||||||
- `go-goto-docstring'
|
- `go-goto-docstring'
|
||||||
- `go-goto-function'
|
- `go-goto-function'
|
||||||
|
@ -1745,11 +1750,9 @@ The following extra functions are defined:
|
||||||
- `go-download-play'
|
- `go-download-play'
|
||||||
- `godef-describe' and `godef-jump'
|
- `godef-describe' and `godef-jump'
|
||||||
- `go-coverage'
|
- `go-coverage'
|
||||||
- `go-set-project'
|
|
||||||
- `go-reset-gopath'
|
|
||||||
|
|
||||||
If you want to automatically run `gofmt' before saving a file,
|
If you want to automatically run `gofmt' before saving a file,
|
||||||
add the following hook to your emacs configuration:
|
add the following hook to your Emacs configuration:
|
||||||
|
|
||||||
\(add-hook 'before-save-hook #'gofmt-before-save)
|
\(add-hook 'before-save-hook #'gofmt-before-save)
|
||||||
|
|
||||||
|
@ -2118,8 +2121,7 @@ Playground URL.
|
||||||
|
|
||||||
By default this function will prompt to confirm you want to upload
|
By default this function will prompt to confirm you want to upload
|
||||||
code to the Playground. You can disable the confirmation by setting
|
code to the Playground. You can disable the confirmation by setting
|
||||||
`go-confirm-playground-uploads' to nil.
|
`go-confirm-playground-uploads' to nil."
|
||||||
"
|
|
||||||
(interactive "r")
|
(interactive "r")
|
||||||
(if (and go-confirm-playground-uploads
|
(if (and go-confirm-playground-uploads
|
||||||
(not (yes-or-no-p "Upload to public Go Playground? ")))
|
(not (yes-or-no-p "Upload to public Go Playground? ")))
|
||||||
|
@ -2198,18 +2200,18 @@ uncommented, otherwise a new import will be added."
|
||||||
(if (re-search-forward (concat "^[[:space:]]*//[[:space:]]*import " line "$") nil t)
|
(if (re-search-forward (concat "^[[:space:]]*//[[:space:]]*import " line "$") nil t)
|
||||||
(uncomment-region (line-beginning-position) (line-end-position))
|
(uncomment-region (line-beginning-position) (line-end-position))
|
||||||
(cl-case (go-goto-imports)
|
(cl-case (go-goto-imports)
|
||||||
('fail (message "Could not find a place to add import."))
|
(fail (message "Could not find a place to add import."))
|
||||||
('block-empty
|
(block-empty
|
||||||
(insert "\n\t" line "\n"))
|
(insert "\n\t" line "\n"))
|
||||||
('block
|
(block
|
||||||
(save-excursion
|
(save-excursion
|
||||||
(re-search-backward "^import (")
|
(re-search-backward "^import (")
|
||||||
(setq import-start (point)))
|
(setq import-start (point)))
|
||||||
(if (re-search-backward (concat "^[[:space:]]*//[[:space:]]*" line "$") import-start t)
|
(if (re-search-backward (concat "^[[:space:]]*//[[:space:]]*" line "$") import-start t)
|
||||||
(uncomment-region (line-beginning-position) (line-end-position))
|
(uncomment-region (line-beginning-position) (line-end-position))
|
||||||
(insert "\n\t" line)))
|
(insert "\n\t" line)))
|
||||||
('single (insert "import " line "\n"))
|
(single (insert "import " line "\n"))
|
||||||
('none (insert "\nimport (\n\t" line "\n)\n")))))))
|
(none (insert "\nimport (\n\t" line "\n)\n")))))))
|
||||||
|
|
||||||
(defun go-root-and-paths ()
|
(defun go-root-and-paths ()
|
||||||
(let* ((output (process-lines go-command "env" "GOROOT" "GOPATH"))
|
(let* ((output (process-lines go-command "env" "GOROOT" "GOPATH"))
|
||||||
|
@ -2245,11 +2247,8 @@ If IGNORE-CASE is non-nil, the comparison is case-insensitive."
|
||||||
(funcall go-packages-function))
|
(funcall go-packages-function))
|
||||||
|
|
||||||
(defun go-packages-native ()
|
(defun go-packages-native ()
|
||||||
"Return a list of all installed Go packages. Obsolete.
|
"Return a list of all installed Go packages."
|
||||||
It looks for archive files in /pkg/. This strategy does not work
|
(declare (obsolete "this function does not work well with modern versions of Go. You should use `go-packages-go-list' instead." "1.7.0"))
|
||||||
well with the Go build cache or Go modules.
|
|
||||||
|
|
||||||
You should use `go-packages-go-list' instead."
|
|
||||||
(sort
|
(sort
|
||||||
(delete-dups
|
(delete-dups
|
||||||
(cl-mapcan
|
(cl-mapcan
|
||||||
|
@ -2293,6 +2292,7 @@ You should use `go-packages-go-list' instead."
|
||||||
"Remove all unused imports.
|
"Remove all unused imports.
|
||||||
If ARG is non-nil, unused imports will be commented, otherwise
|
If ARG is non-nil, unused imports will be commented, otherwise
|
||||||
they will be removed completely."
|
they will be removed completely."
|
||||||
|
(declare (obsolete "set `gofmt-command' to goimports instead, or use LSP and gopls's \"Organize Imports\" code action." "1.7.0"))
|
||||||
(interactive "P")
|
(interactive "P")
|
||||||
(save-excursion
|
(save-excursion
|
||||||
(let ((cur-buffer (current-buffer)) flymake-state lines)
|
(let ((cur-buffer (current-buffer)) flymake-state lines)
|
||||||
|
@ -2467,7 +2467,7 @@ divisor for FILE-NAME."
|
||||||
(insert-file-contents coverage-file)
|
(insert-file-contents coverage-file)
|
||||||
(go--goto-line 2) ;; Skip over mode
|
(go--goto-line 2) ;; Skip over mode
|
||||||
(while (not (eobp))
|
(while (not (eobp))
|
||||||
(let* ((parts (split-string (buffer-substring (point-at-bol) (point-at-eol)) ":"))
|
(let* ((parts (split-string (buffer-substring (line-beginning-position) (line-end-position)) ":"))
|
||||||
(file (car parts))
|
(file (car parts))
|
||||||
(rest (split-string (nth 1 parts) "[., ]")))
|
(rest (split-string (nth 1 parts) "[., ]")))
|
||||||
|
|
||||||
|
@ -2757,6 +2757,7 @@ returned."
|
||||||
|
|
||||||
(defun go-guess-gopath (&optional buffer)
|
(defun go-guess-gopath (&optional buffer)
|
||||||
"Determine a suitable GOPATH for BUFFER, or the current buffer if BUFFER is nil."
|
"Determine a suitable GOPATH for BUFFER, or the current buffer if BUFFER is nil."
|
||||||
|
(declare (obsolete "GOPATH has been deprecated in favour of Go modules." "1.7.0"))
|
||||||
(with-current-buffer (or buffer (current-buffer))
|
(with-current-buffer (or buffer (current-buffer))
|
||||||
(let ((gopath (cl-some (lambda (el) (funcall el))
|
(let ((gopath (cl-some (lambda (el) (funcall el))
|
||||||
go-guess-gopath-functions)))
|
go-guess-gopath-functions)))
|
||||||
|
@ -2769,6 +2770,7 @@ returned."
|
||||||
(defun go-plain-gopath ()
|
(defun go-plain-gopath ()
|
||||||
"Detect a normal GOPATH, by looking for the first `src'
|
"Detect a normal GOPATH, by looking for the first `src'
|
||||||
directory up the directory tree."
|
directory up the directory tree."
|
||||||
|
(declare (obsolete "GOPATH has been deprecated in favour of Go modules." "1.7.0"))
|
||||||
(let ((d (locate-dominating-file buffer-file-name "src")))
|
(let ((d (locate-dominating-file buffer-file-name "src")))
|
||||||
(if d
|
(if d
|
||||||
(list d))))
|
(list d))))
|
||||||
|
@ -2784,6 +2786,7 @@ of when Emacs was started.
|
||||||
This function can for example be used as a
|
This function can for example be used as a
|
||||||
projectile-switch-project-hook, or simply be called manually when
|
projectile-switch-project-hook, or simply be called manually when
|
||||||
switching projects."
|
switching projects."
|
||||||
|
(declare (obsolete "GOPATH has been deprecated in favour of Go modules." "1.7.0"))
|
||||||
(interactive)
|
(interactive)
|
||||||
(let ((gopath (or (go-guess-gopath buffer)
|
(let ((gopath (or (go-guess-gopath buffer)
|
||||||
(go-original-gopath))))
|
(go-original-gopath))))
|
||||||
|
@ -2792,6 +2795,7 @@ switching projects."
|
||||||
|
|
||||||
(defun go-reset-gopath ()
|
(defun go-reset-gopath ()
|
||||||
"Reset GOPATH to the value it had when Emacs started."
|
"Reset GOPATH to the value it had when Emacs started."
|
||||||
|
(declare (obsolete "GOPATH has been deprecated in favour of Go modules." "1.7.0"))
|
||||||
(interactive)
|
(interactive)
|
||||||
(let ((gopath (go-original-gopath)))
|
(let ((gopath (go-original-gopath)))
|
||||||
(setenv "GOPATH" gopath)
|
(setenv "GOPATH" gopath)
|
||||||
|
@ -2799,6 +2803,7 @@ switching projects."
|
||||||
|
|
||||||
(defun go-original-gopath ()
|
(defun go-original-gopath ()
|
||||||
"Return the original value of GOPATH from when Emacs was started."
|
"Return the original value of GOPATH from when Emacs was started."
|
||||||
|
(declare (obsolete "GOPATH has been deprecated in favour of Go modules." "1.7.0"))
|
||||||
(let ((process-environment initial-environment)) (getenv "GOPATH")))
|
(let ((process-environment initial-environment)) (getenv "GOPATH")))
|
||||||
|
|
||||||
(defun go--insert-modified-files ()
|
(defun go--insert-modified-files ()
|
9
code/elpa/helm-20230727.1557/.dir-locals.el
Normal file
9
code/elpa/helm-20230727.1557/.dir-locals.el
Normal file
|
@ -0,0 +1,9 @@
|
||||||
|
;;; Directory Local Variables
|
||||||
|
;;; For more information see (info "(emacs) Directory Variables")
|
||||||
|
|
||||||
|
((nil . ((bug-reference-bug-regexp . "\\(\\b\\(?:[Ii]ssue ?#?\\|[Bb]ug ?#?\\|[Pp]atch ?#\\|RFE ?#\\|PR [a-z+-]+/\\)\\([0-9]+\\(?:#[0-9]+\\)?\\)\\)")
|
||||||
|
(bug-reference-url-format . "https://github.com/emacs-helm/helm/issues/%s")
|
||||||
|
(byte-compile-warnings . (not obsolete docstrings docstrings-non-ascii-quotes))))
|
||||||
|
(emacs-lisp-mode . ((mode . bug-reference-prog)
|
||||||
|
(indent-tabs-mode . nil)
|
||||||
|
(fill-column . 80))))
|
265
code/elpa/helm-20230727.1557/emacs-helm.sh
Normal file
265
code/elpa/helm-20230727.1557/emacs-helm.sh
Normal file
|
@ -0,0 +1,265 @@
|
||||||
|
#!/usr/bin/env sh
|
||||||
|
|
||||||
|
|
||||||
|
## Copyright (C) 2012 ~ 2023 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 <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
## 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 <<EOF
|
||||||
|
Usage: ${0##*/} [-P PATH] [--toolbars] [--load-packages pkgs] [-h] [EMACS-OPTIONS-OR-FILENAME]
|
||||||
|
|
||||||
|
-P --path Specify path to emacs
|
||||||
|
-B --toolbars Display Menu bar, scroll bar etc...
|
||||||
|
--load-packages Load specified M/Elpa packages (separate with ",")
|
||||||
|
-h Display this help and exit
|
||||||
|
|
||||||
|
Any other Emacs options or filename must come after.
|
||||||
|
|
||||||
|
Emacs options:
|
||||||
|
|
||||||
|
Initialization options:
|
||||||
|
|
||||||
|
--chdir DIR change to directory DIR
|
||||||
|
--daemon, --bg-daemon[=NAME] start a (named) server in the background
|
||||||
|
--fg-daemon[=NAME] start a (named) server in the foreground
|
||||||
|
--debug-init enable Emacs Lisp debugger for init file
|
||||||
|
--display, -d DISPLAY use X server DISPLAY
|
||||||
|
--no-build-details do not add build details such as time stamps
|
||||||
|
--no-loadup, -nl do not load loadup.el into bare Emacs
|
||||||
|
--no-site-file do not load site-start.el
|
||||||
|
--no-x-resources do not load X resources
|
||||||
|
--no-window-system, -nw do not communicate with X, ignoring $DISPLAY
|
||||||
|
--script FILE run FILE as an Emacs Lisp script
|
||||||
|
--terminal, -t DEVICE use DEVICE for terminal I/O
|
||||||
|
|
||||||
|
Action options:
|
||||||
|
|
||||||
|
FILE visit FILE
|
||||||
|
+LINE go to line LINE in next FILE
|
||||||
|
+LINE:COLUMN go to line LINE, column COLUMN, in next FILE
|
||||||
|
--directory, -L DIR prepend DIR to load-path (with :DIR, append DIR)
|
||||||
|
--file FILE visit FILE
|
||||||
|
--find-file FILE visit FILE
|
||||||
|
--funcall, -f FUNC call Emacs Lisp function FUNC with no arguments
|
||||||
|
--insert FILE insert contents of FILE into current buffer
|
||||||
|
--load, -l FILE load Emacs Lisp FILE using the load function
|
||||||
|
--visit FILE visit FILE
|
||||||
|
|
||||||
|
Display options:
|
||||||
|
|
||||||
|
--background-color, -bg COLOR window background color
|
||||||
|
--basic-display, -D disable many display features;
|
||||||
|
used for debugging Emacs
|
||||||
|
--border-color, -bd COLOR main border color
|
||||||
|
--border-width, -bw WIDTH width of main border
|
||||||
|
--color, --color=MODE override color mode for character terminals;
|
||||||
|
MODE defaults to \`auto', and
|
||||||
|
can also be \`never', \`always',
|
||||||
|
or a mode name like \`ansi8'
|
||||||
|
--cursor-color, -cr COLOR color of the Emacs cursor indicating point
|
||||||
|
--font, -fn FONT default font; must be fixed-width
|
||||||
|
--foreground-color, -fg COLOR window foreground color
|
||||||
|
--fullheight, -fh make the first frame high as the screen
|
||||||
|
--fullscreen, -fs make the first frame fullscreen
|
||||||
|
--fullwidth, -fw make the first frame wide as the screen
|
||||||
|
--maximized, -mm make the first frame maximized
|
||||||
|
--geometry, -g GEOMETRY window geometry
|
||||||
|
--iconic start Emacs in iconified state
|
||||||
|
--internal-border, -ib WIDTH width between text and main border
|
||||||
|
--line-spacing, -lsp PIXELS additional space to put between lines
|
||||||
|
--mouse-color, -ms COLOR mouse cursor color in Emacs window
|
||||||
|
--name NAME title for initial Emacs frame
|
||||||
|
--reverse-video, -r, -rv switch foreground and background
|
||||||
|
--title, -T TITLE title for initial Emacs frame
|
||||||
|
--vertical-scroll-bars, -vb enable vertical scroll bars
|
||||||
|
--xrm XRESOURCES set additional X resources
|
||||||
|
--parent-id XID set parent window
|
||||||
|
--help display this help and exit
|
||||||
|
--version output version information and exit
|
||||||
|
|
||||||
|
You can generally also specify long option names with a single -; for
|
||||||
|
example, -batch as well as --batch. You can use any unambiguous
|
||||||
|
abbreviation for a --option.
|
||||||
|
|
||||||
|
Various environment variables and window system resources also affect
|
||||||
|
the operation of Emacs. See the main documentation.
|
||||||
|
EOF
|
||||||
|
}
|
||||||
|
|
||||||
|
for a in "$@"; do
|
||||||
|
case $a in
|
||||||
|
--path | -P)
|
||||||
|
shift 1
|
||||||
|
EMACS="$1"
|
||||||
|
shift 1
|
||||||
|
;;
|
||||||
|
--toolbars | -B)
|
||||||
|
shift 1
|
||||||
|
TOOLBARS=1
|
||||||
|
;;
|
||||||
|
--load-packages)
|
||||||
|
shift 1
|
||||||
|
LOAD_PACKAGES="$1"
|
||||||
|
shift 1
|
||||||
|
;;
|
||||||
|
-Q | -q)
|
||||||
|
QUICK="$a"
|
||||||
|
;;
|
||||||
|
-h)
|
||||||
|
usage
|
||||||
|
exit 1
|
||||||
|
;;
|
||||||
|
esac
|
||||||
|
done
|
||||||
|
|
||||||
|
LOAD_PATH=$($EMACS -q -batch --eval "(prin1 load-path)")
|
||||||
|
|
||||||
|
cd "${0%/*}" || exit 1
|
||||||
|
|
||||||
|
# Check if autoload file exists.
|
||||||
|
# It may be in a different directory if emacs-helm.sh is a symlink.
|
||||||
|
TRUENAME=$(find "${0%/*}" -path "$0" -printf "%l")
|
||||||
|
if [ -n "$TRUENAME" ]; then
|
||||||
|
AUTO_FILE="${TRUENAME%/*}/helm-autoloads.el"
|
||||||
|
else
|
||||||
|
AUTO_FILE="helm-autoloads.el"
|
||||||
|
fi
|
||||||
|
if [ ! -e "$AUTO_FILE" ]; then
|
||||||
|
echo No autoloads found, please run make first to generate autoload file
|
||||||
|
exit 1
|
||||||
|
fi
|
||||||
|
|
||||||
|
|
||||||
|
cat > $CONF_FILE <<EOF
|
||||||
|
(setq initial-scratch-message (concat initial-scratch-message
|
||||||
|
";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\\n\
|
||||||
|
;; This Emacs is Powered by \`HELM' using\\n\
|
||||||
|
;; emacs program \"$EMACS\".\\n\
|
||||||
|
;; This is a minimal \`helm' configuration to discover \`helm' or debug it.\\n\
|
||||||
|
;; You can retrieve this minimal configuration in \"$CONF_FILE\".\\n\
|
||||||
|
;;
|
||||||
|
;; Some original Emacs commands are replaced by their \`helm' counterparts:\\n\\n\
|
||||||
|
;; - \`find-file'(C-x C-f) =>\`helm-find-files'\\n\
|
||||||
|
;; - \`occur'(M-s o) =>\`helm-occur'\\n\
|
||||||
|
;; - \`list-buffers'(C-x C-b) =>\`helm-buffers-list'\\n\
|
||||||
|
;; - \`completion-at-point'(M-tab) =>\`helm-lisp-completion-at-point'[1]\\n\
|
||||||
|
;; - \`apropos-command'(C-h a) =>\`helm-apropos'\\n\
|
||||||
|
;; - \`dabbrev-expand'(M-/) =>\`helm-dabbrev'\\n\
|
||||||
|
;; - \`execute-extended-command'(M-x) =>\`helm-M-x'\\n\\n
|
||||||
|
;; Some other Emacs commands are \"helmized\" by \`helm-mode'.\\n\
|
||||||
|
;; [1] Coming with emacs-24.4, \`completion-at-point' is \"helmized\" by \`helm-mode'\\n\
|
||||||
|
|
||||||
|
;; which provides Helm completion in many places like \`shell-mode'.\\n\
|
||||||
|
;; Find context help for most Helm commands with \`C-h m'.\\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) (popup 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)
|
||||||
|
(unless (boundp 'completion-in-region-function)
|
||||||
|
(define-key lisp-interaction-mode-map [remap completion-at-point] 'helm-lisp-completion-at-point)
|
||||||
|
(define-key emacs-lisp-mode-map [remap completion-at-point] 'helm-lisp-completion-at-point))
|
||||||
|
(add-hook 'kill-emacs-hook #'(lambda () (and (file-exists-p "$CONF_FILE") (delete-file "$CONF_FILE"))))
|
||||||
|
EOF
|
||||||
|
|
||||||
|
$EMACS "$QUICK" -l "$CONF_FILE" "$@"
|
284
code/elpa/helm-20230727.1557/helm-adaptive.el
Normal file
284
code/elpa/helm-20230727.1557/helm-adaptive.el
Normal file
|
@ -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 ~ 2023 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 <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
;;; 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 -*-\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
|
1185
code/elpa/helm-20230727.1557/helm-autoloads.el
Normal file
1185
code/elpa/helm-20230727.1557/helm-autoloads.el
Normal file
File diff suppressed because it is too large
Load diff
836
code/elpa/helm-20230727.1557/helm-bookmark.el
Normal file
836
code/elpa/helm-20230727.1557/helm-bookmark.el
Normal file
|
@ -0,0 +1,836 @@
|
||||||
|
;;; helm-bookmark.el --- Helm for Emacs regular Bookmarks. -*- lexical-binding: t -*-
|
||||||
|
|
||||||
|
;; Copyright (C) 2012 ~ 2023 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 <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
;;; 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)
|
||||||
|
|
||||||
|
(declare-function helm-browse-project "helm-files" (arg))
|
||||||
|
(declare-function addressbook-bookmark-edit "ext:addressbook-bookmark.el" (bookmark))
|
||||||
|
(declare-function all-the-icons-fileicon "ext:all-the-icons.el")
|
||||||
|
(declare-function all-the-icons-icon-for-file"ext:all-the-icons.el")
|
||||||
|
(declare-function all-the-icons-octicon "ext:all-the-icons.el")
|
||||||
|
(declare-function all-the-icons-match-to-alist "ext:all-the-icons.el")
|
||||||
|
|
||||||
|
(defvar all-the-icons-dir-icon-alist)
|
||||||
|
|
||||||
|
|
||||||
|
(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)
|
||||||
|
(if (featurep 'all-the-icons)
|
||||||
|
(set var val)
|
||||||
|
(set var nil))))
|
||||||
|
|
||||||
|
(defcustom helm-bookmark-default-sort-method 'adaptive
|
||||||
|
"Sort method for `helm-filtered-bookmarks'.
|
||||||
|
|
||||||
|
Value can be either \\='native' or \\='adaptive'.
|
||||||
|
|
||||||
|
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)))))
|
||||||
|
|
||||||
|
(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)))
|
||||||
|
|
||||||
|
(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)))
|
||||||
|
|
||||||
|
(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)))
|
||||||
|
|
||||||
|
(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)))
|
||||||
|
|
||||||
|
(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 (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)
|
||||||
|
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)
|
||||||
|
|
||||||
|
|
||||||
|
;;;; 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))
|
||||||
|
|
||||||
|
;;; Woman Man
|
||||||
|
;;
|
||||||
|
(defun helm-bookmark-man-setup-alist ()
|
||||||
|
"Specialized filter function for bookmarks w3m."
|
||||||
|
(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))
|
||||||
|
|
||||||
|
;; Same as `helm-source-filtered-bookmarks' but override actions and keymap
|
||||||
|
;; specifically for helm-find-files bookmarks.
|
||||||
|
(defclass helm-bookmark-override-inheritor (helm-source) ())
|
||||||
|
|
||||||
|
(cl-defmethod helm--setup-source ((source helm-bookmark-override-inheritor))
|
||||||
|
;; Ensure `helm-source-in-buffer' method is called.
|
||||||
|
(cl-call-next-method)
|
||||||
|
(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))
|
||||||
|
collect (cons name action))
|
||||||
|
'(("Browse project" . helm-bookmark-browse-project)) 1))
|
||||||
|
(setf (slot-value source 'keymap) helm-bookmark-find-files-map))
|
||||||
|
|
||||||
|
(defclass helm-bookmark-find-files-class (helm-source-filtered-bookmarks
|
||||||
|
helm-bookmark-override-inheritor)
|
||||||
|
())
|
||||||
|
|
||||||
|
(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 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 (all-the-icons-match-to-alist
|
||||||
|
(helm-basename (helm-basedir isfile t))
|
||||||
|
all-the-icons-dir-icon-alist)
|
||||||
|
(all-the-icons-match-to-alist
|
||||||
|
(helm-basename isfile)
|
||||||
|
all-the-icons-dir-icon-alist))
|
||||||
|
(apply (car it) (cdr it))
|
||||||
|
(all-the-icons-octicon "file-directory")))
|
||||||
|
((and isfile isinfo) (all-the-icons-octicon "info"))
|
||||||
|
(isfile (all-the-icons-icon-for-file isfile))
|
||||||
|
((or iswoman isman)
|
||||||
|
(all-the-icons-fileicon "man-page"))
|
||||||
|
((or isgnus ismu4e)
|
||||||
|
(all-the-icons-octicon "mail-read"))))
|
||||||
|
;; Add a * if bookmark have annotation
|
||||||
|
if (and isannotation (not (string-equal isannotation "")))
|
||||||
|
do (setq trunc (concat "*" (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))
|
||||||
|
( ;; 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.
|
||||||
|
Interactively:
|
||||||
|
If called from the keyboard, then prompt for OLD.
|
||||||
|
If called from the menubar, select OLD from a menu.
|
||||||
|
If NEW is nil, then prompt for its string value.
|
||||||
|
|
||||||
|
If BATCH is non-nil, then do not rebuild the menu list.
|
||||||
|
|
||||||
|
While the user enters the new name, repeated `C-w' inserts
|
||||||
|
consecutive words from the buffer into the new bookmark name."
|
||||||
|
(interactive (list (bookmark-completing-read "Old 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))
|
||||||
|
(let ((newname (or new (read-from-minibuffer
|
||||||
|
"New name: " nil
|
||||||
|
(let ((now-map (copy-keymap minibuffer-local-map)))
|
||||||
|
(define-key now-map "\C-w" #'bookmark-yank-word)
|
||||||
|
now-map)
|
||||||
|
nil 'bookmark-history))))
|
||||||
|
(bookmark-set-name old newname)
|
||||||
|
(setq bookmark-current-bookmark newname)
|
||||||
|
(unless batch (bookmark-bmenu-surreptitiously-rebuild-list))
|
||||||
|
(helm-bookmark-maybe-save-bookmark) newname))
|
||||||
|
|
||||||
|
(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)))
|
||||||
|
|
||||||
|
|
||||||
|
;;;###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 (list (thing-at-point 'symbol)
|
||||||
|
(buffer-name helm-current-buffer))))
|
||||||
|
|
||||||
|
(provide 'helm-bookmark)
|
||||||
|
|
||||||
|
;;; helm-bookmark.el ends here
|
1179
code/elpa/helm-20230727.1557/helm-buffers.el
Normal file
1179
code/elpa/helm-20230727.1557/helm-buffers.el
Normal file
File diff suppressed because it is too large
Load diff
159
code/elpa/helm-20230727.1557/helm-color.el
Normal file
159
code/elpa/helm-20230727.1557/helm-color.el
Normal file
|
@ -0,0 +1,159 @@
|
||||||
|
;;; helm-color.el --- colors and faces -*- lexical-binding: t -*-
|
||||||
|
|
||||||
|
;; Copyright (C) 2012 ~ 2023 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 <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
;;; 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'."
|
||||||
|
(unless (helm-candidate-buffer)
|
||||||
|
(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) 'face)
|
||||||
|
(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
|
226
code/elpa/helm-20230727.1557/helm-comint.el
Normal file
226
code/elpa/helm-20230727.1557/helm-comint.el
Normal file
|
@ -0,0 +1,226 @@
|
||||||
|
;;; helm-comint.el --- Comint prompt navigation for helm. -*- lexical-binding: t -*-
|
||||||
|
|
||||||
|
;; Copyright (C) 2020 Pierre Neidhardt <mail@ambrevar.xyz>
|
||||||
|
|
||||||
|
;; 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 <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
;;; Commentary:
|
||||||
|
;;
|
||||||
|
;; You can bind this as follows in .emacs:
|
||||||
|
;;
|
||||||
|
;; (add-hook 'comint-mode-hook
|
||||||
|
;; (lambda ()
|
||||||
|
;; (define-key comint-mode-map (kbd "M-s f") 'helm-comint-prompts-all)))
|
||||||
|
|
||||||
|
;;; Code:
|
||||||
|
(require 'cl-lib)
|
||||||
|
(require 'helm)
|
||||||
|
(require 'helm-lib)
|
||||||
|
(require 'helm-help)
|
||||||
|
(require 'helm-elisp)
|
||||||
|
|
||||||
|
;;; Comint prompts
|
||||||
|
;;
|
||||||
|
(defface helm-comint-prompts-promptidx
|
||||||
|
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
|
||||||
|
(:foreground "cyan")))
|
||||||
|
"Face used to highlight comint prompt index."
|
||||||
|
:group 'helm-comint-faces)
|
||||||
|
|
||||||
|
(defface helm-comint-prompts-buffer-name
|
||||||
|
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
|
||||||
|
(:foreground "green")))
|
||||||
|
"Face used to highlight comint buffer name."
|
||||||
|
:group 'helm-comint-faces)
|
||||||
|
|
||||||
|
(defcustom helm-comint-prompts-promptidx-p t
|
||||||
|
"Show prompt number."
|
||||||
|
:group 'helm-comint
|
||||||
|
:type 'boolean)
|
||||||
|
|
||||||
|
(defcustom helm-comint-mode-list '(comint-mode slime-repl-mode sly-mrepl-mode sql-interactive-mode)
|
||||||
|
"Supported modes for prompt navigation.
|
||||||
|
Derived modes (e.g., Geiser's REPL) are automatically supported."
|
||||||
|
:group 'helm-comint
|
||||||
|
:type '(repeat (choice symbol)))
|
||||||
|
|
||||||
|
(defcustom helm-comint-next-prompt-function '((sly-mrepl-mode . (lambda ()
|
||||||
|
(sly-mrepl-next-prompt)
|
||||||
|
(point))))
|
||||||
|
"Alist of (MODE . NEXT-PROMPT-FUNCTION) to use.
|
||||||
|
If the current major mode is a key in this list, the associated
|
||||||
|
function will be used to navigate the prompts.
|
||||||
|
The function must return the point after the prompt.
|
||||||
|
Otherwise (comint-next-prompt 1) will be used."
|
||||||
|
:group 'helm-comint
|
||||||
|
:type '(alist :key-type symbol :value-type function))
|
||||||
|
|
||||||
|
(defcustom helm-comint-max-offset 400
|
||||||
|
"Max number of chars displayed per candidate in comint-input-ring browser.
|
||||||
|
When t, don't truncate candidate, show all.
|
||||||
|
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 anymore separators between candidates."
|
||||||
|
:type '(choice (const :tag "Disabled" t)
|
||||||
|
(integer :tag "Max candidate offset"))
|
||||||
|
:group 'helm-misc)
|
||||||
|
|
||||||
|
(defvar helm-comint-prompts-keymap
|
||||||
|
(let ((map (make-sparse-keymap)))
|
||||||
|
(set-keymap-parent map helm-map)
|
||||||
|
(define-key map (kbd "C-c o") #'helm-comint-prompts-other-window)
|
||||||
|
(define-key map (kbd "C-c C-o") #'helm-comint-prompts-other-frame)
|
||||||
|
map)
|
||||||
|
"Keymap for `helm-comint-prompt-all'.")
|
||||||
|
|
||||||
|
(defun helm-comint-prompts-list (mode &optional buffer)
|
||||||
|
"List the prompts in BUFFER in mode MODE.
|
||||||
|
|
||||||
|
Return a list of (\"prompt\" (point) (buffer-name) prompt-index))
|
||||||
|
E.g. (\"ls\" 162 \"*shell*\" 3).
|
||||||
|
If BUFFER is nil, use current buffer."
|
||||||
|
(with-current-buffer (or buffer (current-buffer))
|
||||||
|
(when (derived-mode-p mode)
|
||||||
|
(save-excursion
|
||||||
|
(goto-char (point-min))
|
||||||
|
(let (result (count 1))
|
||||||
|
(save-mark-and-excursion
|
||||||
|
(helm-awhile (and (not (eobp))
|
||||||
|
(helm-aif (alist-get major-mode helm-comint-next-prompt-function)
|
||||||
|
(funcall it)
|
||||||
|
(comint-next-prompt 1)))
|
||||||
|
(push (list (buffer-substring-no-properties
|
||||||
|
it (point-at-eol))
|
||||||
|
it (buffer-name) count)
|
||||||
|
result)
|
||||||
|
(setq count (1+ count))))
|
||||||
|
(nreverse result))))))
|
||||||
|
|
||||||
|
(defun helm-comint-prompts-list-all (mode)
|
||||||
|
"List the prompts of all buffers in mode MODE.
|
||||||
|
See `helm-comint-prompts-list'."
|
||||||
|
(cl-loop for b in (buffer-list)
|
||||||
|
append (helm-comint-prompts-list mode b)))
|
||||||
|
|
||||||
|
(defun helm-comint-prompts-transformer (candidates &optional all)
|
||||||
|
;; ("ls" 162 "*shell*" 3) => ("*shell*:3:ls" . ("ls" 162 "*shell*" 3))
|
||||||
|
(cl-loop for (prt pos buf id) in candidates
|
||||||
|
collect `(,(concat
|
||||||
|
(when all
|
||||||
|
(concat (propertize
|
||||||
|
buf
|
||||||
|
'face 'helm-comint-prompts-buffer-name)
|
||||||
|
":"))
|
||||||
|
(when helm-comint-prompts-promptidx-p
|
||||||
|
(concat (propertize
|
||||||
|
(number-to-string id)
|
||||||
|
'face 'helm-comint-prompts-promptidx)
|
||||||
|
":"))
|
||||||
|
prt)
|
||||||
|
. ,(list prt pos buf id))))
|
||||||
|
|
||||||
|
(defun helm-comint-prompts-all-transformer (candidates)
|
||||||
|
(helm-comint-prompts-transformer candidates t))
|
||||||
|
|
||||||
|
(cl-defun helm-comint-prompts-goto (candidate &optional (action 'switch-to-buffer))
|
||||||
|
;; Candidate format: ("ls" 162 "*shell*" 3)
|
||||||
|
(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-comint-prompts-goto-other-window (candidate)
|
||||||
|
(helm-comint-prompts-goto candidate 'switch-to-buffer-other-window))
|
||||||
|
|
||||||
|
(defun helm-comint-prompts-goto-other-frame (candidate)
|
||||||
|
(helm-comint-prompts-goto candidate 'switch-to-buffer-other-frame))
|
||||||
|
|
||||||
|
(helm-make-command-from-action helm-comint-prompts-other-window
|
||||||
|
"Switch to comint prompt in other window."
|
||||||
|
'helm-comint-prompts-goto-other-window)
|
||||||
|
|
||||||
|
(helm-make-command-from-action helm-comint-prompts-other-frame
|
||||||
|
"Switch to comint prompt in other frame."
|
||||||
|
'helm-comint-prompts-goto-other-frame)
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(defun helm-comint-prompts ()
|
||||||
|
"Pre-configured `helm' to browse the prompts of the current comint buffer."
|
||||||
|
(interactive)
|
||||||
|
(if (apply #'derived-mode-p helm-comint-mode-list)
|
||||||
|
(helm :sources
|
||||||
|
(helm-build-sync-source "Comint prompts"
|
||||||
|
:candidates (helm-comint-prompts-list major-mode)
|
||||||
|
:candidate-transformer #'helm-comint-prompts-transformer
|
||||||
|
:action '(("Go to prompt" . helm-comint-prompts-goto)))
|
||||||
|
:buffer "*helm comint prompts*")
|
||||||
|
(message "Current buffer is not a comint buffer")))
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(defun helm-comint-prompts-all ()
|
||||||
|
"Pre-configured `helm' to browse the prompts of all comint sessions."
|
||||||
|
(interactive)
|
||||||
|
(if (apply #'derived-mode-p helm-comint-mode-list)
|
||||||
|
(helm :sources
|
||||||
|
(helm-build-sync-source "All comint prompts"
|
||||||
|
:candidates (helm-comint-prompts-list-all major-mode)
|
||||||
|
:candidate-transformer #'helm-comint-prompts-all-transformer
|
||||||
|
:action (quote (("Go to prompt" . helm-comint-prompts-goto)
|
||||||
|
("Go to prompt in other window `C-c o`" .
|
||||||
|
helm-comint-prompts-goto-other-window)
|
||||||
|
("Go to prompt in other frame `C-c C-o`" .
|
||||||
|
helm-comint-prompts-goto-other-frame)))
|
||||||
|
:keymap helm-comint-prompts-keymap)
|
||||||
|
:buffer "*helm comint all prompts*")
|
||||||
|
(message "Current buffer is not a comint buffer")))
|
||||||
|
|
||||||
|
;;; Comint history
|
||||||
|
;;
|
||||||
|
;;
|
||||||
|
(defun helm-comint-input-ring-action (candidate)
|
||||||
|
"Default action for comint history."
|
||||||
|
(with-helm-current-buffer
|
||||||
|
(delete-region (comint-line-beginning-position) (point-max))
|
||||||
|
(insert candidate)))
|
||||||
|
|
||||||
|
(defvar helm-source-comint-input-ring
|
||||||
|
(helm-build-sync-source "Comint history"
|
||||||
|
:candidates (lambda ()
|
||||||
|
(with-helm-current-buffer
|
||||||
|
(cl-loop for elm in (ring-elements comint-input-ring)
|
||||||
|
unless (string= elm "")
|
||||||
|
collect elm)))
|
||||||
|
:action 'helm-comint-input-ring-action
|
||||||
|
;; Multiline does not work for `shell' because of an Emacs bug.
|
||||||
|
;; It works in other REPLs like Geiser.
|
||||||
|
:multiline 'helm-comint-max-offset)
|
||||||
|
"Source that provides Helm completion against `comint-input-ring'.")
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(defun helm-comint-input-ring ()
|
||||||
|
"Preconfigured `helm' that provide completion of `comint' history."
|
||||||
|
(interactive)
|
||||||
|
(when (or (derived-mode-p 'comint-mode)
|
||||||
|
(member major-mode helm-comint-mode-list))
|
||||||
|
(helm :sources 'helm-source-comint-input-ring
|
||||||
|
:input (buffer-substring-no-properties (comint-line-beginning-position)
|
||||||
|
(point-at-eol))
|
||||||
|
:buffer "*helm comint history*")))
|
||||||
|
|
||||||
|
(provide 'helm-comint)
|
||||||
|
|
||||||
|
;;; helm-comint.el ends here
|
413
code/elpa/helm-20230727.1557/helm-command.el
Normal file
413
code/elpa/helm-20230727.1557/helm-command.el
Normal file
|
@ -0,0 +1,413 @@
|
||||||
|
;;; helm-command.el --- Helm execute-exended-command. -*- lexical-binding: t -*-
|
||||||
|
|
||||||
|
;; Copyright (C) 2012 ~ 2023 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 <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
;;; 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-map>\\[helm-M-x-toggle-short-doc] while in helm-M-x session."
|
||||||
|
: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-active-mode
|
||||||
|
'((t :inherit font-lock-builtin-face))
|
||||||
|
"Face used by `helm-M-x' for activated modes."
|
||||||
|
: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 "<menu-bar>" 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 max-len = (when helm-M-x-show-short-doc
|
||||||
|
(buffer-local-value 'helm-candidate-buffer-longest-len
|
||||||
|
(get-buffer (helm-candidate-buffer))))
|
||||||
|
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 max-len
|
||||||
|
(helm-get-first-line-documentation (intern-soft cand)))
|
||||||
|
for disp = (if (or (eq sym major-mode)
|
||||||
|
(and (memq sym minor-mode-list)
|
||||||
|
(boundp sym)
|
||||||
|
(buffer-local-value sym helm-current-buffer)))
|
||||||
|
(propertize cand 'face 'helm-command-active-mode)
|
||||||
|
cand)
|
||||||
|
unless (and (null ignore-props) (or (get sym 'helm-only) (get sym 'no-helm-mx)))
|
||||||
|
collect
|
||||||
|
(cons (cond ((and (string-match "^M-x" key) local-key)
|
||||||
|
(format "%s%s%s %s"
|
||||||
|
disp
|
||||||
|
(if doc (make-string (+ 1 (- max-len (length cand))) ? ) "")
|
||||||
|
(if doc (propertize doc 'face 'helm-M-x-short-doc) "")
|
||||||
|
(propertize
|
||||||
|
" " 'display
|
||||||
|
(propertize local-key 'face 'helm-M-x-key))))
|
||||||
|
((string-match "^M-x" key)
|
||||||
|
(format "%s%s%s"
|
||||||
|
disp
|
||||||
|
(if doc (make-string (+ 1 (- max-len (length cand))) ? ) "")
|
||||||
|
(if doc (propertize doc 'face 'helm-M-x-short-doc) "")))
|
||||||
|
(t (format "%s%s%s %s"
|
||||||
|
disp
|
||||||
|
(if doc (make-string (+ 1 (- max-len (length cand))) ? ) "")
|
||||||
|
(if doc (propertize doc 'face 'helm-M-x-short-doc) "")
|
||||||
|
(propertize
|
||||||
|
" " 'display
|
||||||
|
(propertize key 'face 'helm-M-x-key)))))
|
||||||
|
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
|
||||||
|
(point-at-bol) (point-at-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-no-sort)
|
||||||
|
(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.
|
||||||
|
|
||||||
|
When `helm-M-x-use-completion-styles' is used, Emacs
|
||||||
|
`completion-styles' mechanism is used, otherwise standard helm
|
||||||
|
completion and helm fuzzy matching are used together.
|
||||||
|
|
||||||
|
Helm completion is not provided when executing or defining kbd
|
||||||
|
macros.
|
||||||
|
|
||||||
|
Arg COLLECTION should be an `obarray' but can be any object
|
||||||
|
suitable for `try-completion'. Arg PREDICATE is a function that
|
||||||
|
default to `commandp' see also `try-completion'. 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)
|
||||||
|
;; Sort on real candidate otherwise
|
||||||
|
;; "symbol (<binding>)" is used when sorting.
|
||||||
|
(helm-fuzzy-matching-default-sort-fn-1 candidates t)))
|
||||||
|
(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 ""))
|
||||||
|
: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 (cond
|
||||||
|
((eq helm-M-x-prefix-argument '-) "- ")
|
||||||
|
((and (consp helm-M-x-prefix-argument)
|
||||||
|
(eq (car helm-M-x-prefix-argument) 4))
|
||||||
|
"C-u ")
|
||||||
|
((and (consp helm-M-x-prefix-argument)
|
||||||
|
(integerp (car helm-M-x-prefix-argument)))
|
||||||
|
(format "%d " (car helm-M-x-prefix-argument)))
|
||||||
|
((integerp helm-M-x-prefix-argument)
|
||||||
|
(format "%d " helm-M-x-prefix-argument)))
|
||||||
|
"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)))))
|
||||||
|
|
||||||
|
;;;###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)
|
||||||
|
(helm-M-x-read-extended-command obarray)))
|
||||||
|
(put 'helm-M-x 'interactive-only 'command-execute)
|
||||||
|
|
||||||
|
(provide 'helm-command)
|
||||||
|
|
||||||
|
;;; helm-command.el ends here
|
388
code/elpa/helm-20230727.1557/helm-dabbrev.el
Normal file
388
code/elpa/helm-20230727.1557/helm-dabbrev.el
Normal file
|
@ -0,0 +1,388 @@
|
||||||
|
;;; helm-dabbrev.el --- Helm implementation of dabbrev. -*- lexical-binding: t -*-
|
||||||
|
|
||||||
|
;; Copyright (C) 2012 ~ 2023 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 <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
;;; 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 actually 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 (point-at-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
|
84
code/elpa/helm-20230727.1557/helm-easymenu.el
Normal file
84
code/elpa/helm-20230727.1557/helm-easymenu.el
Normal file
|
@ -0,0 +1,84 @@
|
||||||
|
;;; helm-easymenu.el --- Helm easymenu definitions. -*- lexical-binding: t -*-
|
||||||
|
|
||||||
|
;; Copyright (C) 2015 ~ 2020 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 <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
;;; 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])
|
||||||
|
("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])
|
||||||
|
("Elpa"
|
||||||
|
["Elisp packages" helm-list-elisp-packages t]
|
||||||
|
["Elisp packages no fetch" helm-list-elisp-packages-no-fetch 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
|
483
code/elpa/helm-20230727.1557/helm-elisp-package.el
Normal file
483
code/elpa/helm-20230727.1557/helm-elisp-package.el
Normal file
|
@ -0,0 +1,483 @@
|
||||||
|
;;; helm-elisp-package.el --- helm interface for package.el -*- lexical-binding: t -*-
|
||||||
|
|
||||||
|
;; Copyright (C) 2012 ~ 2023 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 <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
;;; Code:
|
||||||
|
(require 'cl-lib)
|
||||||
|
(require 'helm)
|
||||||
|
(require 'helm-help)
|
||||||
|
(require 'package)
|
||||||
|
|
||||||
|
(defgroup helm-el-package nil
|
||||||
|
"helm elisp packages."
|
||||||
|
:group 'helm)
|
||||||
|
|
||||||
|
(defcustom helm-el-package-initial-filter 'all
|
||||||
|
"Show only installed, upgraded or all packages at startup."
|
||||||
|
:type '(radio :tag "Initial filter for elisp packages"
|
||||||
|
(const :tag "Show all packages" all)
|
||||||
|
(const :tag "Show installed packages" installed)
|
||||||
|
(const :tag "Show not installed packages" uninstalled)
|
||||||
|
(const :tag "Show upgradable packages" upgrade)))
|
||||||
|
|
||||||
|
(defcustom helm-el-truncate-lines t
|
||||||
|
"Truncate lines in `helm-buffer' when non-nil."
|
||||||
|
:type 'boolean)
|
||||||
|
|
||||||
|
|
||||||
|
(defcustom helm-el-package-upgrade-on-start nil
|
||||||
|
"Show package upgrades on startup when non nil."
|
||||||
|
:type 'boolean)
|
||||||
|
|
||||||
|
(defcustom helm-el-package-autoremove-on-start nil
|
||||||
|
"Try to autoremove no more needed packages on startup.
|
||||||
|
See `package-autoremove'."
|
||||||
|
:type 'boolean)
|
||||||
|
|
||||||
|
;; internals vars
|
||||||
|
(defvar helm-el-package--show-only 'all)
|
||||||
|
(defvar helm-el-package--initialized-p nil)
|
||||||
|
(defvar helm-el-package--tabulated-list nil)
|
||||||
|
(defvar helm-el-package--upgrades nil)
|
||||||
|
(defvar helm-el-package--removable-packages nil)
|
||||||
|
|
||||||
|
;; Shutup bytecompiler for emacs-24*
|
||||||
|
(defvar package-menu-async) ; Only available on emacs-25.
|
||||||
|
(defvar helm-marked-buffer-name)
|
||||||
|
(declare-function async-byte-recompile-directory "ext:async-bytecomp.el")
|
||||||
|
(declare-function with-helm-display-marked-candidates "helm-utils.el")
|
||||||
|
|
||||||
|
|
||||||
|
(defun helm-el-package--init ()
|
||||||
|
;; In emacs-27 package-show-package-list returns an empty buffer
|
||||||
|
;; until package-initialize have been called.
|
||||||
|
(unless (or package--initialized
|
||||||
|
(null (boundp 'package-quickstart)))
|
||||||
|
(package-initialize))
|
||||||
|
(let (package-menu-async
|
||||||
|
(inhibit-read-only t))
|
||||||
|
(when (null package-alist)
|
||||||
|
(setq helm-el-package--show-only 'all))
|
||||||
|
(unless (consp package-selected-packages)
|
||||||
|
(helm-aif (package--find-non-dependencies)
|
||||||
|
(setq package-selected-packages it)))
|
||||||
|
(when (and (setq helm-el-package--removable-packages
|
||||||
|
(package--removable-packages))
|
||||||
|
helm-el-package-autoremove-on-start)
|
||||||
|
(package-autoremove))
|
||||||
|
(unwind-protect
|
||||||
|
(progn
|
||||||
|
(save-selected-window
|
||||||
|
(if helm-el-package--initialized-p
|
||||||
|
;; Use this as `list-packages' doesn't work
|
||||||
|
;; properly (empty buffer) when called from lisp
|
||||||
|
;; with 'no-fetch (emacs-25 WA).
|
||||||
|
(package-show-package-list)
|
||||||
|
(when helm--force-updating-p (message "Refreshing packages list..."))
|
||||||
|
(list-packages helm-el-package--initialized-p))
|
||||||
|
(setq helm-el-package--initialized-p t)
|
||||||
|
(message nil))
|
||||||
|
(helm-init-candidates-in-buffer
|
||||||
|
'global
|
||||||
|
(with-current-buffer (get-buffer "*Packages*")
|
||||||
|
(setq helm-el-package--tabulated-list tabulated-list-entries)
|
||||||
|
(remove-text-properties (point-min) (point-max)
|
||||||
|
'(read-only button follow-link category))
|
||||||
|
(goto-char (point-min))
|
||||||
|
(while (re-search-forward "^[ \t]+" nil t)
|
||||||
|
(replace-match ""))
|
||||||
|
(buffer-string)))
|
||||||
|
(setq helm-el-package--upgrades (helm-el-package-menu--find-upgrades))
|
||||||
|
(if helm--force-updating-p
|
||||||
|
(if helm-el-package--upgrades
|
||||||
|
(message "Refreshing packages list done, [%d] package(s) to upgrade"
|
||||||
|
(length helm-el-package--upgrades))
|
||||||
|
(message "Refreshing packages list done, no upgrades available"))
|
||||||
|
(setq helm-el-package--show-only (if (and helm-el-package-upgrade-on-start
|
||||||
|
helm-el-package--upgrades)
|
||||||
|
'upgrade
|
||||||
|
helm-el-package-initial-filter))))
|
||||||
|
(kill-buffer "*Packages*"))))
|
||||||
|
|
||||||
|
(defun helm-el-package-describe (candidate)
|
||||||
|
(let ((id (get-text-property 0 'tabulated-list-id candidate)))
|
||||||
|
(describe-package (package-desc-name id))))
|
||||||
|
|
||||||
|
(defun helm-el-package-visit-homepage (candidate)
|
||||||
|
(let* ((id (get-text-property 0 'tabulated-list-id candidate))
|
||||||
|
(pkg (package-desc-name id))
|
||||||
|
(desc (cadr (assoc pkg package-archive-contents)))
|
||||||
|
(extras (package-desc-extras desc))
|
||||||
|
(url (and (listp extras) (cdr-safe (assoc :url extras)))))
|
||||||
|
(if (stringp url)
|
||||||
|
(browse-url url)
|
||||||
|
(message "Package %s has no homepage"
|
||||||
|
(propertize (symbol-name pkg)
|
||||||
|
'face 'font-lock-keyword-face)))))
|
||||||
|
|
||||||
|
(helm-make-command-from-action helm-el-run-visit-homepage
|
||||||
|
"Visit package homepage from helm elisp packages."
|
||||||
|
'helm-el-package-visit-homepage)
|
||||||
|
|
||||||
|
(defun helm-elisp-package--pkg-name (pkg)
|
||||||
|
(if (package-desc-p pkg)
|
||||||
|
(package-desc-name pkg)
|
||||||
|
pkg))
|
||||||
|
|
||||||
|
(defun helm-el-package-install-1 (pkg-list)
|
||||||
|
(cl-loop with mkd = pkg-list
|
||||||
|
for p in mkd
|
||||||
|
for id = (get-text-property 0 'tabulated-list-id p)
|
||||||
|
for name = (helm-elisp-package--pkg-name id)
|
||||||
|
do (package-install id t)
|
||||||
|
when (helm-aand (assq name package-alist)
|
||||||
|
(package-desc-dir (cadr it))
|
||||||
|
(file-exists-p it))
|
||||||
|
collect id into installed-list and
|
||||||
|
do (unless (package--user-selected-p name)
|
||||||
|
(package--save-selected-packages
|
||||||
|
(cons name package-selected-packages)))
|
||||||
|
finally do (message (format "%d packages installed:\n(%s)"
|
||||||
|
(length installed-list)
|
||||||
|
(mapconcat #'package-desc-full-name
|
||||||
|
installed-list ", ")))))
|
||||||
|
|
||||||
|
(defun helm-el-package-install (_candidate)
|
||||||
|
(helm-el-package-install-1 (helm-marked-candidates)))
|
||||||
|
|
||||||
|
(helm-make-command-from-action helm-el-run-package-install
|
||||||
|
"Install package from helm elisp packages."
|
||||||
|
'helm-el-package-install)
|
||||||
|
|
||||||
|
(defun helm-el-package-uninstall-1 (pkg-list &optional force)
|
||||||
|
(cl-loop with mkd = pkg-list
|
||||||
|
for p in mkd
|
||||||
|
for id = (get-text-property 0 'tabulated-list-id p)
|
||||||
|
do
|
||||||
|
(condition-case-unless-debug err
|
||||||
|
(package-delete id force)
|
||||||
|
(error (message (cadr err))))
|
||||||
|
;; Seems like package-descs are symbols with props instead of
|
||||||
|
;; vectors in emacs-27, use package-desc-name to ensure
|
||||||
|
;; compatibility in all emacs versions.
|
||||||
|
unless (assoc (package-desc-name id) package-alist)
|
||||||
|
collect id into delete-list
|
||||||
|
finally do (if delete-list
|
||||||
|
(message (format "%d packages deleted:\n(%s)"
|
||||||
|
(length delete-list)
|
||||||
|
(mapconcat #'package-desc-full-name
|
||||||
|
delete-list ", ")))
|
||||||
|
"No package deleted")))
|
||||||
|
|
||||||
|
(defun helm-el-package-uninstall (_candidate)
|
||||||
|
(helm-el-package-uninstall-1 (helm-marked-candidates) helm-current-prefix-arg))
|
||||||
|
|
||||||
|
(helm-make-command-from-action helm-el-run-package-uninstall
|
||||||
|
"Uninstall package from helm elisp packages."
|
||||||
|
'helm-el-package-uninstall)
|
||||||
|
|
||||||
|
(defun helm-el-package-menu--find-upgrades ()
|
||||||
|
(cl-loop for entry in helm-el-package--tabulated-list
|
||||||
|
for pkg-desc = (car entry)
|
||||||
|
for status = (package-desc-status pkg-desc)
|
||||||
|
;; A dependency.
|
||||||
|
when (string= status "dependency")
|
||||||
|
collect pkg-desc into dependencies
|
||||||
|
;; An installed package used as dependency (user have
|
||||||
|
;; installed this package explicitely).
|
||||||
|
when (package--used-elsewhere-p pkg-desc)
|
||||||
|
collect pkg-desc into installed-as-dep
|
||||||
|
;; An installed package.
|
||||||
|
when (member status '("installed" "unsigned"))
|
||||||
|
collect pkg-desc into installed
|
||||||
|
when (member status '("available" "new"))
|
||||||
|
collect (cons (package-desc-name pkg-desc) pkg-desc) into available
|
||||||
|
finally return
|
||||||
|
;; Always try to upgrade dependencies before installed.
|
||||||
|
(cl-loop with all = (append dependencies installed-as-dep installed)
|
||||||
|
for pkg in all
|
||||||
|
for name = (package-desc-name pkg)
|
||||||
|
for avail-pkg = (assq name available)
|
||||||
|
when (and avail-pkg
|
||||||
|
(version-list-<
|
||||||
|
(package-desc-version pkg)
|
||||||
|
(package-desc-version (cdr avail-pkg))))
|
||||||
|
collect avail-pkg)))
|
||||||
|
|
||||||
|
(defun helm-el-package--user-installed-p (package)
|
||||||
|
"Return non-nil if PACKAGE is a user-installed package."
|
||||||
|
(let* ((assoc (assq package package-alist))
|
||||||
|
(pkg-desc (and assoc (cadr assoc)))
|
||||||
|
(dir (and pkg-desc (package-desc-dir pkg-desc))))
|
||||||
|
(when dir
|
||||||
|
(file-in-directory-p dir package-user-dir))))
|
||||||
|
|
||||||
|
(defun helm-el-package-upgrade-1 (pkg-list)
|
||||||
|
(cl-loop for p in pkg-list
|
||||||
|
for pkg-desc = (car p)
|
||||||
|
for pkg-name = (package-desc-name pkg-desc)
|
||||||
|
for upgrade = (cdr (assq pkg-name
|
||||||
|
helm-el-package--upgrades))
|
||||||
|
do
|
||||||
|
(cond (;; Install.
|
||||||
|
(equal pkg-desc upgrade)
|
||||||
|
(message "Installing package `%s'" pkg-name)
|
||||||
|
(package-install pkg-desc t))
|
||||||
|
(;; Do nothing.
|
||||||
|
(or (null upgrade)
|
||||||
|
;; This may happen when a Elpa version of pkg
|
||||||
|
;; is installed and need upgrade and pkg is as
|
||||||
|
;; well a builtin package.
|
||||||
|
(package-built-in-p pkg-name))
|
||||||
|
(ignore))
|
||||||
|
(;; Delete.
|
||||||
|
t
|
||||||
|
(message "Deleting package `%s'" pkg-name)
|
||||||
|
(package-delete pkg-desc t t)))))
|
||||||
|
|
||||||
|
(defun helm-el-package-upgrade (_candidate)
|
||||||
|
(helm-el-package-upgrade-1
|
||||||
|
(cl-loop with pkgs = (helm-marked-candidates)
|
||||||
|
for p in helm-el-package--tabulated-list
|
||||||
|
for pkg = (car p)
|
||||||
|
if (member (symbol-name (package-desc-name pkg)) pkgs)
|
||||||
|
collect p)))
|
||||||
|
|
||||||
|
(helm-make-command-from-action helm-el-run-package-upgrade
|
||||||
|
"Uninstall package from helm elisp packages."
|
||||||
|
'helm-el-package-upgrade)
|
||||||
|
|
||||||
|
(defun helm-el-package-upgrade-all ()
|
||||||
|
(if helm-el-package--upgrades
|
||||||
|
(with-helm-display-marked-candidates
|
||||||
|
helm-marked-buffer-name (helm-fast-remove-dups
|
||||||
|
(mapcar (lambda (x) (symbol-name (car x)))
|
||||||
|
helm-el-package--upgrades)
|
||||||
|
:test 'equal)
|
||||||
|
(when (y-or-n-p "Upgrade all packages? ")
|
||||||
|
(helm-el-package-upgrade-1 helm-el-package--tabulated-list)))
|
||||||
|
(message "No packages to upgrade actually!")))
|
||||||
|
|
||||||
|
(defun helm-el-package-upgrade-all-action (_candidate)
|
||||||
|
(helm-el-package-upgrade-all))
|
||||||
|
|
||||||
|
(helm-make-command-from-action helm-el-run-package-upgrade-all
|
||||||
|
"Upgrade all packages from helm elisp packages."
|
||||||
|
'helm-el-package-upgrade-all-action)
|
||||||
|
|
||||||
|
(defun helm-el-package--transformer (candidates _source)
|
||||||
|
(cl-loop for c in candidates
|
||||||
|
for disp = (concat " " c)
|
||||||
|
for id = (get-text-property 0 'tabulated-list-id c)
|
||||||
|
for name = (and id (package-desc-name id))
|
||||||
|
for desc = (package-desc-status id)
|
||||||
|
for built-in-p = (and (package-built-in-p name)
|
||||||
|
(not (member desc '("available" "new"
|
||||||
|
"installed" "dependency"))))
|
||||||
|
for installed-p = (member desc '("installed" "dependency"))
|
||||||
|
for upgrade-p = (assq name helm-el-package--upgrades)
|
||||||
|
for user-installed-p = (memq name package-selected-packages)
|
||||||
|
do (when (and user-installed-p (not upgrade-p))
|
||||||
|
(put-text-property 0 2 'display "S " disp))
|
||||||
|
do (when (or (memq name helm-el-package--removable-packages)
|
||||||
|
(and upgrade-p installed-p))
|
||||||
|
(put-text-property 0 2 'display "U " disp)
|
||||||
|
(put-text-property
|
||||||
|
2 (+ (length (symbol-name name)) 2)
|
||||||
|
'face 'font-lock-variable-name-face disp))
|
||||||
|
do (when (and upgrade-p (not installed-p) (not built-in-p))
|
||||||
|
(put-text-property 0 2 'display "I " disp))
|
||||||
|
for cand = (cons disp (car (split-string disp)))
|
||||||
|
when (or (and built-in-p
|
||||||
|
(eq helm-el-package--show-only 'built-in))
|
||||||
|
(and upgrade-p
|
||||||
|
(eq helm-el-package--show-only 'upgrade))
|
||||||
|
(and installed-p
|
||||||
|
(eq helm-el-package--show-only 'installed))
|
||||||
|
(and (not installed-p)
|
||||||
|
(not built-in-p)
|
||||||
|
(eq helm-el-package--show-only 'uninstalled))
|
||||||
|
(eq helm-el-package--show-only 'all))
|
||||||
|
collect cand))
|
||||||
|
|
||||||
|
(defun helm-el-package-show-built-in ()
|
||||||
|
(interactive)
|
||||||
|
(with-helm-alive-p
|
||||||
|
(setq helm-el-package--show-only 'built-in)
|
||||||
|
(helm-update)))
|
||||||
|
(put 'helm-el-package-show-built-in 'helm-only t)
|
||||||
|
|
||||||
|
(defun helm-el-package-show-upgrade ()
|
||||||
|
(interactive)
|
||||||
|
(with-helm-alive-p
|
||||||
|
(setq helm-el-package--show-only 'upgrade)
|
||||||
|
(helm-update)))
|
||||||
|
(put 'helm-el-package-show-upgrade 'helm-only t)
|
||||||
|
|
||||||
|
(defun helm-el-package-show-installed ()
|
||||||
|
(interactive)
|
||||||
|
(with-helm-alive-p
|
||||||
|
(setq helm-el-package--show-only 'installed)
|
||||||
|
(helm-update)))
|
||||||
|
(put 'helm-el-package-show-installed 'helm-only t)
|
||||||
|
|
||||||
|
(defun helm-el-package-show-all ()
|
||||||
|
(interactive)
|
||||||
|
(with-helm-alive-p
|
||||||
|
(setq helm-el-package--show-only 'all)
|
||||||
|
(helm-update)))
|
||||||
|
(put 'helm-el-package-show-all 'helm-only t)
|
||||||
|
|
||||||
|
(defun helm-el-package-show-uninstalled ()
|
||||||
|
(interactive)
|
||||||
|
(with-helm-alive-p
|
||||||
|
(setq helm-el-package--show-only 'uninstalled)
|
||||||
|
(helm-update)))
|
||||||
|
(put 'helm-el-package-show-uninstalled 'helm-only t)
|
||||||
|
|
||||||
|
(defvar helm-el-package-map
|
||||||
|
(let ((map (make-sparse-keymap)))
|
||||||
|
(set-keymap-parent map helm-map)
|
||||||
|
(define-key map (kbd "M-I") #'helm-el-package-show-installed)
|
||||||
|
(define-key map (kbd "M-O") #'helm-el-package-show-uninstalled)
|
||||||
|
(define-key map (kbd "M-U") #'helm-el-package-show-upgrade)
|
||||||
|
(define-key map (kbd "M-B") #'helm-el-package-show-built-in)
|
||||||
|
(define-key map (kbd "M-A") #'helm-el-package-show-all)
|
||||||
|
(define-key map (kbd "C-c i") #'helm-el-run-package-install)
|
||||||
|
(define-key map (kbd "C-c r") #'helm-el-run-package-reinstall)
|
||||||
|
(define-key map (kbd "C-c d") #'helm-el-run-package-uninstall)
|
||||||
|
(define-key map (kbd "C-c u") #'helm-el-run-package-upgrade)
|
||||||
|
(define-key map (kbd "C-c U") #'helm-el-run-package-upgrade-all)
|
||||||
|
(define-key map (kbd "C-c @") #'helm-el-run-visit-homepage)
|
||||||
|
map))
|
||||||
|
|
||||||
|
(defvar helm-source-list-el-package nil)
|
||||||
|
(defclass helm-list-el-package-source (helm-source-in-buffer)
|
||||||
|
((init :initform 'helm-el-package--init)
|
||||||
|
(get-line :initform 'buffer-substring)
|
||||||
|
(filtered-candidate-transformer :initform 'helm-el-package--transformer)
|
||||||
|
(action-transformer :initform 'helm-el-package--action-transformer)
|
||||||
|
(help-message :initform 'helm-el-package-help-message)
|
||||||
|
(keymap :initform 'helm-el-package-map)
|
||||||
|
(update :initform 'helm-el-package--update)
|
||||||
|
(candidate-number-limit :initform 9999)
|
||||||
|
(action :initform '(("Describe package" . helm-el-package-describe)
|
||||||
|
("Visit homepage" . helm-el-package-visit-homepage)))
|
||||||
|
(find-file-target :initform #'helm-el-package-quit-an-find-file-fn)
|
||||||
|
(group :initform 'helm-el-package)))
|
||||||
|
|
||||||
|
(defun helm-el-package-quit-an-find-file-fn (source)
|
||||||
|
(let* ((sel (helm-get-selection nil nil source))
|
||||||
|
(pkg (and (stringp sel)
|
||||||
|
(get-text-property 0 'tabulated-list-id sel))))
|
||||||
|
(when (and pkg (package-installed-p pkg))
|
||||||
|
(expand-file-name (package-desc-dir pkg)))))
|
||||||
|
|
||||||
|
(defun helm-el-package--action-transformer (actions candidate)
|
||||||
|
(let* ((pkg-desc (get-text-property 0 'tabulated-list-id candidate))
|
||||||
|
(status (package-desc-status pkg-desc))
|
||||||
|
(pkg-name (package-desc-name pkg-desc))
|
||||||
|
(built-in (and (package-built-in-p pkg-name)
|
||||||
|
(not (member status '("available" "new"
|
||||||
|
"installed" "dependency")))))
|
||||||
|
(acts (if helm-el-package--upgrades
|
||||||
|
(append actions '(("Upgrade all packages"
|
||||||
|
. helm-el-package-upgrade-all-action)))
|
||||||
|
actions)))
|
||||||
|
(cond (built-in '(("Describe package" . helm-el-package-describe)))
|
||||||
|
((and (package-installed-p pkg-name)
|
||||||
|
(cdr (assq pkg-name helm-el-package--upgrades))
|
||||||
|
(member status '("installed" "dependency")))
|
||||||
|
(append '(("Upgrade package(s)" . helm-el-package-upgrade)
|
||||||
|
("Uninstall package(s)" . helm-el-package-uninstall))
|
||||||
|
acts))
|
||||||
|
((and (package-installed-p pkg-name)
|
||||||
|
(cdr (assq pkg-name helm-el-package--upgrades))
|
||||||
|
(string= status "available"))
|
||||||
|
(append '(("Upgrade package(s)" . helm-el-package-upgrade))
|
||||||
|
acts))
|
||||||
|
((and (package-installed-p pkg-name)
|
||||||
|
(or (null (package-built-in-p pkg-name))
|
||||||
|
(and (package-built-in-p pkg-name)
|
||||||
|
(assq pkg-name package-alist))))
|
||||||
|
(append acts '(("Reinstall package(s)" . helm-el-package-reinstall)
|
||||||
|
("Recompile package(s)" . helm-el-package-recompile)
|
||||||
|
("Uninstall package(s)" . helm-el-package-uninstall))))
|
||||||
|
(t (append acts '(("Install packages(s)" . helm-el-package-install)))))))
|
||||||
|
|
||||||
|
(defun helm-el-package--update ()
|
||||||
|
(setq helm-el-package--initialized-p nil))
|
||||||
|
|
||||||
|
(defun helm-el-package-recompile (_pkg)
|
||||||
|
(cl-loop for p in (helm-marked-candidates)
|
||||||
|
do (helm-el-package-recompile-1 p)))
|
||||||
|
|
||||||
|
(defun helm-el-package-recompile-1 (pkg)
|
||||||
|
(let* ((pkg-desc (get-text-property 0 'tabulated-list-id pkg))
|
||||||
|
(dir (package-desc-dir pkg-desc)))
|
||||||
|
(async-byte-recompile-directory dir)))
|
||||||
|
|
||||||
|
(defun helm-el-package-reinstall (_pkg)
|
||||||
|
(cl-loop for p in (helm-marked-candidates)
|
||||||
|
for pkg-desc = (get-text-property 0 'tabulated-list-id p)
|
||||||
|
do (helm-el-package-reinstall-1 pkg-desc)))
|
||||||
|
|
||||||
|
(defun helm-el-package-reinstall-1 (pkg-desc)
|
||||||
|
(let ((name (package-desc-name pkg-desc)))
|
||||||
|
(package-delete pkg-desc 'force 'nosave)
|
||||||
|
;; pkg-desc contain the description
|
||||||
|
;; of the installed package just removed
|
||||||
|
;; and is BTW no more valid.
|
||||||
|
;; Use the entry in package-archive-content
|
||||||
|
;; which is the non--installed package entry.
|
||||||
|
;; For some reason `package-install'
|
||||||
|
;; need a pkg-desc (package-desc-p) for the build-in
|
||||||
|
;; packages already installed, the name (as symbol)
|
||||||
|
;; fails with such packages.
|
||||||
|
(package-install
|
||||||
|
(cadr (assq name package-archive-contents)) t)))
|
||||||
|
|
||||||
|
(helm-make-command-from-action helm-el-run-package-reinstall
|
||||||
|
"Reinstall package from helm elisp packages."
|
||||||
|
'helm-el-package-reinstall)
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(defun helm-list-elisp-packages (arg)
|
||||||
|
"Preconfigured `helm' for listing and handling Emacs packages."
|
||||||
|
(interactive "P")
|
||||||
|
(when arg (setq helm-el-package--initialized-p nil))
|
||||||
|
(unless helm-source-list-el-package
|
||||||
|
(setq helm-source-list-el-package
|
||||||
|
(helm-make-source "list packages" 'helm-list-el-package-source)))
|
||||||
|
(helm :sources 'helm-source-list-el-package
|
||||||
|
:truncate-lines helm-el-truncate-lines
|
||||||
|
:full-frame t
|
||||||
|
:buffer "*helm list packages*"))
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(defun helm-list-elisp-packages-no-fetch (arg)
|
||||||
|
"Preconfigured Helm for Emacs packages.
|
||||||
|
|
||||||
|
Same as `helm-list-elisp-packages' but don't fetch packages on
|
||||||
|
remote. Called with a prefix ARG always fetch packages on
|
||||||
|
remote."
|
||||||
|
(interactive "P")
|
||||||
|
(let ((helm-el-package--initialized-p (null arg)))
|
||||||
|
(helm-list-elisp-packages nil)))
|
||||||
|
|
||||||
|
(provide 'helm-elisp-package)
|
||||||
|
|
||||||
|
;;; helm-elisp-package.el ends here
|
1141
code/elpa/helm-20230727.1557/helm-elisp.el
Normal file
1141
code/elpa/helm-20230727.1557/helm-elisp.el
Normal file
File diff suppressed because it is too large
Load diff
254
code/elpa/helm-20230727.1557/helm-epa.el
Normal file
254
code/elpa/helm-20230727.1557/helm-epa.el
Normal file
|
@ -0,0 +1,254 @@
|
||||||
|
;;; helm-epa.el --- helm interface for epa/epg -*- lexical-binding: t; -*-
|
||||||
|
|
||||||
|
;; Copyright (C) 2012 ~ 2023 Thierry Volpiatto <thievol@posteo.net>
|
||||||
|
|
||||||
|
;; 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 <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
|
||||||
|
;;; 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'."
|
||||||
|
(let ((result (helm :sources (helm-make-source "Epa select keys" 'helm-epa
|
||||||
|
:candidates (lambda ()
|
||||||
|
(helm-epa-get-key-list keys)))
|
||||||
|
:prompt (and prompt (helm-epa--format-prompt prompt))
|
||||||
|
:buffer "*helm epa*")))
|
||||||
|
(unless (equal result "")
|
||||||
|
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 ()
|
||||||
|
"A helm replacement for `epa--read-signature-type'."
|
||||||
|
(let ((answer (helm-read-answer "Signature type:
|
||||||
|
(n - Create a normal signature)
|
||||||
|
(c - Create a cleartext signature)
|
||||||
|
(d - Create a detached signature)"
|
||||||
|
'("n" "c" "d"))))
|
||||||
|
(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
|
494
code/elpa/helm-20230727.1557/helm-eshell.el
Normal file
494
code/elpa/helm-20230727.1557/helm-eshell.el
Normal file
|
@ -0,0 +1,494 @@
|
||||||
|
;;; helm-eshell.el --- pcomplete and eshell completion for helm. -*- lexical-binding: t -*-
|
||||||
|
|
||||||
|
;; Copyright (C) 2012 ~ 2023 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 <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
;;; 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-or-file-name-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 (point-at-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))
|
||||||
|
|
||||||
|
(cl-defun helm-eshell-prompts-goto (candidate &optional (action 'switch-to-buffer))
|
||||||
|
;; Candidate format: ("ls" 162 "*eshell*" 3)
|
||||||
|
(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
|
215
code/elpa/helm-20230727.1557/helm-eval.el
Normal file
215
code/elpa/helm-20230727.1557/helm-eval.el
Normal file
|
@ -0,0 +1,215 @@
|
||||||
|
;;; helm-eval.el --- eval expressions from helm. -*- lexical-binding: t -*-
|
||||||
|
|
||||||
|
;; Copyright (C) 2012 ~ 2023 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 <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
;;; Code:
|
||||||
|
(require 'cl-lib)
|
||||||
|
(require 'helm)
|
||||||
|
(require 'helm-help)
|
||||||
|
(require 'eldoc)
|
||||||
|
(require 'edebug)
|
||||||
|
|
||||||
|
(declare-function helm-lisp-completion-at-point "helm-elisp.el")
|
||||||
|
|
||||||
|
|
||||||
|
(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 "<C-return>") #'helm-eval-new-line-and-indent)
|
||||||
|
(define-key map (kbd "<M-tab>") #'lisp-indent-line)
|
||||||
|
(define-key map (kbd "<C-tab>") #'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 "<up>") #'previous-line)
|
||||||
|
(define-key map (kbd "<down>") #'next-line)
|
||||||
|
(define-key map (kbd "<right>") #'forward-char)
|
||||||
|
(define-key map (kbd "<left>") #'backward-char)
|
||||||
|
map))
|
||||||
|
|
||||||
|
(defun helm-build-evaluation-result-source ()
|
||||||
|
(helm-build-dummy-source "Evaluation Result"
|
||||||
|
: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
|
265
code/elpa/helm-20230727.1557/helm-external.el
Normal file
265
code/elpa/helm-20230727.1557/helm-external.el
Normal file
|
@ -0,0 +1,265 @@
|
||||||
|
;;; helm-external.el --- Run Externals commands within Emacs with helm completion. -*- lexical-binding: t -*-
|
||||||
|
|
||||||
|
;; Copyright (C) 2012 ~ 2023 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 <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
;;; 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)
|
||||||
|
"Returns 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'."
|
||||||
|
(helm-aif helm-external-commands-list
|
||||||
|
it
|
||||||
|
(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 ends here
|
143
code/elpa/helm-20230727.1557/helm-fd.el
Normal file
143
code/elpa/helm-20230727.1557/helm-fd.el
Normal file
|
@ -0,0 +1,143 @@
|
||||||
|
;;; helm-fd.el --- helm interface for fd command line tool. -*- lexical-binding: t -*-
|
||||||
|
|
||||||
|
;; Copyright (C) 2012 ~ 2023 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 <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
(require 'helm)
|
||||||
|
(require 'helm-types)
|
||||||
|
|
||||||
|
(declare-function ansi-color-apply "ansi-color.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-<down>") 'helm-fd-next-directory)
|
||||||
|
(define-key map (kbd "M-<up>") '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 (string= event "finished\n")
|
||||||
|
(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
|
||||||
|
collect (ansi-color-apply i)))
|
||||||
|
|
||||||
|
(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
|
||||||
|
(format "fd (%s)"
|
||||||
|
(abbreviate-file-name default-directory))
|
||||||
|
'helm-fd-class)
|
||||||
|
:buffer "*helm fd*")))
|
||||||
|
|
||||||
|
|
||||||
|
(provide 'helm-fd)
|
||||||
|
|
||||||
|
;;; helm-fd.el ends here
|
6819
code/elpa/helm-20230727.1557/helm-files.el
Normal file
6819
code/elpa/helm-20230727.1557/helm-files.el
Normal file
File diff suppressed because it is too large
Load diff
170
code/elpa/helm-20230727.1557/helm-find.el
Normal file
170
code/elpa/helm-20230727.1557/helm-find.el
Normal file
|
@ -0,0 +1,170 @@
|
||||||
|
;;; helm-find.el --- helm interface for find command. -*- lexical-binding: t -*-
|
||||||
|
|
||||||
|
;; Copyright (C) 2012 ~ 2023 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 <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
;;; 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)
|
||||||
|
|
||||||
|
(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 disp = (if (and helm-ff-transformer-show-only-basename
|
||||||
|
(not (string-match "[.]\\{1,2\\}$" i)))
|
||||||
|
(helm-basename abs) abs)
|
||||||
|
collect (cond ((eq t type)
|
||||||
|
(cons (propertize disp 'face 'helm-ff-directory)
|
||||||
|
abs))
|
||||||
|
((stringp type)
|
||||||
|
(cons (propertize disp 'face 'helm-ff-symlink)
|
||||||
|
abs))
|
||||||
|
(t (cons (propertize disp 'face 'helm-ff-file)
|
||||||
|
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 (string= event "finished\n")
|
||||||
|
(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
|
344
code/elpa/helm-20230727.1557/helm-font.el
Normal file
344
code/elpa/helm-20230727.1557/helm-font.el
Normal file
|
@ -0,0 +1,344 @@
|
||||||
|
;;; helm-font --- Font and ucs selection for Helm -*- lexical-binding: t -*-
|
||||||
|
|
||||||
|
;; Copyright (C) 2012 ~ 2023 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 <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
;;; 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 "<C-backspace>") 'helm-ucs-persistent-delete)
|
||||||
|
(define-key map (kbd "<C-left>") 'helm-ucs-persistent-backward)
|
||||||
|
(define-key map (kbd "<C-right>") '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
|
310
code/elpa/helm-20230727.1557/helm-for-files.el
Normal file
310
code/elpa/helm-20230727.1557/helm-for-files.el
Normal file
|
@ -0,0 +1,310 @@
|
||||||
|
;;; helm-for-files.el --- helm-for-files and related. -*- lexical-binding: t -*-
|
||||||
|
|
||||||
|
;; Copyright (C) 2012 ~ 2023 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 <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
(require 'helm-files)
|
||||||
|
(require 'helm-external)
|
||||||
|
(require 'helm-bookmark)
|
||||||
|
|
||||||
|
(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))))
|
||||||
|
|
||||||
|
(defcustom helm-turn-on-recentf t
|
||||||
|
"Automatically turn on `recentf-mode' when non-nil."
|
||||||
|
:group 'helm-files
|
||||||
|
:type 'boolean)
|
||||||
|
|
||||||
|
(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 (lambda () 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)))
|
||||||
|
(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)))))
|
||||||
|
|
||||||
|
|
||||||
|
;;; Files in current dir
|
||||||
|
;;
|
||||||
|
;;
|
||||||
|
(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)
|
||||||
|
for i in files
|
||||||
|
for disp = (if (and helm-ff-transformer-show-only-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))
|
||||||
|
;; Call file-attributes 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 ((and (null type) isremote) (cons disp i))
|
||||||
|
((stringp type)
|
||||||
|
(cons (propertize disp
|
||||||
|
'face 'helm-ff-symlink
|
||||||
|
'match-part (funcall mp-fn disp)
|
||||||
|
'help-echo (expand-file-name i))
|
||||||
|
i))
|
||||||
|
((eq type t)
|
||||||
|
(cons (propertize disp
|
||||||
|
'face 'helm-ff-directory
|
||||||
|
'match-part (funcall mp-fn disp)
|
||||||
|
'help-echo (expand-file-name i))
|
||||||
|
i))
|
||||||
|
(t (let* ((ext (helm-file-name-extension disp))
|
||||||
|
(disp (propertize disp
|
||||||
|
'face 'helm-ff-file
|
||||||
|
'match-part (funcall mp-fn disp)
|
||||||
|
'help-echo (expand-file-name i))))
|
||||||
|
(when (condition-case _err
|
||||||
|
(string-match (format "\\.\\(%s\\)$" ext) disp)
|
||||||
|
(invalid-regexp nil))
|
||||||
|
(add-face-text-property
|
||||||
|
(match-beginning 1) (match-end 1)
|
||||||
|
'helm-ff-file-extension nil disp))
|
||||||
|
(cons disp i))))))
|
||||||
|
|
||||||
|
(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)
|
||||||
|
(migemo :initform t)))
|
||||||
|
|
||||||
|
(defvar helm-source-files-in-current-dir
|
||||||
|
(helm-make-source "Files from Current Directory"
|
||||||
|
'helm-files-in-current-dir-source))
|
||||||
|
|
||||||
|
;;;###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)))))
|
||||||
|
(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
|
||||||
|
:ff-transformer-show-only-basename nil
|
||||||
|
: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
|
103
code/elpa/helm-20230727.1557/helm-global-bindings.el
Normal file
103
code/elpa/helm-20230727.1557/helm-global-bindings.el
Normal file
|
@ -0,0 +1,103 @@
|
||||||
|
;;; helm-global-bindings.el --- Bind global helm commands -*- lexical-binding: t -*-
|
||||||
|
|
||||||
|
;; Copyright (C) 2012 ~ 2023 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 <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
;;; 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 "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 "/") 'helm-find)
|
||||||
|
(define-key map (kbd "i") 'helm-imenu)
|
||||||
|
(define-key map (kbd "I") 'helm-imenu-in-all-buffers)
|
||||||
|
(define-key map (kbd "<tab>") '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 <SPC>") '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-list-elisp-packages)
|
||||||
|
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
|
1800
code/elpa/helm-20230727.1557/helm-grep.el
Normal file
1800
code/elpa/helm-20230727.1557/helm-grep.el
Normal file
File diff suppressed because it is too large
Load diff
2578
code/elpa/helm-20230727.1557/helm-help.el
Normal file
2578
code/elpa/helm-20230727.1557/helm-help.el
Normal file
File diff suppressed because it is too large
Load diff
125
code/elpa/helm-20230727.1557/helm-id-utils.el
Normal file
125
code/elpa/helm-20230727.1557/helm-id-utils.el
Normal file
|
@ -0,0 +1,125 @@
|
||||||
|
;;; helm-id-utils.el --- Helm interface for id-utils. -*- lexical-binding: t -*-
|
||||||
|
|
||||||
|
;; Copyright (C) 2015 ~ 2020 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 <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
;;; 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))
|
||||||
|
(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 (string= event "finished\n")
|
||||||
|
(helm-maybe-show-help-echo)
|
||||||
|
(with-helm-window
|
||||||
|
(setq mode-line-format
|
||||||
|
'(" " mode-line-buffer-identification " "
|
||||||
|
(:eval (format "L%s" (helm-candidate-number-at-point))) " "
|
||||||
|
(:eval (propertize
|
||||||
|
(format "[Helm Gid process finished - (%s results)]"
|
||||||
|
(max (1- (count-lines
|
||||||
|
(point-min) (point-max)))
|
||||||
|
0))
|
||||||
|
'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)
|
||||||
|
(candidate-number-limit :initform 99999)
|
||||||
|
(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 <https://www.gnu.org/software/idutils/>."
|
||||||
|
(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
|
544
code/elpa/helm-20230727.1557/helm-imenu.el
Normal file
544
code/elpa/helm-20230727.1557/helm-imenu.el
Normal file
|
@ -0,0 +1,544 @@
|
||||||
|
;;; helm-imenu.el --- Helm interface for Imenu -*- lexical-binding: t -*-
|
||||||
|
|
||||||
|
;; Copyright (C) 2012 ~ 2023 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 <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
(require 'cl-lib)
|
||||||
|
(require 'helm)
|
||||||
|
(require 'helm-lib)
|
||||||
|
(require 'imenu)
|
||||||
|
(require 'helm-utils)
|
||||||
|
(require 'helm-help)
|
||||||
|
|
||||||
|
(defvar all-the-icons-default-adjust)
|
||||||
|
(defvar all-the-icons-scale-factor)
|
||||||
|
|
||||||
|
(declare-function which-function "which-func")
|
||||||
|
(declare-function all-the-icons-material "ext:all-the-icons.el")
|
||||||
|
(declare-function all-the-icons-octicon "ext:all-the-icons.el")
|
||||||
|
(declare-function all-the-icons-faicon "ext:all-the-icons.el")
|
||||||
|
(declare-function all-the-icons-wicon "ext:all-the-icons.el")
|
||||||
|
|
||||||
|
|
||||||
|
(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 <buffer-name>\".
|
||||||
|
`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-map>\\[helm-imenu-toggle-type-view].
|
||||||
|
Don't use `setq' to set this."
|
||||||
|
:group 'helm-imenu
|
||||||
|
:type 'boolean
|
||||||
|
:set (lambda (var val)
|
||||||
|
(if (featurep 'all-the-icons)
|
||||||
|
(set var val)
|
||||||
|
(set var nil))))
|
||||||
|
|
||||||
|
(defcustom helm-imenu-use-icon nil
|
||||||
|
"Display an icon from all-the-icons package when non nil.
|
||||||
|
|
||||||
|
Don't use `setq' to set this."
|
||||||
|
:group 'helm-imenu
|
||||||
|
:type 'boolean
|
||||||
|
:set (lambda (var val)
|
||||||
|
(if (featurep 'all-the-icons)
|
||||||
|
(set var val)
|
||||||
|
(set var nil))))
|
||||||
|
|
||||||
|
(defcustom helm-imenu-icon-type-alist
|
||||||
|
'(("Array" . (all-the-icons-material "crop" :face font-lock-builtin-face))
|
||||||
|
("Array" . (all-the-icons-material "crop" :face font-lock-builtin-face))
|
||||||
|
("Boolean" . (all-the-icons-material "crop" :face font-lock-builtin-face))
|
||||||
|
("Boolean" . (all-the-icons-material "crop" :face font-lock-builtin-face))
|
||||||
|
("Class" . (all-the-icons-octicon "package" :face font-lock-type-face))
|
||||||
|
("Class" . (all-the-icons-octicon "package" :face font-lock-type-face))
|
||||||
|
("Color" . (all-the-icons-material "color_lens" :face font-lock-builtin-face))
|
||||||
|
("Colors" . (all-the-icons-material "color_lens" :face font-lock-builtin-face))
|
||||||
|
("Constant" . (all-the-icons-material "crop" :face font-lock-builtin-face))
|
||||||
|
("Constants" . (all-the-icons-material "crop" :face font-lock-builtin-face))
|
||||||
|
("Constructor" . (all-the-icons-faicon "cube" :face font-lock-function-name-face))
|
||||||
|
("Constructors" . (all-the-icons-faicon "cube" :face font-lock-function-name-face))
|
||||||
|
("Enum Member" . (all-the-icons-octicon "three-bars" :face font-lock-type-face))
|
||||||
|
("Enum Members" . (all-the-icons-octicon "three-bars" :face font-lock-type-face))
|
||||||
|
("Enum" . (all-the-icons-faicon "cog" :face font-lock-type-face))
|
||||||
|
("Enums" . (all-the-icons-faicon "cog" :face font-lock-type-face))
|
||||||
|
("Event" . (all-the-icons-wicon "lightning" :face font-lock-builtin-face))
|
||||||
|
("Events" . (all-the-icons-wicon "lightning" :face font-lock-builtin-face))
|
||||||
|
("Field" . (all-the-icons-octicon "three-bars" :face font-lock-type-face))
|
||||||
|
("Fields" . (all-the-icons-octicon "three-bars" :face font-lock-type-face))
|
||||||
|
("File" . (all-the-icons-faicon "file" :face font-lock-variable-name-face))
|
||||||
|
("Files" . (all-the-icons-faicon "file" :face font-lock-variable-name-face))
|
||||||
|
("Folder" . (all-the-icons-faicon "folder" :face font-lock-variable-name-face))
|
||||||
|
("Folders" . (all-the-icons-faicon "folder" :face font-lock-variable-name-face))
|
||||||
|
("Interface" . (all-the-icons-octicon "package" :face font-lock-builtin-face))
|
||||||
|
("Interfaces" . (all-the-icons-octicon "package" :face font-lock-builtin-face))
|
||||||
|
("Keyword" . (all-the-icons-octicon "key" :face font-lock-builtin-face))
|
||||||
|
("Keywords" . (all-the-icons-octicon "key" :face font-lock-builtin-face))
|
||||||
|
("Method" . (all-the-icons-faicon "cube" :face font-lock-function-name-face))
|
||||||
|
("Methods" . (all-the-icons-faicon "cube" :face font-lock-function-name-face))
|
||||||
|
("Defun" . (all-the-icons-faicon "cube" :face font-lock-function-name-face))
|
||||||
|
("Defuns" . (all-the-icons-faicon "cube" :face font-lock-function-name-face))
|
||||||
|
("Fn" . (all-the-icons-faicon "cube" :face font-lock-function-name-face))
|
||||||
|
("Fns" . (all-the-icons-faicon "cube" :face font-lock-function-name-face))
|
||||||
|
("Function" . (all-the-icons-faicon "cube" :face font-lock-function-name-face))
|
||||||
|
("Functions" . (all-the-icons-faicon "cube" :face font-lock-function-name-face))
|
||||||
|
("Misc" . (all-the-icons-faicon "globe" :face font-lock-function-name-face))
|
||||||
|
("Miscs" . (all-the-icons-faicon "globe" :face font-lock-function-name-face))
|
||||||
|
("Module" . (all-the-icons-faicon "angle-double-right" :face font-lock-builtin-face))
|
||||||
|
("Modules" . (all-the-icons-faicon "angle-double-right" :face font-lock-builtin-face))
|
||||||
|
("Numeric" . (all-the-icons-material "crop" :face font-lock-builtin-face))
|
||||||
|
("Numeric" . (all-the-icons-material "crop" :face font-lock-builtin-face))
|
||||||
|
("Object" . (all-the-icons-faicon "angle-double-right" :face font-lock-builtin-face))
|
||||||
|
("Objects" . (all-the-icons-faicon "angle-double-right" :face font-lock-builtin-face))
|
||||||
|
("Operator" . (all-the-icons-faicon "calculator" :face font-lock-builtin-face))
|
||||||
|
("Operators" . (all-the-icons-faicon "calculator" :face font-lock-builtin-face))
|
||||||
|
("Property" . (all-the-icons-octicon "book" :face font-lock-variable-name-face))
|
||||||
|
("Properties" . (all-the-icons-octicon "book" :face font-lock-variable-name-face))
|
||||||
|
("Reference" . (all-the-icons-octicon "book" :face font-lock-variable-name-face))
|
||||||
|
("References" . (all-the-icons-octicon "book" :face font-lock-variable-name-face))
|
||||||
|
("Snippet" . (all-the-icons-material "border_style" :face font-lock-variable-name-face))
|
||||||
|
("Snippet" . (all-the-icons-material "border_style" :face font-lock-variable-name-face))
|
||||||
|
("String" . (all-the-icons-material "text_fields" :face font-lock-variable-name-face))
|
||||||
|
("Strings" . (all-the-icons-material "text_fields" :face font-lock-variable-name-face))
|
||||||
|
("Struct" . (all-the-icons-faicon "cog" :face font-lock-type-face))
|
||||||
|
("Structs" . (all-the-icons-faicon "cog" :face font-lock-type-face))
|
||||||
|
("Text" . (all-the-icons-material "text_fields" :face font-lock-variable-name-face))
|
||||||
|
("Texts" . (all-the-icons-material "text_fields" :face font-lock-variable-name-face))
|
||||||
|
("Top level" . (all-the-icons-faicon "globe" :face font-lock-function-name-face))
|
||||||
|
("Trait" . (all-the-icons-octicon "package" :face font-lock-builtin-face))
|
||||||
|
("Traits" . (all-the-icons-octicon "package" :face font-lock-builtin-face))
|
||||||
|
("Type" . (all-the-icons-faicon "cog" :face font-lock-type-face))
|
||||||
|
("Types" . (all-the-icons-faicon "cog" :face font-lock-type-face))
|
||||||
|
("Type Parameter" . (all-the-icons-material "code" :face font-lock-type-face))
|
||||||
|
("Type Parameters" . (all-the-icons-material "code" :face font-lock-type-face))
|
||||||
|
("Unit" . (all-the-icons-faicon "bar-chart" :face font-lock-builtin-face))
|
||||||
|
("Units" . (all-the-icons-faicon "bar-chart" :face font-lock-builtin-face))
|
||||||
|
("Value" . (all-the-icons-faicon "cog" :face font-lock-type-face))
|
||||||
|
("Values" . (all-the-icons-faicon "cog" :face font-lock-type-face))
|
||||||
|
("Variable" . (all-the-icons-octicon "book" :face font-lock-variable-name-face))
|
||||||
|
("Variables" . (all-the-icons-octicon "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
|
||||||
|
'(all-the-icons-faicon "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-<down>") 'helm-imenu-next-section)
|
||||||
|
(define-key map (kbd "M-<up>") '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 "<right>") 'helm-execute-persistent-action)
|
||||||
|
(define-key helm-imenu-map (kbd "<left>") 'helm-maybe-exit-minibuffer))
|
||||||
|
(define-key helm-imenu-map (kbd "<right>") nil)
|
||||||
|
(define-key helm-imenu-map (kbd "<left>") nil))))
|
||||||
|
|
||||||
|
(defun helm-imenu-next-or-previous-section (n)
|
||||||
|
(with-helm-window
|
||||||
|
(let* ((fn (lambda ()
|
||||||
|
(let ((str (buffer-substring
|
||||||
|
(point-at-bol) (point-at-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))
|
||||||
|
(switch-to-buffer it))))
|
||||||
|
|
||||||
|
(defun helm-imenu--execute-action-at-once-p ()
|
||||||
|
(let ((cur (helm-get-selection))
|
||||||
|
(mb (with-helm-current-buffer
|
||||||
|
(save-excursion
|
||||||
|
(goto-char (point-at-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 "\\_<" (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 (pcase (cdr elm) ; Same as [1].
|
||||||
|
((and ov (pred overlayp))
|
||||||
|
(copy-overlay ov))
|
||||||
|
((and mk (or (pred markerp)
|
||||||
|
(pred integerp)))
|
||||||
|
(copy-marker mk))))
|
||||||
|
(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))
|
||||||
|
(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
|
||||||
|
(pcase v
|
||||||
|
((pred overlayp) (overlay-buffer v))
|
||||||
|
((or (pred markerp) (pred integerp))
|
||||||
|
(marker-buffer v))))
|
||||||
|
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
|
308
code/elpa/helm-20230727.1557/helm-info.el
Normal file
308
code/elpa/helm-20230727.1557/helm-info.el
Normal file
|
@ -0,0 +1,308 @@
|
||||||
|
;;; helm-info.el --- Browse info index with helm -*- lexical-binding: t -*-
|
||||||
|
|
||||||
|
;; Copyright (C) 2012 ~ 2023 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 <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
(require 'cl-lib)
|
||||||
|
(require 'helm)
|
||||||
|
(require 'helm-lib)
|
||||||
|
(require 'helm-utils)
|
||||||
|
(require 'info)
|
||||||
|
|
||||||
|
(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)
|
||||||
|
;; `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.
|
||||||
|
|
||||||
|
(cl-defun helm-info-init (&optional (file (helm-get-attr 'info-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."
|
||||||
|
;; Allow reinit candidate buffer when using edebug.
|
||||||
|
(helm-aif (and debug-on-error
|
||||||
|
(helm-candidate-buffer))
|
||||||
|
(kill-buffer it))
|
||||||
|
(unless (helm-candidate-buffer)
|
||||||
|
(save-selected-window
|
||||||
|
(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+ (point-at-eol)) t)
|
||||||
|
(setq start (point-at-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 (point-at-bol))
|
||||||
|
(re-search-forward "(line +[0-9]+)" nil t))
|
||||||
|
(point-at-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."
|
||||||
|
(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)
|
||||||
|
(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-<NAME>' 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 (var-value &optional commands)
|
||||||
|
"Define Helm sources named helm-source-info-<NAME>.
|
||||||
|
Sources are generated for all entries of
|
||||||
|
`helm-default-info-index-list'.
|
||||||
|
If COMMANDS arg is non-nil, also build commands named
|
||||||
|
`helm-info-<NAME>'.
|
||||||
|
Where NAME is an element of `helm-default-info-index-list'."
|
||||||
|
(cl-loop for str in var-value
|
||||||
|
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-<CANDIDATE>."
|
||||||
|
(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))))
|
||||||
|
|
||||||
|
(defun helm-def-source--info-files ()
|
||||||
|
"Return a Helm source for Info files."
|
||||||
|
(helm-build-sync-source "Helm Info"
|
||||||
|
:candidates
|
||||||
|
(lambda () (copy-sequence helm-default-info-index-list))
|
||||||
|
:candidate-number-limit 999
|
||||||
|
:candidate-transformer
|
||||||
|
(lambda (candidates)
|
||||||
|
(sort candidates #'string-lessp))
|
||||||
|
: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'. 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."
|
||||||
|
(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))
|
||||||
|
(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'.
|
||||||
|
(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
|
482
code/elpa/helm-20230727.1557/helm-locate.el
Normal file
482
code/elpa/helm-20230727.1557/helm-locate.el
Normal file
|
@ -0,0 +1,482 @@
|
||||||
|
;;; helm-locate.el --- helm interface for locate. -*- lexical-binding: t -*-
|
||||||
|
|
||||||
|
;; Copyright (C) 2012 ~ 2023 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 <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
;; 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 --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\".
|
||||||
|
|
||||||
|
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 "locate -i -e -A --regex '^%s' '%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.
|
||||||
|
|
||||||
|
If for some reasons you can't use locate because your filesystem
|
||||||
|
doesn't have a database, you can use find command from findutils
|
||||||
|
but be aware that it will be much slower. 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
|
||||||
|
(gnu/linux "locate %s -e -A --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)]"
|
||||||
|
(max (1- (count-lines
|
||||||
|
(point-min) (point-max)))
|
||||||
|
0)
|
||||||
|
,process-name)
|
||||||
|
'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 "/")))
|
||||||
|
(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)))))
|
||||||
|
((string= event "finished\n")
|
||||||
|
(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-override-inheritor (helm-type-file) ())
|
||||||
|
|
||||||
|
(defclass helm-locate-source (helm-source-async helm-locate-override-inheritor)
|
||||||
|
((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-override-inheritor))
|
||||||
|
(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)))))
|
||||||
|
(cl-loop for p in helm-locate-project-list
|
||||||
|
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 ()
|
||||||
|
(with-temp-buffer
|
||||||
|
(call-process-shell-command
|
||||||
|
(if (string-match-p "\\`fd" helm-locate-recursive-dirs-command)
|
||||||
|
(format helm-locate-recursive-dirs-command
|
||||||
|
;; fd pass path at end.
|
||||||
|
(helm-get-attr 'subdir) (helm-get-attr 'basedir))
|
||||||
|
(format helm-locate-recursive-dirs-command
|
||||||
|
(if (string-match-p "\\`es" helm-locate-recursive-dirs-command)
|
||||||
|
;; Fix W32 paths.
|
||||||
|
(replace-regexp-in-string
|
||||||
|
"/" "\\\\\\\\" (helm-get-attr 'basedir))
|
||||||
|
(helm-get-attr 'basedir))
|
||||||
|
(helm-get-attr 'subdir)))
|
||||||
|
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 version")
|
||||||
|
(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
|
114
code/elpa/helm-20230727.1557/helm-man.el
Normal file
114
code/elpa/helm-20230727.1557/helm-man.el
Normal file
|
@ -0,0 +1,114 @@
|
||||||
|
;;; helm-man.el --- Man and woman UI -*- lexical-binding: t -*-
|
||||||
|
|
||||||
|
;; Copyright (C) 2012 ~ 2023 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 <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
;;; 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)
|
||||||
|
(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.")
|
||||||
|
|
||||||
|
(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 ()
|
||||||
|
(require 'woman)
|
||||||
|
(require 'helm-utils)
|
||||||
|
(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))
|
||||||
|
|
||||||
|
(defvar helm-source-man-pages
|
||||||
|
(helm-build-in-buffer-source "Manual Pages"
|
||||||
|
:init #'helm-man--init
|
||||||
|
:persistent-action #'ignore
|
||||||
|
:filtered-candidate-transformer
|
||||||
|
(lambda (candidates _source)
|
||||||
|
(sort candidates #'helm-generic-sort-fn))
|
||||||
|
:action '(("Display Man page" . helm-man-default-action))
|
||||||
|
:group 'helm-man))
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(defun helm-man-woman (arg)
|
||||||
|
"Preconfigured `helm' for Man and Woman pages.
|
||||||
|
With a prefix arg reinitialize the cache."
|
||||||
|
(interactive "P")
|
||||||
|
(when arg (setq helm-man--pages nil))
|
||||||
|
(helm :sources 'helm-source-man-pages
|
||||||
|
:buffer "*helm man woman*"))
|
||||||
|
|
||||||
|
(provide 'helm-man)
|
||||||
|
|
||||||
|
;;; helm-man.el ends here
|
393
code/elpa/helm-20230727.1557/helm-misc.el
Normal file
393
code/elpa/helm-20230727.1557/helm-misc.el
Normal file
|
@ -0,0 +1,393 @@
|
||||||
|
;;; helm-misc.el --- Various functions for helm -*- lexical-binding: t -*-
|
||||||
|
|
||||||
|
;; Copyright (C) 2012 ~ 2023 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 <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
;;; 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")
|
||||||
|
|
||||||
|
|
||||||
|
(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))
|
||||||
|
|
||||||
|
;;; Commands
|
||||||
|
;;
|
||||||
|
(defun helm-call-interactively (cmd-or-name)
|
||||||
|
"Execute CMD-OR-NAME as Emacs command.
|
||||||
|
It is added to `extended-command-history'.
|
||||||
|
`helm-current-prefix-arg' is used as the command's prefix argument."
|
||||||
|
(setq extended-command-history
|
||||||
|
(cons (helm-stringify cmd-or-name)
|
||||||
|
(delete (helm-stringify cmd-or-name) extended-command-history)))
|
||||||
|
(let ((current-prefix-arg helm-current-prefix-arg)
|
||||||
|
(cmd (helm-symbolify cmd-or-name)))
|
||||||
|
(if (stringp (symbol-function cmd))
|
||||||
|
(execute-kbd-macro (symbol-function cmd))
|
||||||
|
(setq this-command cmd)
|
||||||
|
(call-interactively cmd))))
|
||||||
|
|
||||||
|
;;; 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 "<ratpoison> \\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-other-buffer 'helm-source-time-world "*helm world time*"))
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(defun helm-insert-latex-math ()
|
||||||
|
"Preconfigured helm for latex math symbols completion."
|
||||||
|
(interactive)
|
||||||
|
(helm-other-buffer 'helm-source-latex-math "*helm latex*"))
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(defun helm-ratpoison-commands ()
|
||||||
|
"Preconfigured `helm' to execute ratpoison commands."
|
||||||
|
(interactive)
|
||||||
|
(helm-other-buffer 'helm-source-ratpoison-commands
|
||||||
|
"*helm ratpoison commands*"))
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(defun helm-stumpwm-commands()
|
||||||
|
"Preconfigured helm for stumpwm commands."
|
||||||
|
(interactive)
|
||||||
|
(helm-other-buffer 'helm-source-stumpwm-commands
|
||||||
|
"*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)))
|
||||||
|
|
||||||
|
|
||||||
|
(provide 'helm-misc)
|
||||||
|
|
||||||
|
;;; helm-misc.el ends here
|
2378
code/elpa/helm-20230727.1557/helm-mode.el
Normal file
2378
code/elpa/helm-20230727.1557/helm-mode.el
Normal file
File diff suppressed because it is too large
Load diff
436
code/elpa/helm-20230727.1557/helm-net.el
Normal file
436
code/elpa/helm-20230727.1557/helm-net.el
Normal file
|
@ -0,0 +1,436 @@
|
||||||
|
;;; helm-net.el --- helm browse url and search web. -*- lexical-binding: t -*-
|
||||||
|
|
||||||
|
;; Copyright (C) 2012 ~ 2023 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 <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
;;; 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
|
||||||
|
'(("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-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-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.")
|
||||||
|
|
||||||
|
(cl-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))))))
|
||||||
|
|
||||||
|
;;;###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))
|
||||||
|
(setq url (browse-url-encode-url url))
|
||||||
|
(let ((process-environment (browse-url-process-environment)))
|
||||||
|
(call-process-shell-command
|
||||||
|
(format "(%s %s %s &)"
|
||||||
|
browse-url-firefox-program
|
||||||
|
helm-browse-url-firefox-new-window
|
||||||
|
(shell-quote-argument url)))))
|
||||||
|
|
||||||
|
;;;###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))
|
||||||
|
(setq url (browse-url-encode-url url))
|
||||||
|
(let ((process-environment (browse-url-process-environment)))
|
||||||
|
(call-process-shell-command
|
||||||
|
(format "(%s %s &)"
|
||||||
|
helm-browse-url-opera-program (shell-quote-argument url)))))
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(defun helm-browse-url-chromium (url &optional _ignore)
|
||||||
|
"Browse URL with Google Chrome browser."
|
||||||
|
(interactive "sURL: ")
|
||||||
|
(helm-generic-browser
|
||||||
|
url helm-browse-url-chromium-program))
|
||||||
|
|
||||||
|
;;;###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.
|
||||||
|
;; <http://surfraw.alioth.debian.org/>
|
||||||
|
|
||||||
|
;; 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-other-buffer 'helm-source-google-suggest "*helm google*"))
|
||||||
|
|
||||||
|
(provide 'helm-net)
|
||||||
|
|
||||||
|
;;; helm-net.el ends here
|
885
code/elpa/helm-20230727.1557/helm-occur.el
Normal file
885
code/elpa/helm-20230727.1557/helm-occur.el
Normal file
|
@ -0,0 +1,885 @@
|
||||||
|
;;; helm-occur.el --- Incremental Occur for Helm. -*- lexical-binding: t -*-
|
||||||
|
|
||||||
|
;; Copyright (C) 2012 ~ 2023 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 <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
|
||||||
|
;;; 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-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-\\{1\\}\\(.*\\)\\'"
|
||||||
|
"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)
|
||||||
|
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 "<right>") 'helm-occur-right)
|
||||||
|
(define-key helm-occur-map (kbd "<left>") 'helm-occur-run-default-action))
|
||||||
|
(define-key helm-occur-map (kbd "<right>") nil)
|
||||||
|
(define-key helm-occur-map (kbd "<left>") 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 '())
|
||||||
|
(name (helm-get-attr 'name helm-source-occur))
|
||||||
|
closest beg end)
|
||||||
|
(while-no-input
|
||||||
|
(goto-char (point-min))
|
||||||
|
(if (string= name "Helm occur")
|
||||||
|
(setq beg (point)
|
||||||
|
end (point-max))
|
||||||
|
(helm-awhile (helm-get-next-header-pos)
|
||||||
|
(when (string= name (buffer-substring-no-properties
|
||||||
|
(point-at-bol) (point-at-eol)))
|
||||||
|
(forward-line 1)
|
||||||
|
(setq beg (point)
|
||||||
|
end (or (helm-get-next-header-pos) (point-max)))
|
||||||
|
(cl-return))))
|
||||||
|
(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 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 (buffer-file-name
|
||||||
|
(get-buffer buf)))
|
||||||
|
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."
|
||||||
|
(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]* \\{1\\}" (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 'helm-occur-actions
|
||||||
|
: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)
|
||||||
|
"Run `helm-occur' on a list of buffers.
|
||||||
|
Each buffer's result is displayed in a separated source."
|
||||||
|
(let* ((curbuf (current-buffer))
|
||||||
|
(bufs (if helm-occur-always-search-in-current
|
||||||
|
(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 helm-occur-always-search-in-current
|
||||||
|
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 (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
|
||||||
|
;;
|
||||||
|
(cl-defun helm-occur-action (lineno
|
||||||
|
&optional (method (quote buffer)))
|
||||||
|
"Jump to line number LINENO with METHOD.
|
||||||
|
METHOD can be one of buffer, buffer-other-window, buffer-other-frame."
|
||||||
|
(require 'helm-grep)
|
||||||
|
(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 (point-at-eol) t)
|
||||||
|
(re-search-forward reg (point-at-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))))
|
||||||
|
|
||||||
|
;;; 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 "<C-down>") 'helm-occur-mode-goto-line-ow-forward)
|
||||||
|
(define-key map (kbd "<C-up>") 'helm-occur-mode-goto-line-ow-backward)
|
||||||
|
(define-key map (kbd "<M-down>") 'helm-gm-next-file)
|
||||||
|
(define-key map (kbd "<M-up>") '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 (point-at-bol))
|
||||||
|
(end (point-at-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
|
||||||
|
(point-at-bol) (point-at-eol)
|
||||||
|
`(buffer-name ,buf-name))
|
||||||
|
(add-text-properties
|
||||||
|
(point-at-bol) (point-at-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\\}\\(.*\\)$"
|
||||||
|
(point-at-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)))
|
||||||
|
(cons (concat (propertize
|
||||||
|
buf
|
||||||
|
'face 'helm-moccur-buffer
|
||||||
|
'help-echo (buffer-file-name
|
||||||
|
(get-buffer buf))
|
||||||
|
'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
|
14
code/elpa/helm-20230727.1557/helm-pkg.el
Normal file
14
code/elpa/helm-20230727.1557/helm-pkg.el
Normal file
|
@ -0,0 +1,14 @@
|
||||||
|
(define-package "helm" "20230727.1557" "Helm is an Emacs incremental and narrowing framework"
|
||||||
|
'((helm-core "3.9.1")
|
||||||
|
(wfnames "1.1")
|
||||||
|
(popup "0.5.3"))
|
||||||
|
:commit "c11845ea65500255ec294eb8026aef7ad3489269" :authors
|
||||||
|
'(("Thierry Volpiatto" . "thievol@posteo.net"))
|
||||||
|
:maintainers
|
||||||
|
'(("Thierry Volpiatto" . "thievol@posteo.net"))
|
||||||
|
:maintainer
|
||||||
|
'("Thierry Volpiatto" . "thievol@posteo.net")
|
||||||
|
:url "https://emacs-helm.github.io/helm/")
|
||||||
|
;; Local Variables:
|
||||||
|
;; no-byte-compile: t
|
||||||
|
;; End:
|
132
code/elpa/helm-20230727.1557/helm-regexp.el
Normal file
132
code/elpa/helm-20230727.1557/helm-regexp.el
Normal file
|
@ -0,0 +1,132 @@
|
||||||
|
;;; helm-regexp.el --- In buffer regexp searching and replacement for helm. -*- lexical-binding: t -*-
|
||||||
|
|
||||||
|
;; Copyright (C) 2012 ~ 2023 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 <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
;;; 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
|
624
code/elpa/helm-20230727.1557/helm-ring.el
Normal file
624
code/elpa/helm-20230727.1557/helm-ring.el
Normal file
|
@ -0,0 +1,624 @@
|
||||||
|
;;; helm-ring.el --- kill-ring, mark-ring, and register browsers for helm. -*- lexical-binding: t -*-
|
||||||
|
|
||||||
|
;; Copyright (C) 2012 ~ 2023 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 <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
;;; 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))
|
||||||
|
|
||||||
|
|
||||||
|
(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)
|
||||||
|
|
||||||
|
|
||||||
|
;;;; <Mark ring>
|
||||||
|
;; 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)
|
||||||
|
"<EMPTY 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)
|
||||||
|
(helm-log-run-hook "helm-mark-ring-default-action" 'helm-goto-line-before-hook)
|
||||||
|
(helm-match-line-cleanup)
|
||||||
|
(with-helm-current-buffer
|
||||||
|
(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 (pcase (thing-at-point 'line)
|
||||||
|
((and line (pred stringp)
|
||||||
|
(guard (not (string-match-p "\\`\n?\\'" line))))
|
||||||
|
(car (split-string line "[\n\r]")))
|
||||||
|
(_ "<EMPTY LINE>"))))
|
||||||
|
(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))))
|
||||||
|
|
||||||
|
;;;; <Register>
|
||||||
|
;;; 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."
|
||||||
|
(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 "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))))
|
||||||
|
(list "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) '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 ()
|
||||||
|
(helm-fast-remove-dups
|
||||||
|
(cons (kmacro-ring-head)
|
||||||
|
kmacro-ring)
|
||||||
|
:test 'equal))
|
||||||
|
:multiline t
|
||||||
|
:candidate-transformer
|
||||||
|
(lambda (candidates)
|
||||||
|
(cl-loop for c in candidates collect
|
||||||
|
(propertize (help-key-description (car c) 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 <n>' to execute <n> 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
|
||||||
|
(mapconcat 'identity
|
||||||
|
(cl-loop for km in mkd
|
||||||
|
if (vectorp km)
|
||||||
|
append (cl-loop for k across km collect
|
||||||
|
(key-description (vector k)))
|
||||||
|
into result
|
||||||
|
else collect (car km) into result
|
||||||
|
finally return result)
|
||||||
|
"")))))
|
||||||
|
|
||||||
|
(defun helm-kbd-macro-delete-macro (_candidate)
|
||||||
|
(let ((mkd (helm-marked-candidates)))
|
||||||
|
(kmacro-push-ring)
|
||||||
|
(cl-loop for km in mkd
|
||||||
|
do (setq kmacro-ring (delete km kmacro-ring)))
|
||||||
|
(kmacro-pop-ring1)))
|
||||||
|
|
||||||
|
(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
|
233
code/elpa/helm-20230727.1557/helm-semantic.el
Normal file
233
code/elpa/helm-20230727.1557/helm-semantic.el
Normal file
|
@ -0,0 +1,233 @@
|
||||||
|
;;; helm-semantic.el --- Helm interface for Semantic -*- lexical-binding: t -*-
|
||||||
|
|
||||||
|
;; Copyright (C) 2012 ~ 2017 Daniel Hackney <dan@haxney.org>
|
||||||
|
;; 2012 ~ 2023 Thierry Volpiatto
|
||||||
|
|
||||||
|
;; Author: Daniel Hackney <dan@haxney.org>
|
||||||
|
|
||||||
|
;; 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 <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
;;; 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 "<right>") 'helm-execute-persistent-action)
|
||||||
|
(define-key helm-semantic-map (kbd "<left>") 'helm-maybe-exit-minibuffer))
|
||||||
|
(define-key helm-semantic-map (kbd "<right>") nil)
|
||||||
|
(define-key helm-semantic-map (kbd "<left>") 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
|
||||||
|
(point-at-bol) 'semantic-tag nil (point-at-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
|
38
code/elpa/helm-20230727.1557/helm-shell.el
Normal file
38
code/elpa/helm-20230727.1557/helm-shell.el
Normal file
|
@ -0,0 +1,38 @@
|
||||||
|
;;; helm-shell.el --- Shell prompt navigation for helm. -*- lexical-binding: t -*-
|
||||||
|
|
||||||
|
;; Copyright (C) 2020 Pierre Neidhardt <mail@ambrevar.xyz>
|
||||||
|
|
||||||
|
;; 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 <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
;;; Commentary:
|
||||||
|
;;
|
||||||
|
;; This is superseded by helm-comint.el.
|
||||||
|
|
||||||
|
;;; Code:
|
||||||
|
(require 'cl-lib)
|
||||||
|
(require 'helm)
|
||||||
|
(require 'helm-lib)
|
||||||
|
(require 'helm-help)
|
||||||
|
(require 'helm-elisp)
|
||||||
|
(require 'helm-comint)
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(defalias 'helm-shell-prompts 'helm-comint-prompts)
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(defalias 'helm-shell-prompts-all 'helm-comint-prompts-all)
|
||||||
|
|
||||||
|
(provide 'helm-shell)
|
||||||
|
|
||||||
|
;;; helm-shell ends here
|
Some files were not shown because too many files have changed in this diff Show more
Reference in a new issue