kemonine
/
emacs
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

update elpa ; add ox-pandoc to plugins

This commit is contained in:
KemoNine 2023-08-10 10:03:04 -04:00
parent ea7d9387e7
commit 19318e5eda
411 changed files with 28948 additions and 127930 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

0
org/elpa/all-the-icons-20230316.1906/all-the-icons-autoloads.el → org/elpa/all-the-icons-20230615.2016/all-the-icons-autoloads.el
View File

0
org/elpa/all-the-icons-20230316.1906/all-the-icons-faces.el → org/elpa/all-the-icons-20230615.2016/all-the-icons-faces.el
View File

6
org/elpa/all-the-icons-20230316.1906/all-the-icons-pkg.el → org/elpa/all-the-icons-20230615.2016/all-the-icons-pkg.el
View File

@ -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"))
:commit "d922aff57ac8308d3ed067f9151cc76d342855f2" :authors
:commit "f491f39c21336d354e85bdb4cca281e0a0c2f880" :authors
'(("Dominic Charlesworth" . "dgc336@gmail.com"))
:maintainers
'(("Dominic Charlesworth" . "dgc336@gmail.com"))
:maintainer
'("Dominic Charlesworth" . "dgc336@gmail.com")

7
org/elpa/all-the-icons-20230316.1906/all-the-icons.el → org/elpa/all-the-icons-20230615.2016/all-the-icons.el
View File

@ -284,6 +284,8 @@
("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)
("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)
("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)
("ppt" 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)
("xlsx" 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)
(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)
(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)
(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)
@ -1254,8 +1257,6 @@ FONT-NAME is the name of the .ttf file providing the font, defaults to FAMILY."
(interactive "P")
(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 fileicon all-the-icons-data/file-icon-alist "file-icons")
(all-the-icons-define-icon faicon all-the-icons-data/fa-icon-alist "FontAwesome")

0
org/elpa/all-the-icons-20230316.1906/data/data-alltheicons.el → org/elpa/all-the-icons-20230615.2016/data/data-alltheicons.el
View File

0
org/elpa/all-the-icons-20230316.1906/data/data-faicons.el → org/elpa/all-the-icons-20230615.2016/data/data-faicons.el
View File

0
org/elpa/all-the-icons-20230316.1906/data/data-fileicons.el → org/elpa/all-the-icons-20230615.2016/data/data-fileicons.el
View File

0
org/elpa/all-the-icons-20230316.1906/data/data-material.el → org/elpa/all-the-icons-20230615.2016/data/data-material.el
View File

0
org/elpa/all-the-icons-20230316.1906/data/data-octicons.el → org/elpa/all-the-icons-20230615.2016/data/data-octicons.el
View File

0
org/elpa/all-the-icons-20230316.1906/data/data-weathericons.el → org/elpa/all-the-icons-20230615.2016/data/data-weathericons.el
View File

10633
org/elpa/archives/melpa/archive-contents
View File

File diff suppressed because it is too large Load Diff

214
org/elpa/async-20230216.559/async-autoloads.el
View File

@ -1,214 +0,0 @@
;;; async-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 "async" "async.el" (0 0 0 0))
;;; Generated autoloads from async.el
(autoload 'async-start-process "async" "\
Start the executable PROGRAM asynchronously named NAME. See `async-start'.
PROGRAM is passed PROGRAM-ARGS, calling FINISH-FUNC with the
process object when done. If FINISH-FUNC is nil, the future
object will return the process object when the program is
finished. Set DEFAULT-DIRECTORY to change PROGRAM's current
working directory.
\(fn NAME PROGRAM FINISH-FUNC &rest PROGRAM-ARGS)" nil nil)
(autoload 'async-start "async" "\
Execute START-FUNC (often a lambda) in a subordinate Emacs process.
When done, the return value is passed to FINISH-FUNC. Example:
(async-start
;; What to do in the child process
(lambda ()
(message \"This is a test\")
(sleep-for 3)
222)
;; What to do when it finishes
(lambda (result)
(message \"Async process done, result should be 222: %s\"
result)))
If FINISH-FUNC is nil or missing, a future is returned that can
be inspected using `async-get', blocking until the value is
ready. Example:
(let ((proc (async-start
;; What to do in the child process
(lambda ()
(message \"This is a test\")
(sleep-for 3)
222))))
(message \"I'm going to do some work here\") ;; ....
(message \"Waiting on async process, result should be 222: %s\"
(async-get proc)))
If you don't want to use a callback, and you don't care about any
return value from the child process, pass the `ignore' symbol as
the second argument (if you don't, and never call `async-get', it
will leave *emacs* process buffers hanging around):
(async-start
(lambda ()
(delete-file \"a remote file on a slow link\" nil))
\\='ignore)
Special case:
If the output of START-FUNC is a string with properties
e.g. (buffer-string) RESULT will be transformed in a list where the
car is the string itself (without props) and the cdr the rest of
properties, this allows using in FINISH-FUNC the string without
properties and then apply the properties in cdr to this string (if
needed).
Properties handling special objects like markers are returned as
list to allow restoring them later.
See <https://github.com/jwiegley/emacs-async/issues/145> for more infos.
Note: Even when FINISH-FUNC is present, a future is still
returned except that it yields no value (since the value is
passed to FINISH-FUNC). Call `async-get' on such a future always
returns nil. It can still be useful, however, as an argument to
`async-ready' or `async-wait'.
\(fn START-FUNC &optional FINISH-FUNC)" nil nil)
(register-definition-prefixes "async" '("async-"))
;;;***
;;;### (autoloads nil "async-bytecomp" "async-bytecomp.el" (0 0 0
;;;;;; 0))
;;; Generated autoloads from async-bytecomp.el
(autoload 'async-byte-recompile-directory "async-bytecomp" "\
Compile all *.el files in DIRECTORY asynchronously.
All *.elc files are systematically deleted before proceeding.
\(fn DIRECTORY &optional QUIET)" nil nil)
(defvar async-bytecomp-package-mode nil "\
Non-nil if Async-Bytecomp-Package mode is enabled.
See the `async-bytecomp-package-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 `async-bytecomp-package-mode'.")
(custom-autoload 'async-bytecomp-package-mode "async-bytecomp" nil)
(autoload 'async-bytecomp-package-mode "async-bytecomp" "\
Byte compile asynchronously packages installed with package.el.
Async compilation of packages can be controlled by
`async-bytecomp-allowed-packages'.
This is a minor mode. If called interactively, toggle the
`Async-Bytecomp-Package 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 \\='async-bytecomp-package-mode)'.
The mode's hook is called both when the mode is enabled and when
it is disabled.
\(fn &optional ARG)" t nil)
(autoload 'async-byte-compile-file "async-bytecomp" "\
Byte compile Lisp code FILE asynchronously.
Same as `byte-compile-file' but asynchronous.
\(fn FILE)" t nil)
(register-definition-prefixes "async-bytecomp" '("async-"))
;;;***
;;;### (autoloads nil "dired-async" "dired-async.el" (0 0 0 0))
;;; Generated autoloads from dired-async.el
(defvar dired-async-mode nil "\
Non-nil if Dired-Async mode is enabled.
See the `dired-async-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 `dired-async-mode'.")
(custom-autoload 'dired-async-mode "dired-async" nil)
(autoload 'dired-async-mode "dired-async" "\
Do dired actions asynchronously.
This is a minor mode. If called interactively, toggle the
`Dired-Async 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 \\='dired-async-mode)'.
The mode's hook is called both when the mode is enabled and when
it is disabled.
\(fn &optional ARG)" t nil)
(autoload 'dired-async-do-copy "dired-async" "\
Run ‘dired-do-copy’ asynchronously.
\(fn &optional ARG)" t nil)
(autoload 'dired-async-do-symlink "dired-async" "\
Run ‘dired-do-symlink’ asynchronously.
\(fn &optional ARG)" t nil)
(autoload 'dired-async-do-hardlink "dired-async" "\
Run ‘dired-do-hardlink’ asynchronously.
\(fn &optional ARG)" t nil)
(autoload 'dired-async-do-rename "dired-async" "\
Run ‘dired-do-rename’ asynchronously.
\(fn &optional ARG)" t nil)
(register-definition-prefixes "dired-async" '("dired-async-"))
;;;***
;;;### (autoloads nil "smtpmail-async" "smtpmail-async.el" (0 0 0
;;;;;; 0))
;;; Generated autoloads from smtpmail-async.el
(register-definition-prefixes "smtpmail-async" '("async-smtpmail-"))
;;;***
;;;### (autoloads nil nil ("async-pkg.el") (0 0 0 0))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; coding: utf-8
;; End:
;;; async-autoloads.el ends here

12
org/elpa/async-20230216.559/async-pkg.el
View File

@ -1,12 +0,0 @@
(define-package "async" "20230216.559" "Asynchronous processing in Emacs"
'((emacs "24.4"))
:commit "71cc50f27ffc598a89aeaa593488d87818647d02" :authors
'(("John Wiegley" . "jwiegley@gmail.com"))
:maintainer
'("Thierry Volpiatto" . "thievol@posteo.net")
:keywords
'("async")
:url "https://github.com/jwiegley/emacs-async")
;; Local Variables:
;; no-byte-compile: t
;; End:

453
org/elpa/async-20230216.559/async.el
View File

@ -1,453 +0,0 @@
;;; async.el --- Asynchronous processing in Emacs -*- lexical-binding: t -*-
;; Copyright (C) 2012-2022 Free Software Foundation, Inc.
;; Author: John Wiegley <jwiegley@gmail.com>
;; Maintainer: Thierry Volpiatto <thievol@posteo.net>
;; Created: 18 Jun 2012
;; Version: 1.9.7
;; Package-Requires: ((emacs "24.4"))
;; Keywords: async
;; X-URL: https://github.com/jwiegley/emacs-async
;; 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:
;; Adds the ability to call asynchronous functions and process with ease. See
;; the documentation for `async-start' and `async-start-process'.
;;; Code:
(eval-when-compile (require 'cl-lib))
(defgroup async nil
"Simple asynchronous processing in Emacs"
:group 'lisp)
(defcustom async-variables-noprops-function #'async--purecopy
"Default function to remove text properties in variables."
:type 'function)
(defvar async-debug nil)
(defvar async-send-over-pipe t)
(defvar async-in-child-emacs nil)
(defvar async-callback nil)
(defvar async-callback-for-process nil)
(defvar async-callback-value nil)
(defvar async-callback-value-set nil)
(defvar async-current-process nil)
(defvar async--procvar nil)
(defvar async-child-init nil
"Initialisation file for async child Emacs.
If defined this allows for an init file to setup the child Emacs. It
should not be your normal init.el as that would likely load more
things that you require. It should limit itself to ensuring paths have
been setup so any async code can load libraries you expect.")
;; For emacs<29 (only exists in emacs-29+).
(defvar print-symbols-bare)
(defun async--purecopy (object)
"Remove text properties in OBJECT.
Argument OBJECT may be a list or a string, if anything else it
is returned unmodified."
(cond ((stringp object)
(substring-no-properties object))
((consp object)
(cl-loop for elm in object
;; A string.
if (stringp elm)
collect (substring-no-properties elm)
else
;; Proper lists.
if (and (consp elm) (null (cdr (last elm))))
collect (async--purecopy elm)
else
;; Dotted lists.
;; We handle here only dotted list where car and cdr
;; are atoms i.e. (x . y) and not (x . (x . y)) or
;; (x . (x y)) which should fit most cases.
if (and (consp elm) (cdr (last elm)))
collect (let ((key (car elm))
(val (cdr elm)))
(cons (if (stringp key)
(substring-no-properties key)
key)
(if (stringp val)
(substring-no-properties val)
val)))
else
collect elm))
(t object)))
(defun async-inject-variables
(include-regexp &optional predicate exclude-regexp noprops)
"Return a `setq' form that replicates part of the calling environment.
It sets the value for every variable matching INCLUDE-REGEXP and
also PREDICATE. It will not perform injection for any variable
matching EXCLUDE-REGEXP (if present) or representing a `syntax-table'
i.e. ending by \"-syntax-table\".
When NOPROPS is non nil it tries to strip out text properties of each
variable's value with `async-variables-noprops-function'.
It is intended to be used as follows:
(async-start
\\=`(lambda ()
(require \\='smtpmail)
(with-temp-buffer
(insert ,(buffer-substring-no-properties (point-min) (point-max)))
;; Pass in the variable environment for smtpmail
,(async-inject-variables \"\\\\=`\\(smtpmail\\|\\(user-\\)?mail\\)-\")
(smtpmail-send-it)))
\\='ignore)"
`(setq
,@(let (bindings)
(mapatoms
(lambda (sym)
(let* ((sname (and (boundp sym) (symbol-name sym)))
(value (and sname (symbol-value sym))))
(when (and sname
(or (null include-regexp)
(string-match include-regexp sname))
(or (null exclude-regexp)
(not (string-match exclude-regexp sname)))
(not (string-match "-syntax-table\\'" sname)))
(unless (or (stringp value)
(memq value '(nil t))
(numberp value)
(vectorp value))
(setq value `(quote ,value)))
(when noprops
(setq value (funcall async-variables-noprops-function
value)))
(when (or (null predicate)
(funcall predicate sym))
(setq bindings (cons value bindings)
bindings (cons sym bindings)))))))
bindings)))
(defalias 'async-inject-environment 'async-inject-variables)
(defun async-handle-result (func result buf)
(if (null func)
(progn
(set (make-local-variable 'async-callback-value) result)
(set (make-local-variable 'async-callback-value-set) t))
(unwind-protect
(if (and (listp result)
(eq 'async-signal (nth 0 result)))
(signal (car (nth 1 result))
(cdr (nth 1 result)))
(funcall func result))
(unless async-debug
(kill-buffer buf)))))
(defun async-when-done (proc &optional _change)
"Process sentinel used to retrieve the value from the child process."
(when (eq 'exit (process-status proc))
(with-current-buffer (process-buffer proc)
(let ((async-current-process proc))
(if (= 0 (process-exit-status proc))
(if async-callback-for-process
(if async-callback
(prog1
(funcall async-callback proc)
(unless async-debug
(kill-buffer (current-buffer))))
(set (make-local-variable 'async-callback-value) proc)
(set (make-local-variable 'async-callback-value-set) t))
;; Maybe strip out unreadable "#"; They are replaced by
;; empty string unless they are prefixing a special
;; object like a marker. See issue #145.
(goto-char (point-min))
(save-excursion
;; Transform markers in list like
;; (marker (moves after insertion) at 2338 in
;; test\.org) so that remap text properties function
;; can parse it to restitute marker.
(while (re-search-forward "#<\\([^>]*\\)>" nil t)
(replace-match (concat "(" (match-string 1) ")") t t)))
(while (re-search-forward "#(" nil t)
(replace-match "(" t t))
(goto-char (point-max))
(backward-sexp)
(async-handle-result async-callback (read (current-buffer))
(current-buffer)))
(set (make-local-variable 'async-callback-value)
(list 'error
(format "Async process '%s' failed with exit code %d"
(process-name proc) (process-exit-status proc))))
(set (make-local-variable 'async-callback-value-set) t))))))
(defun async--receive-sexp (&optional stream)
;; FIXME: Why use `utf-8-auto' instead of `utf-8-unix'? This is
;; a communication channel over which we have complete control,
;; so we get to choose exactly which encoding and EOL we use, isn't
;; it?
;; UPDATE: We use now `utf-8-emacs-unix' instead of `utf-8-auto' as
;; recommended in bug#165.
(let ((sexp (decode-coding-string (base64-decode-string (read stream))
'utf-8-emacs-unix))
;; Parent expects UTF-8 encoded text.
(coding-system-for-write 'utf-8-emacs-unix))
(if async-debug
(message "Received sexp {{{%s}}}" (pp-to-string sexp)))
(setq sexp (read sexp))
(if async-debug
(message "Read sexp {{{%s}}}" (pp-to-string sexp)))
(eval sexp t)))
(defun async--insert-sexp (sexp)
(let (print-level
print-length
(print-escape-nonascii t)
(print-circle t)
;; Fix bug#153 in emacs-29 with symbol's positions.
(print-symbols-bare t))
(prin1 sexp (current-buffer))
;; Just in case the string we're sending might contain EOF
(encode-coding-region (point-min) (point-max) 'utf-8-emacs-unix)
(base64-encode-region (point-min) (point-max) t)
(goto-char (point-min)) (insert ?\")
(goto-char (point-max)) (insert ?\" ?\n)))
(defun async--transmit-sexp (process sexp)
(with-temp-buffer
(if async-debug
(message "Transmitting sexp {{{%s}}}" (pp-to-string sexp)))
(async--insert-sexp sexp)
(process-send-region process (point-min) (point-max))))
(defun async-batch-invoke ()
"Called from the child Emacs process' command line."
;; Make sure 'message' and 'prin1' encode stuff in UTF-8, as parent
;; process expects.
(let ((coding-system-for-write 'utf-8-emacs-unix)
(args-left command-line-args-left))
(setq async-in-child-emacs t
debug-on-error async-debug
command-line-args-left nil)
(condition-case-unless-debug err
(prin1 (funcall
(async--receive-sexp (unless async-send-over-pipe
args-left))))
(error
(prin1 (list 'async-signal err))))))
(defun async-ready (future)
"Query a FUTURE to see if it is ready.
I.e., if no blocking would result from a call to `async-get' on that FUTURE."
(and (memq (process-status future) '(exit signal))
(let ((buf (process-buffer future)))
(if (buffer-live-p buf)
(with-current-buffer buf
async-callback-value-set)
t))))
(defun async-wait (future)
"Wait for FUTURE to become ready."
(while (not (async-ready future))
(sleep-for 0.05)))
(defun async-get (future)
"Get the value from process FUTURE when it is ready.
FUTURE is returned by `async-start' or `async-start-process' when
its FINISH-FUNC is nil."
(and future (async-wait future))
(let ((buf (process-buffer future)))
(when (buffer-live-p buf)
(with-current-buffer buf
(async-handle-result
#'identity async-callback-value (current-buffer))))))
(defun async-message-p (value)
"Return non-nil of VALUE is an async.el message packet."
(and (listp value)
(plist-get value :async-message)))
(defun async-send (&rest args)
"Send the given messages to the asynchronous Emacs PROCESS."
(let ((args (append args '(:async-message t))))
(if async-in-child-emacs
(if async-callback
(funcall async-callback args))
(async--transmit-sexp (car args) (list 'quote (cdr args))))))
(defun async-receive ()
"Send the given messages to the asynchronous Emacs PROCESS."
(async--receive-sexp))
;;;###autoload
(defun async-start-process (name program finish-func &rest program-args)
"Start the executable PROGRAM asynchronously named NAME. See `async-start'.
PROGRAM is passed PROGRAM-ARGS, calling FINISH-FUNC with the
process object when done. If FINISH-FUNC is nil, the future
object will return the process object when the program is
finished. Set DEFAULT-DIRECTORY to change PROGRAM's current
working directory."
(let* ((buf (generate-new-buffer (concat "*" name "*")))
(proc (let ((process-connection-type nil))
(apply #'start-process name buf program program-args))))
(with-current-buffer buf
(set (make-local-variable 'async-callback) finish-func)
(set-process-sentinel proc #'async-when-done)
(unless (string= name "emacs")
(set (make-local-variable 'async-callback-for-process) t))
proc)))
(defvar async-quiet-switch "-Q"
"The Emacs parameter to use to call emacs without config.
Can be one of \"-Q\" or \"-q\".
Default is \"-Q\" but it is sometimes useful to use \"-q\" to have a
enhanced config or some more variables loaded.")
(defun async--emacs-program-args (&optional sexp)
"Return a list of arguments for invoking the child Emacs."
;; Using `locate-library' ensure we use the right file
;; when the .elc have been deleted.
(let ((args (list async-quiet-switch "-l" (locate-library "async"))))
(when async-child-init
(setq args (append args (list "-l" async-child-init))))
(append args (list "-batch" "-f" "async-batch-invoke"
(if sexp
(with-temp-buffer
(async--insert-sexp (list 'quote sexp))
(buffer-string))
"<none>")))))
;;;###autoload
(defun async-start (start-func &optional finish-func)
"Execute START-FUNC (often a lambda) in a subordinate Emacs process.
When done, the return value is passed to FINISH-FUNC. Example:
(async-start
;; What to do in the child process
(lambda ()
(message \"This is a test\")
(sleep-for 3)
222)
;; What to do when it finishes
(lambda (result)
(message \"Async process done, result should be 222: %s\"
result)))
If FINISH-FUNC is nil or missing, a future is returned that can
be inspected using `async-get', blocking until the value is
ready. Example:
(let ((proc (async-start
;; What to do in the child process
(lambda ()
(message \"This is a test\")
(sleep-for 3)
222))))
(message \"I'm going to do some work here\") ;; ....
(message \"Waiting on async process, result should be 222: %s\"
(async-get proc)))
If you don't want to use a callback, and you don't care about any
return value from the child process, pass the `ignore' symbol as
the second argument (if you don't, and never call `async-get', it
will leave *emacs* process buffers hanging around):
(async-start
(lambda ()
(delete-file \"a remote file on a slow link\" nil))
\\='ignore)
Special case:
If the output of START-FUNC is a string with properties
e.g. (buffer-string) RESULT will be transformed in a list where the
car is the string itself (without props) and the cdr the rest of
properties, this allows using in FINISH-FUNC the string without
properties and then apply the properties in cdr to this string (if
needed).
Properties handling special objects like markers are returned as
list to allow restoring them later.
See <https://github.com/jwiegley/emacs-async/issues/145> for more infos.
Note: Even when FINISH-FUNC is present, a future is still
returned except that it yields no value (since the value is
passed to FINISH-FUNC). Call `async-get' on such a future always
returns nil. It can still be useful, however, as an argument to
`async-ready' or `async-wait'."
(let ((sexp start-func)
;; Subordinate Emacs will send text encoded in UTF-8.
(coding-system-for-read 'utf-8-emacs-unix))
(setq async--procvar
(apply 'async-start-process
"emacs" (file-truename
(expand-file-name invocation-name
invocation-directory))
finish-func
(async--emacs-program-args (if (not async-send-over-pipe) sexp))))
(if async-send-over-pipe
(async--transmit-sexp async--procvar (list 'quote sexp)))
async--procvar))
(defmacro async-sandbox(func)
"Evaluate FUNC in a separate Emacs process, synchronously."
`(async-get (async-start ,func)))
(defun async--fold-left (fn forms bindings)
(let ((res forms))
(dolist (binding bindings)
(setq res (funcall fn res
(if (listp binding)
binding
(list binding)))))
res))
(defmacro async-let (bindings &rest forms)
"Implements `let', but each binding is established asynchronously.
For example:
(async-let ((x (foo))
(y (bar)))
(message \"%s %s\" x y))
expands to ==>
(async-start (foo)
(lambda (x)
(async-start (bar)
(lambda (y)
(message \"%s %s\" x y)))))"
(declare (indent 1))
(async--fold-left
(lambda (acc binding)
(let ((fun (pcase (cadr binding)
((and (pred functionp) f) f)
(f `(lambda () ,f)))))
`(async-start ,fun
(lambda (,(car binding))
,acc))))
`(progn ,@forms)
(reverse bindings)))
(provide 'async)
;;; async.el ends here

211
org/elpa/async-20230323.643/async-bytecomp.el
View File

@ -1,211 +0,0 @@
;;; async-bytecomp.el --- Compile elisp files asynchronously -*- lexical-binding: t -*-
;; Copyright (C) 2014-2022 Free Software Foundation, Inc.
;; Authors: John Wiegley <jwiegley@gmail.com>
;; Thierry Volpiatto <thievol@posteo.net>
;; Keywords: dired async byte-compile
;; X-URL: https://github.com/jwiegley/emacs-async
;; 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 provide the `async-byte-recompile-directory' function
;; which allows, as the name says to recompile a directory outside of
;; your running emacs.
;; The benefit is your files will be compiled in a clean environment without
;; the old *.el files loaded.
;; Among other things, this fix a bug in package.el which recompile
;; the new files in the current environment with the old files loaded, creating
;; errors in most packages after upgrades.
;;
;; NB: This package is advicing the function `package--compile'.
;;; Code:
(require 'cl-lib)
(require 'async)
(require 'bytecomp)
(declare-function package-desc-name "package.el")
(declare-function package-desc-dir "package.el")
(defcustom async-bytecomp-allowed-packages 'all
"Packages in this list will be compiled asynchronously by `package--compile'.
All the dependencies of these packages will be compiled async too,
so no need to add dependencies to this list.
The value of this variable can also be the symbol `all' (default), in this case
all packages are always compiled asynchronously."
:group 'async
:type '(choice
(const :tag "All packages" all)
(repeat symbol)))
(defvar async-byte-compile-log-file
(concat user-emacs-directory "async-bytecomp.log"))
(defvar async-bytecomp-load-variable-regexp "\\`load-path\\'"
"The variable used by `async-inject-variables' when (re)compiling async.")
;;;###autoload
(defun async-byte-recompile-directory (directory &optional quiet)
"Compile all *.el files in DIRECTORY asynchronously.
All *.elc files are systematically deleted before proceeding."
(cl-loop with dir = (directory-files directory t "\\.elc\\'")
unless dir return nil
for f in dir
when (file-exists-p f) do (delete-file f))
;; Ensure async is reloaded when async.elc is deleted.
;; This happen when recompiling its own directory.
(load "async")
(let ((call-back
(lambda (&optional _ignore)
(if (file-exists-p async-byte-compile-log-file)
(let ((buf (get-buffer-create byte-compile-log-buffer))
(n 0))
(with-current-buffer buf
(goto-char (point-max))
(let ((inhibit-read-only t))
(insert-file-contents async-byte-compile-log-file)
(compilation-mode))
(display-buffer buf)
(delete-file async-byte-compile-log-file)
(unless quiet
(save-excursion
(goto-char (point-min))
(while (re-search-forward "^.*:Error:" nil t)
(cl-incf n)))
(if (> n 0)
(message "Failed to compile %d files in directory `%s'" n directory)
(message "Directory `%s' compiled asynchronously with warnings" directory)))))
(unless quiet
(message "Directory `%s' compiled asynchronously with success" directory))))))
(async-start
`(lambda ()
(require 'bytecomp)
,(async-inject-variables async-bytecomp-load-variable-regexp)
(let ((default-directory (file-name-as-directory ,directory))
error-data)
(add-to-list 'load-path default-directory)
(byte-recompile-directory ,directory 0 t)
(when (get-buffer byte-compile-log-buffer)
(setq error-data (with-current-buffer byte-compile-log-buffer
(buffer-substring-no-properties (point-min) (point-max))))
(unless (string= error-data "")
(with-temp-file ,async-byte-compile-log-file
(erase-buffer)
(insert error-data))))))
call-back)
(unless quiet (message "Started compiling asynchronously directory %s" directory))))
(defvar package-archive-contents)
(defvar package-alist)
(declare-function package-desc-reqs "package.el" (cl-x))
(defun async-bytecomp--get-package-deps (pkgs)
;; Same as `package--get-deps' but parse instead `package-archive-contents'
;; because PKG is not already installed and not present in `package-alist'.
;; However fallback to `package-alist' in case PKG no more present
;; in `package-archive-contents' due to modification to `package-archives'.
;; See issue #58.
(let ((seen '()))
(while pkgs
(let ((pkg (pop pkgs)))
(unless (memq pkg seen)
(let ((pkg-desc (cadr (or (assq pkg package-archive-contents)
(assq pkg package-alist)))))
(when pkg-desc
(push pkg seen)
(setq pkgs (append (mapcar #'car (package-desc-reqs pkg-desc))
pkgs)))))))
seen))
(defun async--package-compile (orig-fun pkg-desc &rest args)
(let ((cur-package (package-desc-name pkg-desc))
(pkg-dir (package-desc-dir pkg-desc)))
(if (or (member async-bytecomp-allowed-packages '(t all (all)))
(memq cur-package (async-bytecomp--get-package-deps
async-bytecomp-allowed-packages)))
(progn
;; FIXME: Why do we use (eq cur-package 'async) once
;; and (string= cur-package "async") afterwards?
(when (eq cur-package 'async)
(fmakunbound 'async-byte-recompile-directory))
;; Add to `load-path' the latest version of async and
;; reload it when reinstalling async.
(when (string= cur-package "async")
(cl-pushnew pkg-dir load-path)
(load "async-bytecomp"))
;; `async-byte-recompile-directory' will add directory
;; as needed to `load-path'.
(async-byte-recompile-directory (package-desc-dir pkg-desc) t))
(apply orig-fun pkg-desc args))))
;;;###autoload
(define-minor-mode async-bytecomp-package-mode
"Byte compile asynchronously packages installed with package.el.
Async compilation of packages can be controlled by
`async-bytecomp-allowed-packages'."
:group 'async
:global t
(if async-bytecomp-package-mode
(advice-add 'package--compile :around #'async--package-compile)
(advice-remove 'package--compile #'async--package-compile)))
;;;###autoload
(defun async-byte-compile-file (file)
"Byte compile Lisp code FILE asynchronously.
Same as `byte-compile-file' but asynchronous."
(interactive "fFile: ")
(let ((call-back
(lambda (&optional _ignore)
(let ((bn (file-name-nondirectory file)))
(if (file-exists-p async-byte-compile-log-file)
(let ((buf (get-buffer-create byte-compile-log-buffer))
start)
(with-current-buffer buf
(goto-char (setq start (point-max)))
(let ((inhibit-read-only t))
(insert-file-contents async-byte-compile-log-file)
(compilation-mode))
(display-buffer buf)
(delete-file async-byte-compile-log-file)
(save-excursion
(goto-char start)
(if (re-search-forward "^.*:Error:" nil t)
(message "Failed to compile `%s'" bn)
(message "`%s' compiled asynchronously with warnings" bn)))))
(message "`%s' compiled asynchronously with success" bn))))))
(async-start
`(lambda ()
(require 'bytecomp)
,(async-inject-variables async-bytecomp-load-variable-regexp)
(let ((default-directory ,(file-name-directory file)))
(add-to-list 'load-path default-directory)
(byte-compile-file ,file)
(when (get-buffer byte-compile-log-buffer)
(setq error-data (with-current-buffer byte-compile-log-buffer
(buffer-substring-no-properties (point-min) (point-max))))
(unless (string= error-data "")
(with-temp-file ,async-byte-compile-log-file
(erase-buffer)
(insert error-data))))))
call-back)))
(provide 'async-bytecomp)
;;; async-bytecomp.el ends here

455
org/elpa/async-20230323.643/dired-async.el
View File

@ -1,455 +0,0 @@
;;; dired-async.el --- Asynchronous dired actions -*- lexical-binding: t -*-
;; Copyright (C) 2012-2019 Free Software Foundation, Inc.
;; Authors: John Wiegley <jwiegley@gmail.com>
;; Thierry Volpiatto <thievol@posteo.net>
;; Keywords: dired async network
;; X-URL: https://github.com/jwiegley/emacs-async
;; 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 file provide a redefinition of `dired-create-file' function,
;; performs copies, moves and all what is handled by `dired-create-file'
;; in the background using a slave Emacs process,
;; by means of the async.el module.
;; To use it, put this in your .emacs:
;; (dired-async-mode 1)
;; This will enable async copy/rename etc...
;; in dired and helm.
;;; Code:
(require 'cl-lib)
(require 'dired-aux)
(require 'async)
(eval-when-compile
(defvar async-callback))
(defgroup dired-async nil
"Copy rename files asynchronously from dired."
:group 'dired)
(defcustom dired-async-env-variables-regexp
"\\`\\(tramp-\\(default\\|connection\\|remote\\)\\|ange-ftp\\)-.*"
"Variables matching this regexp will be loaded on Child Emacs."
:type 'regexp)
(defcustom dired-async-message-function 'dired-async-mode-line-message
"Function to use to notify result when operation finish.
Should take same args as `message'."
:type 'function)
(defcustom dired-async-log-file "/tmp/dired-async.log"
"File use to communicate errors from Child Emacs to host Emacs."
:type 'string)
(defcustom dired-async-mode-lighter '(:eval
(when (eq major-mode 'dired-mode)
" Async"))
"Mode line lighter used for `dired-async-mode'."
:risky t
:type 'sexp)
(defcustom dired-async-skip-fast nil
"If non-nil, skip async for fast operations.
Same device renames and copying and renaming files smaller than
`dired-async-small-file-max' are considered fast."
:risky t
:type 'boolean)
(defcustom dired-async-small-file-max 5000000
"Files smaller than this in bytes are considered fast to copy
or rename for `dired-async-skip-fast'."
:risky t
:type 'integer)
(defface dired-async-message
'((t (:foreground "yellow")))
"Face used for mode-line message.")
(defface dired-async-failures
'((t (:foreground "red")))
"Face used for mode-line message.")
(defface dired-async-mode-message
'((t (:foreground "Gold")))
"Face used for `dired-async--modeline-mode' lighter.")
(define-minor-mode dired-async--modeline-mode
"Notify mode-line that an async process run."
:global t
:lighter (:eval (propertize (format " [%s Async job(s) running]"
(length (dired-async-processes)))
'face 'dired-async-mode-message))
(unless dired-async--modeline-mode
(let ((visible-bell t)) (ding))))
(defun dired-async-mode-line-message (text face &rest args)
"Notify end of operation in `mode-line'."
(message nil)
(let ((mode-line-format (concat
" " (propertize
(if args
(apply #'format text args)
text)
'face face))))
(force-mode-line-update)
(sit-for 3)
(force-mode-line-update)))
(defun dired-async-processes ()
(cl-loop for p in (process-list)
when (process-get p 'dired-async-process)
collect p))
(defun dired-async-kill-process ()
(interactive)
(let* ((processes (dired-async-processes))
(proc (car (last processes))))
(and proc (delete-process proc))
(unless (> (length processes) 1)
(dired-async--modeline-mode -1))))
(defun dired-async-after-file-create (total operation failures skipped)
"Callback function used for operation handled by `dired-create-file'."
(unless (dired-async-processes)
;; Turn off mode-line notification
;; only when last process end.
(dired-async--modeline-mode -1))
(when operation
(if (file-exists-p dired-async-log-file)
(progn
(pop-to-buffer (get-buffer-create dired-log-buffer))
(goto-char (point-max))
(setq inhibit-read-only t)
(insert "Error: ")
(insert-file-contents dired-async-log-file)
(special-mode)
(shrink-window-if-larger-than-buffer)
(delete-file dired-async-log-file))
(run-with-timer
0.1 nil
(lambda ()
;; First send error messages.
(cond (failures
(funcall dired-async-message-function
"%s failed for %d of %d file%s -- See *Dired log* buffer"
'dired-async-failures
(car operation) (length failures)
total (dired-plural-s total)))
(skipped
(funcall dired-async-message-function
"%s: %d of %d file%s skipped -- See *Dired log* buffer"
'dired-async-failures
(car operation) (length skipped) total
(dired-plural-s total))))
(when dired-buffers
(cl-loop for (_f . b) in dired-buffers
when (buffer-live-p b)
do (with-current-buffer b
(when (and (not (file-remote-p default-directory nil t))
(file-exists-p default-directory))
(revert-buffer nil t)))))
;; Finally send the success message.
(funcall dired-async-message-function
"Asynchronous %s of %s on %s file%s done"
'dired-async-message
(car operation) (cadr operation)
total (dired-plural-s total)))))))
(defun dired-async-maybe-kill-ftp ()
"Return a form to kill ftp process in child emacs."
(quote
(progn
(require 'cl-lib)
(let ((buf (cl-loop for b in (buffer-list)
thereis (and (string-match
"\\`\\*ftp.*"
(buffer-name b)) b))))
(when buf (kill-buffer buf))))))
(defsubst dired-async--directory-p (attributes)
"Return non-nil if ATTRIBUTES is for a directory.
See `file-attributes'."
;; Can also be a string for symlinks, so check for t explicitly.
(eq (file-attribute-type attributes) t))
(defsubst dired-async--same-device-p (f1 f2)
"Return non-nil if F1 and F2 have the same device number."
;; file-attribute-device-number may be a cons cell, so use equal for
;; testing (See Emacs bug/58446).
(equal (file-attribute-device-number (file-attributes f1))
(file-attribute-device-number (file-attributes f2))))
(defun dired-async--small-file-p (file)
"Return non-nil if FILE is considered small.
File is considered small if it size is smaller than
`dired-async-small-file-max'."
(let ((a (file-attributes file)))
;; Directories are always large since we can't easily figure out
;; their total size.
(and (not (dired-async--directory-p a))
(< (file-attribute-size a) dired-async-small-file-max))))
(defun dired-async--skip-async-p (file-creator file name-constructor)
"Return non-nil if we should skip async for FILE.
See `dired-create-files' for FILE-CREATOR and NAME-CONSTRUCTOR."
;; Skip async for small files.
(or (dired-async--small-file-p file)
;; Also skip async for same device renames.
(and (eq file-creator 'dired-rename-file)
(let ((new (funcall name-constructor file)))
(dired-async--same-device-p file (file-name-directory new))))))
(defun dired-async--smart-create-files (old-func file-creator
operation fn-list name-constructor
&optional marker-char)
"Around advice for `dired-create-files'.
Uses async like `dired-async-create-files' but skips certain fast
cases if `dired-async-skip-fast' is non-nil."
(let (async-list quick-list)
(if (or (eq file-creator 'backup-file)
(null dired-async-skip-fast))
(setq async-list fn-list)
(dolist (old fn-list)
(if (dired-async--skip-async-p file-creator old name-constructor)
(push old quick-list)
(push old async-list))))
(when async-list
(dired-async-create-files
file-creator operation (nreverse async-list)
name-constructor marker-char))
(when quick-list
(funcall old-func file-creator operation
(nreverse quick-list) name-constructor marker-char))))
(defvar overwrite-query)
(defun dired-async-create-files (file-creator operation fn-list name-constructor
&optional _marker-char)
"Same as `dired-create-files' but asynchronous.
See `dired-create-files' for the behavior of arguments."
(setq overwrite-query nil)
(let ((total (length fn-list))
failures async-fn-list skipped callback
async-quiet-switch)
(let (to)
(dolist (from fn-list)
(setq to (funcall name-constructor from))
(if (and (equal to from)
(null (eq file-creator 'backup-file)))
(progn
(setq to nil)
(dired-log "Cannot %s to same file: %s\n"
(downcase operation) from)))
(if (not to)
(setq skipped (cons (dired-make-relative from) skipped))
(let* ((overwrite (and (null (eq file-creator 'backup-file))
(file-exists-p to)))
(dired-overwrite-confirmed ; for dired-handle-overwrite
(and overwrite
(let ((help-form `(format "\
Type SPC or `y' to overwrite file `%s',
DEL or `n' to skip to next,
ESC or `q' to not overwrite any of the remaining files,
`!' to overwrite all remaining files with no more questions." ,to)))
(dired-query 'overwrite-query "Overwrite `%s'?" to)))))
;; Handle the `dired-copy-file' file-creator specially
;; When copying a directory to another directory or
;; possibly to itself or one of its subdirectories.
;; e.g "~/foo/" => "~/test/"
;; or "~/foo/" =>"~/foo/"
;; or "~/foo/ => ~/foo/bar/")
;; In this case the 'name-constructor' have set the destination
;; TO to "~/test/foo" because the old emacs23 behavior
;; of `copy-directory' was to not create the subdirectory
;; and instead copy the contents.
;; With the new behavior of `copy-directory'
;; (similar to the `cp' shell command) we don't
;; need such a construction of the target directory,
;; so modify the destination TO to "~/test/" instead of "~/test/foo/".
(let ((destname (file-name-directory to)))
(when (and (file-directory-p from)
(file-directory-p to)
(eq file-creator 'dired-copy-file))
(setq to destname))
;; If DESTNAME is a subdirectory of FROM, not a symlink,
;; and the method in use is copying, signal an error.
(and (eq t (car (file-attributes destname)))
(eq file-creator 'dired-copy-file)
(file-in-directory-p destname from)
(error "Cannot copy `%s' into its subdirectory `%s'"
from to)))
(if overwrite
(or (and dired-overwrite-confirmed
(push (cons from to) async-fn-list))
(progn
(push (dired-make-relative from) failures)
(dired-log "%s `%s' to `%s' failed\n"
operation from to)))
(push (cons from to) async-fn-list)))))
;; Fix tramp issue #80 with emacs-26, use "-q" only when needed.
(setq async-quiet-switch
(if (and (boundp 'tramp-cache-read-persistent-data)
async-fn-list
(cl-loop for (_from . to) in async-fn-list
thereis (file-remote-p to)))
"-q" "-Q"))
;; When failures have been printed to dired log add the date at bob.
(when (or failures skipped) (dired-log t))
;; When async-fn-list is empty that's mean only one file
;; had to be copied and user finally answer NO.
;; In this case async process will never start and callback
;; will have no chance to run, so notify failures here.
(unless async-fn-list
(cond (failures
(funcall dired-async-message-function
"%s failed for %d of %d file%s -- See *Dired log* buffer"
'dired-async-failures
operation (length failures)
total (dired-plural-s total)))
(skipped
(funcall dired-async-message-function
"%s: %d of %d file%s skipped -- See *Dired log* buffer"
'dired-async-failures
operation (length skipped) total
(dired-plural-s total)))))
;; Setup callback.
(setq callback
(lambda (&optional _ignore)
(dired-async-after-file-create
total (list operation (length async-fn-list)) failures skipped)
(when (string= (downcase operation) "rename")
(cl-loop for (file . to) in async-fn-list
for bf = (get-file-buffer file)
for destp = (file-exists-p to)
do (and bf destp
(with-current-buffer bf
(set-visited-file-name to t t))))))))
;; Start async process.
(when async-fn-list
(process-put
(async-start `(lambda ()
(require 'cl-lib) (require 'dired-aux) (require 'dired-x)
,(async-inject-variables dired-async-env-variables-regexp)
(let ((dired-recursive-copies (quote always))
(dired-copy-preserve-time
,dired-copy-preserve-time))
(setq overwrite-backup-query nil)
;; Inline `backup-file' as long as it is not
;; available in emacs.
(defalias 'backup-file
;; Same feature as "cp -f --backup=numbered from to"
;; Symlinks are copied as file from source unlike
;; `dired-copy-file' which is same as cp -d.
;; Directories are omitted.
(lambda (from to ok)
(cond ((file-directory-p from) (ignore))
(t (let ((count 0))
(while (let ((attrs (file-attributes to)))
(and attrs (null (nth 0 attrs))))
(cl-incf count)
(setq to (concat (file-name-sans-versions to)
(format ".~%s~" count)))))
(condition-case err
(copy-file from to ok dired-copy-preserve-time)
(file-date-error
(dired-log "Can't set date on %s:\n%s\n" from err)))))))
;; Now run the FILE-CREATOR function on files.
(cl-loop with fn = (quote ,file-creator)
for (from . dest) in (quote ,async-fn-list)
do (condition-case err
(funcall fn from dest t)
(file-error
(dired-log "%s: %s\n" (car err) (cdr err))
nil)))
(when (get-buffer dired-log-buffer)
(dired-log t)
(with-current-buffer dired-log-buffer
(write-region (point-min) (point-max)
,dired-async-log-file))))
,(dired-async-maybe-kill-ftp))
callback)
'dired-async-process t)
;; Run mode-line notifications while process running.
(dired-async--modeline-mode 1)
(message "%s proceeding asynchronously..." operation))))
(defvar wdired-use-interactive-rename)
(defun dired-async-wdired-do-renames (old-fn &rest args)
;; Perhaps a better fix would be to ask for renaming BEFORE starting
;; OLD-FN when `wdired-use-interactive-rename' is non-nil. For now
;; just bind it to nil to ensure no questions will be asked between
;; each rename.
(let (wdired-use-interactive-rename)
(apply old-fn args)))
;;;###autoload
(define-minor-mode dired-async-mode
"Do dired actions asynchronously."
:lighter dired-async-mode-lighter
:global t
(if dired-async-mode
(progn
(advice-add 'dired-create-files :around #'dired-async--smart-create-files)
(advice-add 'wdired-do-renames :around #'dired-async-wdired-do-renames))
(progn
(advice-remove 'dired-create-files #'dired-async--smart-create-files)
(advice-remove 'wdired-do-renames #'dired-async-wdired-do-renames))))
(defmacro dired-async--with-async-create-files (&rest body)
"Evaluate BODY with ‘dired-create-files’ set to ‘dired-async-create-files’."
(declare (indent 0))
`(cl-letf (((symbol-function 'dired-create-files) #'dired-async-create-files))
,@body))
;;;###autoload
(defun dired-async-do-copy (&optional arg)
"Run ‘dired-do-copy’ asynchronously."
(interactive "P")
(dired-async--with-async-create-files
(dired-do-copy arg)))
;;;###autoload
(defun dired-async-do-symlink (&optional arg)
"Run ‘dired-do-symlink’ asynchronously."
(interactive "P")
(dired-async--with-async-create-files
(dired-do-symlink arg)))
;;;###autoload
(defun dired-async-do-hardlink (&optional arg)
"Run ‘dired-do-hardlink’ asynchronously."
(interactive "P")
(dired-async--with-async-create-files
(dired-do-hardlink arg)))
;;;###autoload
(defun dired-async-do-rename (&optional arg)
"Run ‘dired-do-rename’ asynchronously."
(interactive "P")
(dired-async--with-async-create-files
(dired-do-rename arg)))
(provide 'dired-async)
;;; dired-async.el ends here

71
org/elpa/async-20230323.643/smtpmail-async.el
View File

@ -1,71 +0,0 @@
;;; smtpmail-async.el --- Send e-mail with smtpmail.el asynchronously -*- lexical-binding: t -*-
;; Copyright (C) 2012-2022 Free Software Foundation, Inc.
;; Author: John Wiegley <jwiegley@gmail.com>
;; Created: 18 Jun 2012
;; Keywords: email async
;; X-URL: https://github.com/jwiegley/emacs-async
;; 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:
;; Send e-mail with smtpmail.el asynchronously. To use:
;;
;; (require 'smtpmail-async)
;;
;; (setq send-mail-function 'async-smtpmail-send-it
;; message-send-mail-function 'async-smtpmail-send-it)
;;
;; This assumes you already have smtpmail.el working.
;;; Code:
(defgroup smtpmail-async nil
"Send e-mail with smtpmail.el asynchronously"
:group 'smptmail)
(require 'async)
(require 'smtpmail)
(require 'message)
(defvar async-smtpmail-before-send-hook nil
"Hook running in the child emacs in `async-smtpmail-send-it'.
It is called just before calling `smtpmail-send-it'.")
(defun async-smtpmail-send-it ()
(let ((to (message-field-value "To"))
(buf-content (buffer-substring-no-properties
(point-min) (point-max))))
(message "Delivering message to %s..." to)
(async-start
`(lambda ()
(require 'smtpmail)
(with-temp-buffer
(insert ,buf-content)
(set-buffer-multibyte nil)
;; Pass in the variable environment for smtpmail
,(async-inject-variables
"\\`\\(smtpmail\\|async-smtpmail\\|\\(user-\\)?mail\\)-\\|auth-sources\\|epg\\|nsm"
nil "\\`\\(mail-header-format-function\\|smtpmail-address-buffer\\|mail-mode-abbrev-table\\)")
(run-hooks 'async-smtpmail-before-send-hook)
(smtpmail-send-it)))
(lambda (&optional _ignore)
(message "Delivering message to %s...done" to)))))
(provide 'smtpmail-async)
;;; smtpmail-async.el ends here

0
org/elpa/async-20230323.643/async-autoloads.el → org/elpa/async-20230528.622/async-autoloads.el
View File

0
org/elpa/async-20230216.559/async-bytecomp.el → org/elpa/async-20230528.622/async-bytecomp.el
View File

6
org/elpa/async-20230323.643/async-pkg.el → org/elpa/async-20230528.622/async-pkg.el
View File

@ -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"))
:commit "34feabe1142863a2c96f75afda1a2ae4aa0813f6" :authors
:commit "3ae74c0a4ba223ba373e0cb636c385e08d8838be" :authors
'(("John Wiegley" . "jwiegley@gmail.com"))
:maintainers
'(("Thierry Volpiatto" . "thievol@posteo.net"))
:maintainer
'("Thierry Volpiatto" . "thievol@posteo.net")
:keywords

0
org/elpa/async-20230323.643/async.el → org/elpa/async-20230528.622/async.el
View File

17
org/elpa/async-20230216.559/dired-async.el → org/elpa/async-20230528.622/dired-async.el
View File

@ -251,7 +251,7 @@ See `dired-create-files' for the behavior of arguments."
(setq overwrite-query nil)
(let ((total (length fn-list))
failures async-fn-list skipped callback
async-quiet-switch)
async-quiet-switch create-dir)
(let (to)
(dolist (from fn-list)
(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)
do (and bf destp
(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.
(when async-fn-list
(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)
(let ((dired-recursive-copies (quote always))
(dired-copy-preserve-time
,dired-copy-preserve-time))
,dired-copy-preserve-time)
(dired-create-destination-dirs ',create-dir))
(setq overwrite-backup-query nil)
;; Inline `backup-file' as long as it is not
;; available in emacs.

0
org/elpa/async-20230216.559/smtpmail-async.el → org/elpa/async-20230528.622/smtpmail-async.el
View File

0
org/elpa/centaur-tabs-20230109.457/centaur-tabs-autoloads.el → org/elpa/centaur-tabs-20230607.1501/centaur-tabs-autoloads.el
View File

55
org/elpa/centaur-tabs-20230109.457/centaur-tabs-elements.el → org/elpa/centaur-tabs-20230607.1501/centaur-tabs-elements.el
View File

@ -168,10 +168,31 @@ Default is 'hand. The following scopes are possible:
;;; Icons
;;
(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
: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
1.0
"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
: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)
"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 (featurep 'all-the-icons)
(if centaur-tabs-icon-type
(with-current-buffer (car tab)
(let* ((icon
(if (and (buffer-file-name)
(all-the-icons-auto-mode-match?))
(all-the-icons-icon-for-file
(centaur-tabs--auto-mode-match?))
(centaur-tabs--icon-for-file
(file-name-nondirectory (buffer-file-name))
:v-adjust centaur-tabs-icon-v-adjust
:height centaur-tabs-icon-scale-factor)
(all-the-icons-icon-for-mode
(centaur-tabs--icon-for-mode
major-mode
:v-adjust centaur-tabs-icon-v-adjust
:height centaur-tabs-icon-scale-factor)))

4
org/elpa/centaur-tabs-20230109.457/centaur-tabs-functions.el → org/elpa/centaur-tabs-20230607.1501/centaur-tabs-functions.el
View File

@ -36,6 +36,10 @@
(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-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-name "ext:projectile.el" t t)
(defvar helm-source-centaur-tabs-group)

0
org/elpa/centaur-tabs-20230109.457/centaur-tabs-interactive.el → org/elpa/centaur-tabs-20230607.1501/centaur-tabs-interactive.el
View File

6
org/elpa/centaur-tabs-20230109.457/centaur-tabs-pkg.el → org/elpa/centaur-tabs-20230607.1501/centaur-tabs-pkg.el
View File

@ -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")
(powerline "2.4")
(cl-lib "0.5"))
:commit "a2890d968d877b269a814a691356fc5877833c39" :authors
:commit "0bb1aa18d475319df85f192dce3327802866c3c3" :authors
'(("Emmanuel Bustos" . "ema2159@gmail.com"))
:maintainers
'(("Emmanuel Bustos" . "ema2159@gmail.com"))
:maintainer
'("Emmanuel Bustos" . "ema2159@gmail.com")

0
org/elpa/centaur-tabs-20230109.457/centaur-tabs.el → org/elpa/centaur-tabs-20230607.1501/centaur-tabs.el
View File

3933
org/elpa/dash-20221013.836/dash.el
View File

File diff suppressed because it is too large Load Diff

4856
org/elpa/dash-20221013.836/dash.info
View File

File diff suppressed because it is too large Load Diff

87
org/elpa/dash-20230304.2223/dash-autoloads.el
View File

@ -1,87 +0,0 @@
;;; dash-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 "dash" "dash.el" (0 0 0 0))
;;; Generated autoloads from dash.el
(autoload 'dash-fontify-mode "dash" "\
Toggle fontification of Dash special variables.
This is a minor mode. If called interactively, toggle the
`Dash-Fontify 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 `dash-fontify-mode'.
The mode's hook is called both when the mode is enabled and when
it is disabled.
Dash-Fontify mode is a buffer-local minor mode intended for Emacs
Lisp buffers. Enabling it causes the special variables bound in
anaphoric Dash macros to be fontified. These anaphoras include
`it', `it-index', `acc', and `other'. In older Emacs versions
which do not dynamically detect macros, Dash-Fontify mode
additionally fontifies Dash macro calls.
See also `dash-fontify-mode-lighter' and
`global-dash-fontify-mode'.
\(fn &optional ARG)" t nil)
(put 'global-dash-fontify-mode 'globalized-minor-mode t)
(defvar global-dash-fontify-mode nil "\
Non-nil if Global Dash-Fontify mode is enabled.
See the `global-dash-fontify-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 `global-dash-fontify-mode'.")
(custom-autoload 'global-dash-fontify-mode "dash" nil)
(autoload 'global-dash-fontify-mode "dash" "\
Toggle Dash-Fontify mode in all buffers.
With prefix ARG, enable Global Dash-Fontify mode if ARG is positive;
otherwise, disable it.
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.
Dash-Fontify mode is enabled in all buffers where
`dash--turn-on-fontify-mode' would do it.
See `dash-fontify-mode' for more information on Dash-Fontify mode.
\(fn &optional ARG)" t nil)
(autoload 'dash-register-info-lookup "dash" "\
Register the Dash Info manual with `info-lookup-symbol'.
This allows Dash symbols to be looked up with \\[info-lookup-symbol]." t nil)
(register-definition-prefixes "dash" '("!cdr" "!cons" "--" "->" "-a" "-butlast" "-c" "-d" "-e" "-f" "-gr" "-i" "-juxt" "-keep" "-l" "-m" "-no" "-o" "-p" "-r" "-s" "-t" "-u" "-value-to-list" "-when-let" "-zip" "dash-"))
;;;***
;;;### (autoloads nil nil ("dash-pkg.el") (0 0 0 0))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; coding: utf-8
;; End:
;;; dash-autoloads.el ends here

12
org/elpa/dash-20230304.2223/dash-pkg.el
View File

@ -1,12 +0,0 @@
(define-package "dash" "20230304.2223" "A modern list library for Emacs"
'((emacs "24"))
:commit "bdf4a5d868618532d34c7b5bae6ac382c3b58f67" :authors
'(("Magnar Sveen" . "magnars@gmail.com"))
:maintainer
'("Magnar Sveen" . "magnars@gmail.com")
:keywords
'("extensions" "lisp")
:url "https://github.com/magnars/dash.el")
;; Local Variables:
;; no-byte-compile: t
;; End:

18
org/elpa/dash-20230304.2223/dir
View File

@ -1,18 +0,0 @@
This is the file .../info/dir, which contains the
topmost node of the Info hierarchy, called (dir)Top.
The first time you invoke Info you start off looking at this node.

File: dir, Node: Top This is the top of the INFO tree
This (the Directory node) gives a menu of major topics.
Typing "q" exits, "H" lists all Info commands, "d" returns here,
"h" gives a primer for first-timers,
"mEmacs<Return>" visits the Emacs manual, etc.
In Emacs, you can click mouse button 2 on a menu item or cross reference
to select it.
* Menu:
Emacs
* Dash: (dash.info). A modern list library for GNU Emacs.

0
org/elpa/dash-20221013.836/dash-autoloads.el → org/elpa/dash-20230714.723/dash-autoloads.el
View File

6
org/elpa/dash-20221013.836/dash-pkg.el → org/elpa/dash-20230714.723/dash-pkg.el
View File

@ -1,6 +1,8 @@
(define-package "dash" "20221013.836" "A modern list library for Emacs"
(define-package "dash" "20230714.723" "A modern list library for Emacs"
'((emacs "24"))
:commit "3df46d7d9fe74f52a661565888e4d31fd760f0df" :authors
:commit "f46268c75cb7c18361d3cee942cd4dc14a03aef4" :authors
'(("Magnar Sveen" . "magnars@gmail.com"))
:maintainers
'(("Magnar Sveen" . "magnars@gmail.com"))
:maintainer
'("Magnar Sveen" . "magnars@gmail.com")

124
org/elpa/dash-20230304.2223/dash.el → org/elpa/dash-20230714.723/dash.el
View File

@ -35,13 +35,13 @@
(unless (fboundp 'gv-define-setter)
(require 'cl))
;; TODO: Emacs versions 24.3..24.5 complain about unknown `declare'
;; props, so remove this when support for those versions is dropped.
(and (< emacs-major-version 25)
(boundp 'defun-declarations-alist)
(dolist (prop '(pure side-effect-free))
(unless (assq prop defun-declarations-alist)
(push (list prop #'ignore) defun-declarations-alist)))))
;; - 24.3 started complaining about unknown `declare' props.
;; - 25 introduced `pure' and `side-effect-free'.
;; - 30 introduced `important-return-value'.
(when (boundp 'defun-declarations-alist)
(dolist (prop '(important-return-value pure side-effect-free))
(unless (assq prop defun-declarations-alist)
(push (list prop #'ignore) defun-declarations-alist)))))
(defgroup dash ()
"Customize group for Dash, a modern list library."
@ -223,6 +223,7 @@ This function's anaphoric counterpart is `--dotimes'."
"Apply FN to each item in LIST and return the list of results.
This function's anaphoric counterpart is `--map'."
(declare (important-return-value t))
(mapcar fn 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'.
For other folds, see also `-reduce' and `-reduce-r'."
(declare (important-return-value t))
(--reduce-from (funcall fn acc it) init list))
(defmacro --reduce (form list)
@ -289,6 +291,7 @@ arguments.
This function's anaphoric counterpart is `--reduce'.
For other folds, see also `-reduce-from' and `-reduce-r'."
(declare (important-return-value t))
(if list
(-reduce-from fn (car list) (cdr list))
(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'.
For other folds, see also `-reduce-r' and `-reduce'."
(declare (important-return-value t))
(--reduce-r-from (funcall fn it acc) init 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'.
For other folds, see also `-reduce-r-from' and `-reduce'."
(declare (important-return-value t))
(if list
(--reduce-r (funcall fn it acc) list)
(funcall fn)))
@ -374,6 +379,7 @@ arguments.
This function's anaphoric counterpart is `--reductions-from'.
For other folds, see also `-reductions' and `-reductions-r'."
(declare (important-return-value t))
(--reductions-from (funcall fn acc it) init 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'.
For other folds, see also `-reductions' and `-reductions-r'."
(declare (important-return-value t))
(if list
(--reductions-from (funcall fn acc it) (car list) (cdr list))
(list (funcall fn))))
@ -424,6 +431,7 @@ arguments.
This function's anaphoric counterpart is `--reductions-r-from'.
For other folds, see also `-reductions' and `-reductions-r'."
(declare (important-return-value t))
(--reductions-r-from (funcall fn it acc) init 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
`-reductions'."
(declare (important-return-value t))
(if list
(--reductions-r (funcall fn it acc) list)
(list (funcall fn))))
@ -477,6 +486,7 @@ Alias: `-select'.
This function's anaphoric counterpart is `--filter'.
For similar operations, see also `-keep' and `-remove'."
(declare (important-return-value t))
(--filter (funcall pred it) list))
(defalias '-select '-filter)
@ -499,6 +509,7 @@ Alias: `-reject'.
This function's anaphoric counterpart is `--remove'.
For similar operations, see also `-keep' and `-filter'."
(declare (important-return-value t))
(--remove (funcall pred it) list))
(defalias '-reject '-remove)
@ -534,6 +545,7 @@ Alias: `-reject-first'.
This function's anaphoric counterpart is `--remove-first'.
See also `-map-first', `-remove-item', and `-remove-last'."
(declare (important-return-value t))
(--remove-first (funcall pred it) list))
;; TODO: #'-quoting the macro upsets Emacs 24.
@ -559,6 +571,7 @@ Alias: `-reject-last'.
This function's anaphoric counterpart is `--remove-last'.
See also `-map-last', `-remove-item', and `-remove-first'."
(declare (important-return-value t))
(--remove-last (funcall pred it) list))
(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.
Its anaphoric counterpart is `--keep'."
(declare (important-return-value t))
(--keep (funcall fn it) list))
(defun -non-nil (list)
"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))
(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'.
For a side-effecting variant, see also `-each-indexed'."
(declare (important-return-value t))
(--map-indexed (funcall fn it-index it) 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'
See also: `-update-at'"
(declare (important-return-value t))
(--map-when (funcall pred it) (funcall rep it) list))
(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.
See also: `-map-when', `-replace-first'"
(declare (important-return-value t))
(let (front)
(while (and list (not (funcall pred (car list))))
(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.
See also: `-map-when', `-replace-last'"
(declare (important-return-value t))
(nreverse (-map-first pred rep (reverse list))))
(defmacro --map-last (pred rep list)
@ -712,6 +730,7 @@ See also: `-map-last'"
(defun -mapcat (fn list)
"Return the concatenation of the result of mapping FN over LIST.
Thus function FN should return a list."
(declare (important-return-value t))
(--mapcat (funcall fn it) list))
(defmacro --iterate (form init n)
@ -735,6 +754,7 @@ This means a list of the form:
(INIT (FUN INIT) (FUN (FUN INIT)) ...)
N is the length of the returned list."
(declare (important-return-value t))
(--iterate (funcall fun it) init n))
(defun -flatten (l)
@ -816,12 +836,14 @@ marked positions (for example with keywords).
This function's anaphoric counterpart is `--splice'.
See also: `-splice-list', `-insert-at'."
(declare (important-return-value t))
(--splice (funcall pred it) (funcall fun it) list))
(defun -splice-list (pred new-list list)
"Splice NEW-LIST in place of elements matching PRED in LIST.
See also: `-splice', `-insert-at'"
(declare (important-return-value t))
(-splice pred (lambda (_) 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
result, so if the final element of ARGS is not a list, the result
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))
(tail (nthcdr (- len 2) args))
(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.
If any ELEMENTS are given, append them to the list as well."
(declare (side-effect-free t))
(-concat list (list elem) elements))
(defmacro --first (form list)
@ -874,6 +897,7 @@ use `-first-item'.
Alias: `-find'.
This function's anaphoric counterpart is `--first'."
(declare (important-return-value t))
(--first (funcall pred it) list))
(defalias '-find #'-first)
@ -897,6 +921,7 @@ This is the anaphoric counterpart to `-some'."
Alias: `-any'.
This function's anaphoric counterpart is `--some'."
(declare (important-return-value t))
(--some (funcall pred it) list))
(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.
This function's anaphoric counterpart is `--every'."
(declare (important-return-value t))
(--every (funcall pred it) list))
(defmacro --last (form list)
@ -943,6 +969,7 @@ This function's anaphoric counterpart is `--every'."
(defun -last (pred list)
"Return the last x in LIST where (PRED x) is non-nil, else nil."
(declare (important-return-value t))
(--last (funcall pred it) list))
(defalias '-first-item #'car
@ -1033,6 +1060,7 @@ See also: `-first-item', etc."
(defun -count (pred list)
"Counts the number of items in LIST where (PRED item) is non-nil."
(declare (important-return-value t))
(--count (funcall pred it) list))
(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.
Alias: `-any-p', `-some?', `-some-p'"
(declare (important-return-value t))
(--any? (funcall pred it) list))
(defalias '-some? '-any?)
@ -1087,6 +1116,7 @@ success.
Alias: `-all-p', `-every-p', `-every?'.
This function's anaphoric counterpart is `--all?'."
(declare (important-return-value t))
(--all? (funcall pred it) list))
(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.
Alias: `-none-p'"
(declare (important-return-value t))
(--none? (funcall pred it) list))
(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.
Alias: `-only-some-p'"
(declare (important-return-value t))
(--only-some? (funcall pred it) list))
(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
section is returned. Defaults to 1."
(declare (pure t) (side-effect-free t))
(declare (side-effect-free t))
(let ((length (length list))
(new-list nil))
;; to defaults to the end of the list
@ -1181,6 +1213,7 @@ non-nil.
This function's anaphoric counterpart is `--take-while'.
For another variant, see also `-drop-while'."
(declare (important-return-value t))
(--take-while (funcall pred it) list))
(defmacro --drop-while (form list)
@ -1205,6 +1238,7 @@ nil.
This function's anaphoric counterpart is `--drop-while'.
For another variant, see also `-take-while'."
(declare (important-return-value t))
(--drop-while (funcall pred it) 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.
See also: `-take-last'."
(declare (pure t) (side-effect-free t))
(declare (side-effect-free t))
(--take-while (< it-index 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.
See also: `-take'."
(declare (pure t) (side-effect-free t))
(declare (side-effect-free t))
(copy-sequence (last list n)))
(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.
See also: `-drop'."
(declare (pure t) (side-effect-free t))
(declare (side-effect-free t))
(nbutlast (copy-sequence list) n))
(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
the results of `-take' and `-drop', respectively, but the split
is done in a single list traversal."
(declare (pure t) (side-effect-free t))
(declare (side-effect-free t))
(let (result)
(--each-while list (< it-index n)
(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.
See also: `-map-when'"
(declare (important-return-value t))
(let ((split-list (-split-at n list)))
(nconc (car 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))
but in no more than a single pass through LIST."
(declare (important-return-value t))
(--split-with (funcall pred it) 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
`split-string'."
(declare (important-return-value t))
(let (r s)
(while list
(if (not (funcall fn (car list)))
@ -1414,6 +1451,7 @@ The result is like performing
((-filter PRED LIST) (-remove PRED LIST))
but in a single pass through LIST."
(declare (important-return-value t))
(--separate (funcall pred it) list))
(defun dash--partition-all-in-steps-reversed (n step list)
@ -1486,6 +1524,7 @@ those items are discarded."
(defun -partition-by (fn list)
"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))
(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
returns the header value, but only after seeing at least one
other value (the body)."
(declare (important-return-value t))
(--partition-by-header (funcall fn it) 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.
This function's anaphoric counterpart is `--partition-after-pred'."
(declare (important-return-value t))
(--partition-after-pred (funcall pred it) list))
(defun -partition-before-pred (pred list)
"Partition directly before each time PRED is true on an element of LIST."
(declare (important-return-value t))
(nreverse (-map #'reverse
(-partition-after-pred pred (reverse list)))))
(defun -partition-after-item (item 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))
list))
(defun -partition-before-item (item 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))
list))
@ -1592,11 +1636,12 @@ This function's anaphoric counterpart is `--partition-after-pred'."
(defun -group-by (fn list)
"Separate LIST into an alist whose keys are FN applied to the
elements of LIST. Keys are compared by `equal'."
(declare (important-return-value t))
(--group-by (funcall fn it) list))
(defun -interpose (sep list)
"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)
(when list
(!cons (car list) result)
@ -1608,7 +1653,7 @@ elements of LIST. Keys are compared by `equal'."
(defun -interleave (&rest lists)
"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
(let (result)
(while (-none? 'null lists)
@ -1647,6 +1692,7 @@ shorter list.
This function's anaphoric counterpart is `--zip-with'.
For other zips, see also `-zip-lists' and `-zip-fill'."
(declare (important-return-value t))
(--zip-with (funcall fn it other) list1 list2))
(defun -zip-lists (&rest lists)
@ -1844,6 +1890,7 @@ corresponding element of LIST, and RESULT is the value obtained
by calling FN on ITEM.
This function's anaphoric counterpart is `--annotate'."
(declare (important-return-value t))
(--annotate (funcall fn it) list))
(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).
See also: `-table-flat'"
(declare (important-return-value t))
(let ((restore-lists (copy-sequence lists))
(last-list (last lists))
(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.
See also: `-flatten-n', `-table'"
(declare (important-return-value t))
(let ((restore-lists (copy-sequence lists))
(last-list (last lists))
re)
@ -1927,6 +1976,7 @@ it returns non-nil, at which point the search terminates.
This function's anaphoric counterpart is `--find-index'.
See also: `-first', `-find-last-index'."
(declare (important-return-value t))
(--find-index (funcall pred it) 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'.
See also: `-find-index', `-elem-indices'."
(declare (important-return-value t))
(--find-indices (funcall pred it) list))
(defun -elem-indices (elem list)
@ -1989,6 +2040,7 @@ current list element.
This function's anaphoric counterpart is `--find-last-index'.
See also: `-last', `-find-index'."
(declare (important-return-value t))
(--find-last-index (funcall pred it) 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.
This yields a permutation vector such that applying this
permutation to LIST sorts it in ascending order."
(declare (important-return-value t))
(->> (--map-indexed (cons it it-index) list)
(-sort (lambda (it other) (funcall comparator (car it) (car other))))
(mapcar #'cdr)))
@ -2142,6 +2195,7 @@ permutation to LIST sorts it in ascending order."
"Grade elements of LIST using COMPARATOR relation.
This yields a permutation vector such that applying this
permutation to LIST sorts it in descending order."
(declare (important-return-value t))
(->> (--map-indexed (cons it it-index) list)
(-sort (lambda (it other) (funcall comparator (car other) (car it))))
(mapcar #'cdr)))
@ -2865,7 +2919,7 @@ Return nil if `-compare-fn' is not a known test function."
(declare (side-effect-free error-free))
;; In theory this could also recognize values that are custom
;; `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))))
(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.
Alias: `-uniq'."
(declare (important-return-value t))
(let (test len)
(cond ((null list) ())
;; 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'
if that is non-nil."
(declare (important-return-value t))
(let ((lists (list list1 list2)) test len union)
(cond ((null (or list1 list2)))
;; 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'
if that is non-nil."
(declare (important-return-value t))
(let (test len)
(cond ((null (and list1 list2)) ())
;; 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'
if that is non-nil."
(declare (important-return-value t))
(let (test len1 len2)
(cond ((null list1) ())
((null list2) (-distinct list1))
@ -2978,6 +3036,7 @@ if that is non-nil."
(defun -powerset (list)
"Return the power set of LIST."
(declare (pure t) (side-effect-free t))
(if (null list) (list ())
(let ((last (-powerset (cdr list))))
(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.
See also `-count' and `-group-by'."
(declare (important-return-value t))
(let (test len freqs)
(cond ((null list))
((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
`-compare-fn' if that is non-nil."
(declare (important-return-value t))
(cond ((null list) (list ()))
;; Optimization: a traversal of `list' is faster than the
;; 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)
"Return all prefixes of LIST."
(declare (pure t) (side-effect-free t))
(let ((res (list list)))
(setq list (reverse list))
(while list
@ -3132,8 +3194,9 @@ Duplicate elements of LIST are determined by `equal', or by
res))
(defun -tails (list)
"Return all suffixes of LIST"
(-reductions-r-from 'cons nil list))
"Return all suffixes of LIST."
(declare (pure t) (side-effect-free t))
(-reductions-r-from #'cons nil list))
(defun -common-prefix (&rest 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)
"Return the longest common suffix of LISTS."
(declare (pure t) (side-effect-free t))
(nreverse (apply #'-common-prefix (mapcar #'reverse lists))))
(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.
Alias: `-contains-p'."
(declare (important-return-value t))
(funcall (dash--member-fn) element list))
(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.
Alias: `-same-items-p'."
(declare (important-return-value t))
(let (test len1 len2)
(cond ((null (or list1 list2)))
((null (and list1 list2)) nil)
@ -3231,6 +3297,7 @@ Alias: `-is-infix-p'"
Return the sorted list. LIST is NOT modified by side effects.
COMPARATOR is called with two elements of LIST, and should return non-nil
if the first element should sort before the second."
(declare (important-return-value t))
(sort (copy-sequence list) comparator))
(defmacro --sort (form list)
@ -3254,7 +3321,7 @@ backward compatibility and is otherwise deprecated."
(defun -repeat (n x)
"Return a new list of length N with each element being X.
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)))
(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
comparing them."
(declare (important-return-value t))
(--reduce (if (funcall comparator it acc) it acc) 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
comparing them."
(declare (important-return-value t))
(--reduce (if (funcall comparator it acc) acc it) 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.
This function takes its name from the corresponding primitive in
the APL language."
(declare (pure t) (side-effect-free t))
(declare (side-effect-free t))
(unless (natnump count)
(signal 'wrong-type-argument (list #'natnump count)))
(or start (setq start 0))
@ -3340,6 +3409,7 @@ the APL language."
"Compute the (least) fixpoint of FN with initial input LIST.
FN is called at least once, results are compared with `equal'."
(declare (important-return-value t))
(let ((re (funcall fn list)))
(while (not (equal 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
cons (A . B), where A will be prepended to the result and B is
the new seed."
(declare (important-return-value t))
(let ((last (funcall fun seed)) r)
(while last
(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'
but is twice as fast as it only traverse the structure once."
(declare (important-return-value t))
(cond
((null 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'
but is twice as fast as it only traverse the structure once."
(declare (important-return-value t))
(cond
((null 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)
"Apply FN to each element of TREE while preserving the tree structure."
(declare (important-return-value t))
(cond
((null 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
two elements."
(declare (important-return-value t))
(cond
((null 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.
See `-reduce-r' for how exactly are lists of zero or one element handled."
(declare (important-return-value t))
(cond
((null 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.
Non-branch nodes are simply copied."
(declare (important-return-value t))
(cons tree
(and (funcall branch tree)
(-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
replaced with new ones. This is useful when you need to clone a
structure such as plist or alist."
(declare (pure t) (side-effect-free t))
(declare (side-effect-free t))
(-tree-map #'identity list))
;;; Combinators
@ -3741,6 +3818,7 @@ In types: (a -> a) -> Int -> a -> a.
This function satisfies the following law:
(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))
(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.
The closure accepts any number of arguments, which are discarded."
(declare (pure t) (side-effect-free error-free))
(let ((inc (or inc 1))
(n (or beg 0)))
(lambda (&rest _)
@ -3789,6 +3868,7 @@ iteration halted before converging, a cons with car `halted' and
cdr the final output from HALT-TEST.
In types: (a -> a) -> a -> a."
(declare (important-return-value t))
(let ((eqfn (or equal-test 'equal))
(haltfn (or halt-test
(-not

304
org/elpa/dash-20230304.2223/dash.info → org/elpa/dash-20230714.723/dash.info
View File

@ -1037,7 +1037,7 @@ Functions reducing lists to a single value (which may also be a list).
⇒ (nil (1))
-- Function: -tails (list)
Return all suffixes of LIST
Return all suffixes of LIST.
(-tails '(1 2 3 4))
⇒ ((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
the first element should sort before the second.
(-sort '< '(3 1 2))
(-sort #'< '(3 1 2))
⇒ (1 2 3)
(-sort '> '(3 1 2))
(-sort #'> '(3 1 2))
⇒ (3 2 1)
(--sort (< it other) '(3 1 2))
⇒ (1 2 3)
@ -2384,8 +2384,8 @@ Functions pretending lists are trees.
structure but all cons are replaced with new ones. This is useful
when you need to clone a structure such as plist or alist.
(let* ((a '(1 2 3)) (b (-clone a))) (nreverse a) b)
⇒ (1 2 3)
(let* ((a (list (list 1))) (b (-clone a))) (setcar (car a) 2) b)
⇒ ((1))

File: dash.info, Node: Threading macros, Next: Binding, Prev: Tree operations, Up: Functions
@ -4792,153 +4792,153 @@ Ref: -product35429
Ref: -running-product35637
Ref: -inits35978
Ref: -tails36223
Ref: -common-prefix36467
Ref: -common-suffix36761
Ref: -min37055
Ref: -min-by37281
Ref: -max37802
Ref: -max-by38027
Ref: -frequencies38553
Node: Unfolding39168
Ref: -iterate39409
Ref: -unfold39856
Ref: -repeat40661
Ref: -cycle40945
Node: Predicates41342
Ref: -some41519
Ref: -every41948
Ref: -any?42662
Ref: -all?43011
Ref: -none?43753
Ref: -only-some?44073
Ref: -contains?44618
Ref: -is-prefix?45124
Ref: -is-suffix?45456
Ref: -is-infix?45788
Ref: -cons-pair?46148
Node: Partitioning46479
Ref: -split-at46667
Ref: -split-with47331
Ref: -split-on47971
Ref: -split-when48642
Ref: -separate49285
Ref: -partition49819
Ref: -partition-all50268
Ref: -partition-in-steps50693
Ref: -partition-all-in-steps51239
Ref: -partition-by51753
Ref: -partition-by-header52131
Ref: -partition-after-pred52732
Ref: -partition-before-pred53185
Ref: -partition-before-item53570
Ref: -partition-after-item53877
Ref: -group-by54179
Node: Indexing54612
Ref: -elem-index54814
Ref: -elem-indices55301
Ref: -find-index55760
Ref: -find-last-index56429
Ref: -find-indices57080
Ref: -grade-up57842
Ref: -grade-down58249
Node: Set operations58663
Ref: -union58846
Ref: -difference59276
Ref: -intersection59704
Ref: -powerset60133
Ref: -permutations60410
Ref: -distinct60848
Ref: -same-items?61242
Node: Other list operations61851
Ref: -rotate62076
Ref: -cons*62429
Ref: -snoc62851
Ref: -interpose63263
Ref: -interleave63557
Ref: -iota63923
Ref: -zip-with64406
Ref: -zip-pair65214
Ref: -zip-lists65780
Ref: -zip-lists-fill66578
Ref: -zip67288
Ref: -zip-fill68315
Ref: -unzip-lists69229
Ref: -unzip69852
Ref: -pad70845
Ref: -table71330
Ref: -table-flat72116
Ref: -first73121
Ref: -last73654
Ref: -first-item74000
Ref: -second-item74412
Ref: -third-item74829
Ref: -fourth-item75204
Ref: -fifth-item75582
Ref: -last-item75957
Ref: -butlast76318
Ref: -sort76563
Ref: -list77055
Ref: -fix77624
Node: Tree operations78113
Ref: -tree-seq78309
Ref: -tree-map79170
Ref: -tree-map-nodes79610
Ref: -tree-reduce80474
Ref: -tree-reduce-from81356
Ref: -tree-mapreduce81956
Ref: -tree-mapreduce-from82815
Ref: -clone84100
Node: Threading macros84427
Ref: ->84652
Ref: ->>85140
Ref: -->85643
Ref: -as->86199
Ref: -some->86653
Ref: -some->>87038
Ref: -some-->87485
Ref: -doto88052
Node: Binding88605
Ref: -when-let88812
Ref: -when-let*89273
Ref: -if-let89802
Ref: -if-let*90168
Ref: -let90791
Ref: -let*96881
Ref: -lambda97818
Ref: -setq98624
Node: Side effects99425
Ref: -each99619
Ref: -each-while100146
Ref: -each-indexed100766
Ref: -each-r101358
Ref: -each-r-while101800
Ref: -dotimes102444
Node: Destructive operations102997
Ref: !cons103215
Ref: !cdr103419
Node: Function combinators103612
Ref: -partial103816
Ref: -rpartial104334
Ref: -juxt104982
Ref: -compose105434
Ref: -applify106041
Ref: -on106471
Ref: -flip107243
Ref: -rotate-args107767
Ref: -const108396
Ref: -cut108738
Ref: -not109218
Ref: -orfn109762
Ref: -andfn110555
Ref: -iteratefn111342
Ref: -fixfn112044
Ref: -prodfn113618
Node: Development114769
Node: Contribute115058
Node: Contributors116070
Node: FDL118163
Node: GPL143483
Node: Index181232
Ref: -common-prefix36468
Ref: -common-suffix36762
Ref: -min37056
Ref: -min-by37282
Ref: -max37803
Ref: -max-by38028
Ref: -frequencies38554
Node: Unfolding39169
Ref: -iterate39410
Ref: -unfold39857
Ref: -repeat40662
Ref: -cycle40946
Node: Predicates41343
Ref: -some41520
Ref: -every41949
Ref: -any?42663
Ref: -all?43012
Ref: -none?43754
Ref: -only-some?44074
Ref: -contains?44619
Ref: -is-prefix?45125
Ref: -is-suffix?45457
Ref: -is-infix?45789
Ref: -cons-pair?46149
Node: Partitioning46480
Ref: -split-at46668
Ref: -split-with47332
Ref: -split-on47972
Ref: -split-when48643
Ref: -separate49286
Ref: -partition49820
Ref: -partition-all50269
Ref: -partition-in-steps50694
Ref: -partition-all-in-steps51240
Ref: -partition-by51754
Ref: -partition-by-header52132
Ref: -partition-after-pred52733
Ref: -partition-before-pred53186
Ref: -partition-before-item53571
Ref: -partition-after-item53878
Ref: -group-by54180
Node: Indexing54613
Ref: -elem-index54815
Ref: -elem-indices55302
Ref: -find-index55761
Ref: -find-last-index56430
Ref: -find-indices57081
Ref: -grade-up57843
Ref: -grade-down58250
Node: Set operations58664
Ref: -union58847
Ref: -difference59277
Ref: -intersection59705
Ref: -powerset60134
Ref: -permutations60411
Ref: -distinct60849
Ref: -same-items?61243
Node: Other list operations61852
Ref: -rotate62077
Ref: -cons*62430
Ref: -snoc62852
Ref: -interpose63264
Ref: -interleave63558
Ref: -iota63924
Ref: -zip-with64407
Ref: -zip-pair65215
Ref: -zip-lists65781
Ref: -zip-lists-fill66579
Ref: -zip67289
Ref: -zip-fill68316
Ref: -unzip-lists69230
Ref: -unzip69853
Ref: -pad70846
Ref: -table71331
Ref: -table-flat72117
Ref: -first73122
Ref: -last73655
Ref: -first-item74001
Ref: -second-item74413
Ref: -third-item74830
Ref: -fourth-item75205
Ref: -fifth-item75583
Ref: -last-item75958
Ref: -butlast76319
Ref: -sort76564
Ref: -list77058
Ref: -fix77627
Node: Tree operations78116
Ref: -tree-seq78312
Ref: -tree-map79173
Ref: -tree-map-nodes79613
Ref: -tree-reduce80477
Ref: -tree-reduce-from81359
Ref: -tree-mapreduce81959
Ref: -tree-mapreduce-from82818
Ref: -clone84103
Node: Threading macros84441
Ref: ->84666
Ref: ->>85154
Ref: -->85657
Ref: -as->86213
Ref: -some->86667
Ref: -some->>87052
Ref: -some-->87499
Ref: -doto88066
Node: Binding88619
Ref: -when-let88826
Ref: -when-let*89287
Ref: -if-let89816
Ref: -if-let*90182
Ref: -let90805
Ref: -let*96895
Ref: -lambda97832
Ref: -setq98638
Node: Side effects99439
Ref: -each99633
Ref: -each-while100160
Ref: -each-indexed100780
Ref: -each-r101372
Ref: -each-r-while101814
Ref: -dotimes102458
Node: Destructive operations103011
Ref: !cons103229
Ref: !cdr103433
Node: Function combinators103626
Ref: -partial103830
Ref: -rpartial104348
Ref: -juxt104996
Ref: -compose105448
Ref: -applify106055
Ref: -on106485
Ref: -flip107257
Ref: -rotate-args107781
Ref: -const108410
Ref: -cut108752
Ref: -not109232
Ref: -orfn109776
Ref: -andfn110569
Ref: -iteratefn111356
Ref: -fixfn112058
Ref: -prodfn113632
Node: Development114783
Node: Contribute115072
Node: Contributors116084
Node: FDL118177
Node: GPL143497
Node: Index181246

End Tag Table

0
org/elpa/dash-20221013.836/dir → org/elpa/dash-20230714.723/dir
View File

1366
org/elpa/dashboard-20230220.1916/dashboard-widgets.el
View File

File diff suppressed because it is too large Load Diff

469
org/elpa/dashboard-20230220.1916/dashboard.el
View File

@ -1,469 +0,0 @@
;;; 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.8.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")
(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 (buffer-read-only) ,@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)
;;;###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 '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

8
org/elpa/dashboard-20230331.2304/banners/1.txt
View File

@ -1,8 +0,0 @@
######## ## ## ### ###### ######
## ### ### ## ## ## ## ## ##
## #### #### ## ## ## ##
###### ## ### ## ## ## ## ######
## ## ## ######### ## ##
## ## ## ## ## ## ## ## ##
######## ## ## ## ## ###### ######

6
org/elpa/dashboard-20230331.2304/banners/2.txt
View File

@ -1,6 +0,0 @@
_______ .___ ___. ___ ______ _______.
| ____|| \/ | / \ / | / |
| |__ | \ / | / ^ \ | ,----' | (----`
| __| | |\/| | / /_\ \ | | \ \
| |____ | | | | / _____ \ | `----.----) |
|_______||__| |__| /__/ \__\ \______|_______/

8
org/elpa/dashboard-20230331.2304/banners/3.txt
View File

@ -1,8 +0,0 @@
_______ _____ ______ ________ ________ ________
|\ ___ \ |\ _ \ _ \|\ __ \|\ ____\|\ ____\
\ \ __/|\ \ \\\__\ \ \ \ \|\ \ \ \___|\ \ \___|_
\ \ \_|/_\ \ \\|__| \ \ \ __ \ \ \ \ \_____ \
\ \ \_|\ \ \ \ \ \ \ \ \ \ \ \ \____\|____|\ \
\ \_______\ \__\ \ \__\ \__\ \__\ \_______\____\_\ \
\|_______|\|__| \|__|\|__|\|__|\|_______|\_________\
\|_________|

17
org/elpa/dashboard-20230331.2304/banners/4.txt
View File

@ -1,17 +0,0 @@
_ ___ _ _
_ ___ __ ___ __ _ ___
__ _ ___ __ ___
_ ___ _
_ _ __ _
___ __ _
__ _
_ _ _
_ _ _
_ _ _
__ ___
_ _ _ _
_ _
_ _
_ _
_
__

BIN
org/elpa/dashboard-20230331.2304/banners/emacs.png
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 43 KiB

BIN
org/elpa/dashboard-20230331.2304/banners/logo.png
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 32 KiB

44
org/elpa/dashboard-20230331.2304/dashboard-autoloads.el
View File

@ -1,44 +0,0 @@
;;; 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

12
org/elpa/dashboard-20230331.2304/dashboard-pkg.el
View File

@ -1,12 +0,0 @@
(define-package "dashboard" "20230331.2304" "A startup screen extracted from Spacemacs"
'((emacs "26.1"))
:commit "0f970d298931f9de7b511086728af140bf44a642" :authors
'(("Rakan Al-Hneiti" . "rakan.alhneiti@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:

0
org/elpa/dashboard-20230220.1916/banners/1.txt → org/elpa/dashboard-20230726.2018/banners/1.txt
View File

0
org/elpa/dashboard-20230220.1916/banners/2.txt → org/elpa/dashboard-20230726.2018/banners/2.txt
View File

0
org/elpa/dashboard-20230220.1916/banners/3.txt → org/elpa/dashboard-20230726.2018/banners/3.txt
View File

0
org/elpa/dashboard-20230220.1916/banners/4.txt → org/elpa/dashboard-20230726.2018/banners/4.txt
View File

0
org/elpa/dashboard-20230220.1916/banners/emacs.png → org/elpa/dashboard-20230726.2018/banners/emacs.png
View File

Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 43 KiB

After

Width:  |  Height:  |  Size: 43 KiB

0
org/elpa/dashboard-20230220.1916/banners/logo.png → org/elpa/dashboard-20230726.2018/banners/logo.png
View File

Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 32 KiB

After

Width:  |  Height:  |  Size: 32 KiB

0
org/elpa/dashboard-20230220.1916/dashboard-autoloads.el → org/elpa/dashboard-20230726.2018/dashboard-autoloads.el
View File

6
org/elpa/dashboard-20230220.1916/dashboard-pkg.el → org/elpa/dashboard-20230726.2018/dashboard-pkg.el
View File

@ -1,7 +1,9 @@
(define-package "dashboard" "20230220.1916" "A startup screen extracted from Spacemacs"
(define-package "dashboard" "20230726.2018" "A startup screen extracted from Spacemacs"
'((emacs "26.1"))
:commit "221ee4b77db77199380c519c4ba52c06abc725e9" :authors
: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

213
org/elpa/dashboard-20230331.2304/dashboard-widgets.el → org/elpa/dashboard-20230726.2018/dashboard-widgets.el
View File

@ -12,7 +12,7 @@
;;; License: GPLv3
;;
;; Created: October 05, 2016
;; Package-Version: 1.8.0-SNAPSHOT
;; Package-Version: 1.9.0-SNAPSHOT
;; Keywords: startup, screen, tools, dashboard
;; Package-Requires: ((emacs "26.1"))
;;; Commentary:
@ -31,6 +31,11 @@
(declare-function all-the-icons-icon-for-file "ext:all-the-icons.el")
(declare-function all-the-icons-fileicon "ext:data-fileicons.el")
(declare-function all-the-icons-octicon "ext:data-octicons.el")
(declare-function nerd-icons-icon-for-dir "ext:nerd-icons.el")
(declare-function nerd-icons-icon-for-file "ext:nerd-icons.el")
(declare-function nerd-icons-sucicon "ext:nerd-icons.el")
(declare-function nerd-icons-octicon "ext:nerd-icons.el")
(declare-function nerd-icons-codicon "ext:nerd-icons.el")
(declare-function bookmark-get-filename "ext:bookmark.el")
(declare-function bookmark-all-names "ext:bookmark.el")
(declare-function calendar-date-compare "ext:calendar.el")
@ -136,6 +141,70 @@ preserved."
:type 'list
:group 'dashboard)
(defcustom dashboard-icon-type (and (or dashboard-set-heading-icons
dashboard-set-file-icons)
(or (require 'nerd-icons nil t)
(require 'all-the-icons nil t)))
"Icon type used for dashboard.
The value can be one of: `all-the-icons', `nerd-icons'."
:type 'symbol
:group 'dashboard
: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))))
(set k v)))
(defcustom dashboard-heading-icons
(pcase dashboard-icon-type
('all-the-icons '((recents . "history")
(bookmarks . "bookmark")
(agenda . "calendar")
(projects . "rocket")
(registers . "database")))
('nerd-icons '((recents . "nf-oct-history")
(bookmarks . "nf-oct-bookmark")
(agenda . "nf-oct-calendar")
(projects . "nf-oct-rocket")
(registers . "nf-oct-database"))))
"Association list for the icons of the heading sections.
Will be of the form `(list-type . icon-name-string)`.
If nil it is disabled. Possible values for list-type are:
`recents' `bookmarks' `projects' `agenda' `registers'"
:type '(repeat (alist :key-type symbol :value-type string))
:group 'dashboard)
(defcustom dashboard-heading-icon-height 1.2
"The height of the heading icon."
:type 'float
:group 'dashboard)
(defcustom dashboard-heading-icon-v-adjust 0.0
"The v-adjust of the heading icon."
:type 'float
:group 'dashboard)
(defcustom dashboard-agenda-item-icon
(pcase dashboard-icon-type
('all-the-icons (all-the-icons-octicon "primitive-dot" :height 1.0 :v-adjust 0.01))
('nerd-icons (nerd-icons-octicon "nf-oct-dot_fill" :height 1.0 :v-adjust 0.01)))
"Agenda item icon."
:type 'string
:group 'dashboard)
(defcustom dashboard-remote-path-icon
(pcase dashboard-icon-type
('all-the-icons (all-the-icons-octicon "radio-tower" :height 1.0 :v-adjust 0.01))
('nerd-icons (nerd-icons-codicon "nf-cod-radio_tower" :height 1.0 :v-adjust 0.01)))
"Remote path icon."
:type 'string
:group 'dashboard)
(defcustom dashboard-show-shortcuts t
"Whether to show shortcut keys for each section."
:type 'boolean
@ -207,20 +276,66 @@ predicate value."
(boolean :tag "Predicate value"))
:group 'dashboard)
(defun dashboard-replace-displayable (str &optional rep)
"Replace non-displayable character from STR.
Optional argument REP is the replacement string of non-displayable character."
(if (stringp str)
(let ((rep (or rep ""))
(results (list)))
(dolist (string (split-string str ""))
(let* ((char (string-to-char string))
(string (if (char-displayable-p char)
string
rep)))
(push string results)))
(string-join (reverse results)))
""))
(defun dashboard-display-icons-p ()
"Assert whether to show icons based on the `dashboard-display-icons-p' variable."
(if (functionp dashboard-display-icons-p)
(funcall dashboard-display-icons-p)
dashboard-display-icons-p))
(defun dashboard-icon-for-dir (dir &rest args)
"Get the formatted icon for DIR.
ARGS should be a plist containing `:height', `:v-adjust',
or `:face' properties."
(dashboard-replace-displayable
(pcase dashboard-icon-type
('all-the-icons (apply #'all-the-icons-icon-for-dir dir args))
('nerd-icons (apply #'nerd-icons-icon-for-dir dir args)))))
(defun dashboard-icon-for-file (file &rest args)
"Get the formatted icon for FILE.
ARGS should be a plist containing `:height', `:v-adjust', or `:face' properties."
(dashboard-replace-displayable
(pcase dashboard-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 dashboard-octicon (name &rest args)
"Get the formatted octicon.
ARGS should be a plist containing `:height', `:v-adjust', or `:face' properties."
(dashboard-replace-displayable
(pcase dashboard-icon-type
('all-the-icons (apply #'all-the-icons-octicon name args))
('nerd-icons (apply #'nerd-icons-octicon name args)))))
(defcustom dashboard-footer-icon
(if (and (dashboard-display-icons-p)
(or (fboundp 'all-the-icons-fileicon)
(require 'all-the-icons nil 'noerror)))
(all-the-icons-fileicon "emacs"
:height 1.1
:v-adjust -0.05
:face 'font-lock-keyword-face)
(if (dashboard-display-icons-p)
(pcase dashboard-icon-type
('all-the-icons
(all-the-icons-fileicon "emacs"
:height 1.1
:v-adjust -0.05
:face 'font-lock-keyword-face))
('nerd-icons
(nerd-icons-sucicon "nf-custom-emacs"
:height 1.1
:v-adjust -0.05
:face 'font-lock-keyword-face)))
(propertize ">" 'face 'dashboard-footer))
"Footer's icon."
:type 'string
@ -309,19 +424,6 @@ Set to nil for unbounded."
:type 'integer
:group 'dashboard)
(defcustom dashboard-heading-icons
'((recents . "history")
(bookmarks . "bookmark")
(agenda . "calendar")
(projects . "rocket")
(registers . "database"))
"Association list for the icons of the heading sections.
Will be of the form `(list-type . icon-name-string)`.
If nil it is disabled. Possible values for list-type are:
`recents' `bookmarks' `projects' `agenda' `registers'"
:type '(repeat (alist :key-type symbol :value-type string))
:group 'dashboard)
(defcustom dashboard-path-style nil
"Style to display path."
:type '(choice
@ -478,31 +580,29 @@ If MESSAGEBUF is not nil then MSG is also written in message buffer."
(defun dashboard-insert-heading (heading &optional shortcut icon)
"Insert a widget HEADING in dashboard buffer, adding SHORTCUT, ICON if provided."
(when (and (dashboard-display-icons-p) dashboard-set-heading-icons)
;; Try loading `all-the-icons'
(unless (or (fboundp 'all-the-icons-octicon)
(require 'all-the-icons nil 'noerror))
(error "Package `all-the-icons' isn't installed"))
(insert (cond
((string-equal heading "Recent Files:")
(all-the-icons-octicon (cdr (assoc 'recents dashboard-heading-icons))
:height 1.2 :v-adjust 0.0 :face 'dashboard-heading))
((string-equal heading "Bookmarks:")
(all-the-icons-octicon (cdr (assoc 'bookmarks dashboard-heading-icons))
:height 1.2 :v-adjust 0.0 :face 'dashboard-heading))
((or (string-equal heading "Agenda for today:")
(string-equal heading "Agenda for the coming week:"))
(all-the-icons-octicon (cdr (assoc 'agenda dashboard-heading-icons))
:height 1.2 :v-adjust 0.0 :face 'dashboard-heading))
((string-equal heading "Registers:")
(all-the-icons-octicon (cdr (assoc 'registers dashboard-heading-icons))
:height 1.2 :v-adjust 0.0 :face 'dashboard-heading))
((string-equal heading "Projects:")
(all-the-icons-octicon (cdr (assoc 'projects dashboard-heading-icons))
:height 1.2 :v-adjust 0.0 :face 'dashboard-heading))
((not (null icon)) icon)
(t " ")))
(insert " "))
(let ((args `( :height ,dashboard-heading-icon-height
:v-adjust ,dashboard-heading-icon-v-adjust
:face dashboard-heading)))
(insert
(pcase heading
("Recent Files:"
(apply #'dashboard-octicon (cdr (assoc 'recents dashboard-heading-icons)) args))
("Bookmarks:"
(apply #'dashboard-octicon (cdr (assoc 'bookmarks dashboard-heading-icons)) args))
((or "Agenda for today:"
"Agenda for the coming week:")
(apply #'dashboard-octicon (cdr (assoc 'agenda dashboard-heading-icons)) args))
("Registers:"
(apply #'dashboard-octicon (cdr (assoc 'registers dashboard-heading-icons)) args))
("Projects:"
(apply #'dashboard-octicon (cdr (assoc 'projects dashboard-heading-icons)) args))
("List Directories:"
(apply #'dashboard-octicon (cdr (assoc 'ls-directories dashboard-heading-icons)) args))
("List Files:"
(apply #'dashboard-octicon (cdr (assoc 'ls-files dashboard-heading-icons)) args))
(_
(if (null icon) " " icon))))
(insert " ")))
(insert (propertize heading 'face 'dashboard-heading))
@ -749,21 +849,19 @@ to widget creation."
(insert "\n ")
(when (and (dashboard-display-icons-p)
dashboard-set-file-icons
(or (fboundp 'all-the-icons-icon-for-dir)
(require 'all-the-icons nil 'noerror)))
dashboard-set-file-icons)
(let* ((path (car (last (split-string ,@rest " - "))))
(icon (if (and (not (file-remote-p path))
(file-directory-p path))
(all-the-icons-icon-for-dir path nil "")
(dashboard-icon-for-dir path nil "")
(cond
((or (string-equal ,section-name "Agenda for today:")
(string-equal ,section-name "Agenda for the coming week:"))
(all-the-icons-octicon "primitive-dot" :height 1.0 :v-adjust 0.01))
dashboard-agenda-item-icon)
((file-remote-p path)
(all-the-icons-octicon "radio-tower" :height 1.0 :v-adjust 0.01))
(t (all-the-icons-icon-for-file (file-name-nondirectory path)
:v-adjust -0.05))))))
dashboard-remote-path-icon)
(t (dashboard-icon-for-file (file-name-nondirectory path)
:v-adjust -0.05))))))
(setq tag (concat icon " " ,@rest))))
(widget-create 'item
@ -786,8 +884,11 @@ to widget creation."
(when-let ((footer (and dashboard-set-footer (dashboard-random-footer))))
(insert "\n")
(dashboard-insert-center
dashboard-footer-icon
" "
(dashboard-replace-displayable dashboard-footer-icon)
(if (and (stringp dashboard-footer-icon)
(not (string-empty-p dashboard-footer-icon)))
" "
"")
(propertize footer 'face 'dashboard-footer)
"\n")))

15
org/elpa/dashboard-20230331.2304/dashboard.el → org/elpa/dashboard-20230726.2018/dashboard.el
View File

@ -12,7 +12,7 @@
;;; License: GPLv3
;;
;; Created: October 05, 2016
;; Package-Version: 1.8.0-SNAPSHOT
;; Package-Version: 1.9.0-SNAPSHOT
;; Keywords: startup, screen, tools, dashboard
;; Package-Requires: ((emacs "26.1"))
;;; Commentary:
@ -453,12 +453,25 @@ Optional argument ARGS adviced function arguments."
(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)))

2
org/elpa/devdocs-browser-20230112.1554/devdocs-browser-pkg.el
View File

@ -1,2 +0,0 @@
;;; Generated package description from devdocs-browser.el -*- no-byte-compile: t -*-
(define-package "devdocs-browser" "20230112.1554" "Browse devdocs.io documents using EWW" '((emacs "27.1")) :commit "c316c93306527fcb4069adde94402a48605d42d5" :authors '(("blahgeek" . "i@blahgeek.com")) :maintainer '("blahgeek" . "i@blahgeek.com") :keywords '("docs" "help" "tools") :url "https://github.com/blahgeek/emacs-devdocs-browser")

4
org/elpa/devdocs-browser-20230112.1554/devdocs-browser-autoloads.el → org/elpa/devdocs-browser-20230423.444/devdocs-browser-autoloads.el
View File

@ -59,6 +59,10 @@ 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:

14
org/elpa/devdocs-browser-20230423.444/devdocs-browser-pkg.el Normal file
View File

@ -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:

4
org/elpa/devdocs-browser-20230112.1554/devdocs-browser.el → org/elpa/devdocs-browser-20230423.444/devdocs-browser.el
View File

@ -4,8 +4,6 @@
;; Author: blahgeek <i@blahgeek.com>
;; URL: https://github.com/blahgeek/emacs-devdocs-browser
;; Package-Version: 20230112.1554
;; Package-Commit: c316c93306527fcb4069adde94402a48605d42d5
;; Version: 20210525
;; Keywords: docs, help, tools
;; Package-Requires: ((emacs "27.1"))
@ -321,6 +319,8 @@ Can be used as `imenu-create-index-function'."
(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)

1475
org/elpa/doom-modeline-20230219.1605/doom-modeline-core.el
View File

File diff suppressed because it is too large Load Diff

3027
org/elpa/doom-modeline-20230219.1605/doom-modeline-segments.el
View File

File diff suppressed because it is too large Load Diff

249
org/elpa/doom-modeline-20230219.1605/doom-modeline.el
View File

@ -1,249 +0,0 @@
;;; doom-modeline.el --- A minimal and modern mode-line -*- lexical-binding: t; -*-
;; Copyright (C) 2018-2020 Vincent Zhang
;; Author: Vincent Zhang <seagle0128@gmail.com>
;; Homepage: https://github.com/seagle0128/doom-modeline
;; Version: 3.3.3
;; Package-Requires: ((emacs "25.1") (compat "28.1.1.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

91
org/elpa/doom-modeline-20230406.623/doom-modeline-autoloads.el
View File

@ -1,91 +0,0 @@
;;; 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

276
org/elpa/doom-modeline-20230406.623/doom-modeline-env.el
View File

@ -1,276 +0,0 @@
;;; doom-modeline-env.el --- A environment parser for doom-modeline -*- lexical-binding: t -*-
;; Copyright (C) 2019-2020 Justin Barclay, Vincent Zhang
;; 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

14
org/elpa/doom-modeline-20230406.623/doom-modeline-pkg.el
View File

@ -1,14 +0,0 @@
(define-package "doom-modeline" "20230406.623" "A minimal and modern mode-line"
'((emacs "25.1")
(compat "28.1.1.1")
(shrink-path "0.2.0"))
:commit "a86ec8effe242cab8aba09ec0a2c7fed555c1fce" :authors
'(("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:

0
org/elpa/doom-modeline-20230219.1605/doom-modeline-autoloads.el → org/elpa/doom-modeline-20230807.1218/doom-modeline-autoloads.el
View File

277
org/elpa/doom-modeline-20230406.623/doom-modeline-core.el → org/elpa/doom-modeline-20230807.1218/doom-modeline-core.el
View File

@ -1,6 +1,6 @@
;;; doom-modeline-core.el --- The core libraries for doom-modeline -*- lexical-binding: t; -*-
;; Copyright (C) 2018-2020 Vincent Zhang
;; Copyright (C) 2018-2023 Vincent Zhang
;; This file is not part of GNU Emacs.
@ -30,16 +30,87 @@
(require 'subr-x)
(require 'compat)
(require 'nerd-icons)
(require 'shrink-path)
(require 'all-the-icons nil t)
;;
;; Externals
;; Compatibility
;;
(declare-function all-the-icons--function-name "ext:all-the-icons")
;; Backport from 30
(unless (fboundp 'mode--line-format-right-align)
(defcustom mode-line-right-align-edge 'window
"Where function `mode-line-format-right-align' should align to.
Internally, that function uses `:align-to' in a display property,
so aligns to the left edge of the given area. See info node
`(elisp)Pixel Specification'.
Must be set to a symbol. Acceptable values are:
- `window': align to extreme right of window, regardless of margins
or fringes
- `right-fringe': align to right-fringe
- `right-margin': align to right-margin"
:type '(choice (const right-margin)
(const right-fringe)
(const window))
:group 'mode-line)
(defun doom-modeline-string-pixel-width (str)
"Return the width of STR in pixels."
(if (fboundp 'string-pixel-width)
(string-pixel-width str)
(* (string-width str) (window-font-width nil 'mode-line) 1.05)))
(defun mode--line-format-right-align ()
"Right-align all following mode-line constructs.
When the symbol `mode-line-format-right-align' appears in
`mode-line-format', return a string of one space, with a display
property to make it appear long enough to align anything after
that symbol to the right of the rendered mode line. Exactly how
far to the right is controlled by `mode-line-right-align-edge'.
It is important that the symbol `mode-line-format-right-align' be
included in `mode-line-format' (and not another similar construct
such as `(:eval (mode-line-format-right-align)'). This is because
the symbol `mode-line-format-right-align' is processed by
`format-mode-line' as a variable."
(let* ((rest (cdr (memq 'mode-line-format-right-align
mode-line-format)))
(rest-str (format-mode-line `("" ,@rest)))
(rest-width (progn
(add-face-text-property
0 (length rest-str) 'mode-line t rest-str)
(doom-modeline-string-pixel-width rest-str))))
(propertize " " 'display
;; The `right' spec doesn't work on TTY frames
;; when windows are split horizontally (bug#59620)
(if (and (display-graphic-p)
(not (eq mode-line-right-align-edge 'window)))
`(space :align-to (- ,mode-line-right-align-edge
(,rest-width)))
`(space :align-to (,(- (window-pixel-width)
(window-scroll-bar-width)
(window-right-divider-width)
(* (or (cdr (window-margins)) 1)
(frame-char-width))
;; Manually account for value of
;; `mode-line-right-align-edge' even
;; when display is non-graphical
(pcase mode-line-right-align-edge
('right-margin
(or (cdr (window-margins)) 0))
('right-fringe
;; what here?
(or (cadr (window-fringes)) 0))
(_ 0))
rest-width)))))))
(defvar mode-line-format-right-align '(:eval (mode--line-format-right-align))
"Mode line construct to right align all following constructs.")
;;;###autoload
(put 'mode-line-format-right-align 'risky-local-variable t))
;;
@ -50,30 +121,6 @@
(when (eq system-type 'windows-nt)
(setq inhibit-compacting-font-caches t))
;; For better performance, because `window-font-width' consumes a lot.
(defvar doom-modeline--font-width-cache nil)
(defun doom-modeline--font-width ()
"Cache the font width for better performance."
(if (display-graphic-p)
(let ((attributes (face-all-attributes 'mode-line)))
(or (cdr (assoc attributes doom-modeline--font-width-cache))
(let ((width (window-font-width nil 'mode-line)))
(push (cons attributes width) doom-modeline--font-width-cache)
width)))
1))
;; Refresh the font width after setting frame parameters
;; to ensure the font width is correct.
(defun doom-modeline-refresh-font-width-cache (&rest _)
"Refresh the font width cache."
(setq doom-modeline--font-width-cache nil)
(doom-modeline--font-width))
(add-hook 'window-setup-hook #'doom-modeline-refresh-font-width-cache)
(add-hook 'after-make-frame-functions #'doom-modeline-refresh-font-width-cache)
(add-hook 'after-setting-font-hook #'doom-modeline-refresh-font-width-cache)
(add-hook 'server-after-make-frame-hook #'doom-modeline-refresh-font-width-cache)
;;
;; Customization
@ -97,7 +144,7 @@ Must be set before loading `doom-modeline'."
(remove-hook 'emacs-lisp-mode-hook #'doom-modeline-add-imenu)))
:group 'doom-modeline)
(defcustom doom-modeline-height 25
(defcustom doom-modeline-height (+ (frame-char-height) 4)
"How tall the mode-line should be. It's only respected in GUI.
If the actual char height is larger, it respects the actual char height."
:type 'integer
@ -180,6 +227,14 @@ Given ~/Projects/FOSS/emacs/lisp/comint.el
(const buffer-name))
:group'doom-modeline)
(defcustom doom-modeline-buffer-file-true-name nil
"Use `file-truename' on buffer file name.
Project detection(projectile.el) may uses `file-truename' on directory path.
Turn on this to provide right relative path for buffer file name."
:type 'boolean
:group'doom-modeline)
(defcustom doom-modeline-icon t
"Whether display the icons in the mode-line.
@ -197,7 +252,7 @@ It respects variable `doom-modeline-icon'."
(defcustom doom-modeline-major-mode-color-icon t
"Whether display the colorful icon for `major-mode'.
It respects `all-the-icons-color-icons'."
It respects `nerd-icons-color-icons'."
:type 'boolean
:group'doom-modeline)
@ -552,8 +607,7 @@ If nil, display only if the mode line is active."
:group 'doom-modeline)
(defcustom doom-modeline-always-visible-segments nil
"A list of segments that should be visible even in
inactive windows."
"A list of segments that should be visible even in inactive windows."
:type '(repeat symbol)
:group 'doom-modeline)
@ -604,7 +658,7 @@ inactive windows."
:group 'doom-modeline-faces)
(defface doom-modeline-buffer-minor-mode
'((t (:inherit (doom-modeline font-lock-doc-face) :slant normal)))
'((t (:inherit (doom-modeline font-lock-doc-face) :weight normal :slant normal)))
"Face used for the minor-modes segment in the mode-line."
:group 'doom-modeline-faces)
@ -635,32 +689,32 @@ This applies to `anzu', `evil-substitute', `iedit' etc."
:group 'doom-modeline-faces)
(defface doom-modeline-input-method
'((t (:inherit (doom-modeline-emphasis bold))))
'((t (:inherit (doom-modeline-emphasis))))
"Face for input method in the mode-line."
:group 'doom-modeline-faces)
(defface doom-modeline-input-method-alt
'((t (:inherit (doom-modeline font-lock-doc-face bold) :slant normal)))
'((t (:inherit (doom-modeline font-lock-doc-face) :slant normal)))
"Alternative face for input method in the mode-line."
:group 'doom-modeline-faces)
(defface doom-modeline-debug
'((t (:inherit (doom-modeline font-lock-doc-face bold) :slant normal)))
'((t (:inherit (doom-modeline font-lock-doc-face) :slant normal)))
"Face for debug-level messages in the mode-line. Used by vcs, checker, etc."
:group 'doom-modeline-faces)
(defface doom-modeline-info
'((t (:inherit (doom-modeline success bold))))
'((t (:inherit (doom-modeline success))))
"Face for info-level messages in the mode-line. Used by vcs, checker, etc."
:group 'doom-modeline-faces)
(defface doom-modeline-warning
'((t (:inherit (doom-modeline warning bold))))
'((t (:inherit (doom-modeline warning))))
"Face for warnings in the mode-line. Used by vcs, checker, etc."
:group 'doom-modeline-faces)
(defface doom-modeline-urgent
'((t (:inherit (doom-modeline error bold))))
'((t (:inherit (doom-modeline error))))
"Face for errors in the mode-line. Used by vcs, checker, etc."
:group 'doom-modeline-faces)
@ -671,7 +725,7 @@ Also see the face `doom-modeline-unread-number'."
:group 'doom-modeline-faces)
(defface doom-modeline-unread-number
'((t (:inherit doom-modeline :slant italic :weight normal)))
'((t (:inherit doom-modeline :slant italic)))
"Face for unread number in the mode-line. Used by GitHub, mu4e, etc."
:group 'doom-modeline-faces)
@ -681,7 +735,7 @@ Also see the face `doom-modeline-unread-number'."
:group 'doom-modeline-faces)
(defface doom-modeline-bar-inactive
`((t (:background ,(face-foreground 'mode-line-inactive))))
`((t (:inherit doom-modeline)))
"The face used for the left-most bar in the mode-line of an inactive window."
:group 'doom-modeline-faces)
@ -692,17 +746,17 @@ Also see the face `doom-modeline-unread-number'."
:group 'doom-modeline-faces)
(defface doom-modeline-evil-emacs-state
'((t (:inherit (doom-modeline font-lock-builtin-face bold))))
'((t (:inherit (doom-modeline font-lock-builtin-face))))
"Face for the Emacs state tag in evil indicator."
:group 'doom-modeline-faces)
(defface doom-modeline-evil-insert-state
'((t (:inherit (doom-modeline font-lock-keyword-face bold))))
'((t (:inherit (doom-modeline font-lock-keyword-face))))
"Face for the insert state tag in evil indicator."
:group 'doom-modeline-faces)
(defface doom-modeline-evil-motion-state
'((t (:inherit (doom-modeline font-lock-doc-face bold) :slant normal)))
'((t (:inherit (doom-modeline font-lock-doc-face) :slant normal)))
"Face for the motion state tag in evil indicator."
:group 'doom-modeline-faces)
@ -712,7 +766,7 @@ Also see the face `doom-modeline-unread-number'."
:group 'doom-modeline-faces)
(defface doom-modeline-evil-operator-state
'((t (:inherit doom-modeline-buffer-file)))
'((t (:inherit (doom-modeline mode-line))))
"Face for the operator state tag in evil indicator."
:group 'doom-modeline-faces)
@ -737,12 +791,12 @@ Also see the face `doom-modeline-unread-number'."
:group 'doom-modeline-faces)
(defface doom-modeline-ryo
'((t (:inherit doom-modeline-ryo)))
'((t (:inherit doom-modeline-info)))
"Face for RYO indicator."
:group 'doom-modeline-faces)
(defface doom-modeline-fly-insert-state
'((t (:inherit (font-lock-keyword-face bold))))
'((t (:inherit (doom-modeline font-lock-keyword-face))))
"Face for the insert state in xah-fly-keys indicator."
:group 'doom-modeline-faces)
@ -757,17 +811,17 @@ Also see the face `doom-modeline-unread-number'."
:group 'doom-modeline-faces)
(defface doom-modeline-boon-insert-state
'((t (:inherit (doom-modeline font-lock-keyword-face bold))))
'((t (:inherit (doom-modeline font-lock-keyword-face))))
"Face for the insert state tag in boon indicator."
:group 'doom-modeline-faces)
(defface doom-modeline-boon-special-state
'((t (:inherit (doom-modeline font-lock-builtin-face bold))))
'((t (:inherit (doom-modeline font-lock-builtin-face))))
"Face for the special state tag in boon indicator."
:group 'doom-modeline-faces)
(defface doom-modeline-boon-off-state
'((t (:inherit doom-modeline-buffer-file)))
'((t (:inherit (doom-modeline mode-line))))
"Face for the off state tag in boon indicator."
:group 'doom-modeline-faces)
@ -777,32 +831,32 @@ Also see the face `doom-modeline-unread-number'."
:group 'doom-modeline-faces)
(defface doom-modeline-persp-buffer-not-in-persp
'((t (:inherit (doom-modeline font-lock-doc-face bold italic))))
'((t (:inherit (doom-modeline font-lock-doc-face italic))))
"Face for the buffers which are not in the persp."
:group 'doom-modeline-faces)
(defface doom-modeline-repl-success
'((t (:inherit doom-modeline-info :weight normal)))
'((t (:inherit doom-modeline-info)))
"Face for REPL success state."
:group 'doom-modeline-faces)
(defface doom-modeline-repl-warning
'((t (:inherit doom-modeline-warning :weight normal)))
'((t (:inherit doom-modeline-warning)))
"Face for REPL warning state."
:group 'doom-modeline-faces)
(defface doom-modeline-lsp-success
'((t (:inherit doom-modeline-info :weight normal)))
'((t (:inherit doom-modeline-info)))
"Face for LSP success state."
:group 'doom-modeline-faces)
(defface doom-modeline-lsp-warning
'((t (:inherit doom-modeline-warning :weight normal)))
'((t (:inherit doom-modeline-warning)))
"Face for LSP warning state."
:group 'doom-modeline-faces)
(defface doom-modeline-lsp-error
'((t (:inherit doom-modeline-urgent :weight normal)))
'((t (:inherit doom-modeline-urgent)))
"Face for LSP error state."
:group 'doom-modeline-faces)
@ -812,32 +866,32 @@ Also see the face `doom-modeline-unread-number'."
:group 'doom-modeline-faces)
(defface doom-modeline-battery-charging
'((t (:inherit doom-modeline-info :weight normal)))
'((t (:inherit doom-modeline-info)))
"Face for battery charging status."
:group 'doom-modeline-faces)
(defface doom-modeline-battery-full
'((t (:inherit doom-modeline-info :weight normal)))
'((t (:inherit doom-modeline-info)))
"Face for battery full status."
:group 'doom-modeline-faces)
(defface doom-modeline-battery-normal
'((t (:inherit (doom-modeline mode-line) :weight normal)))
'((t (:inherit (doom-modeline mode-line))))
"Face for battery normal status."
:group 'doom-modeline-faces)
(defface doom-modeline-battery-warning
'((t (:inherit doom-modeline-warning :weight normal)))
'((t (:inherit doom-modeline-warning)))
"Face for battery warning status."
:group 'doom-modeline-faces)
(defface doom-modeline-battery-critical
'((t (:inherit doom-modeline-urgent :weight normal)))
'((t (:inherit doom-modeline-urgent)))
"Face for battery critical status."
:group 'doom-modeline-faces)
(defface doom-modeline-battery-error
'((t (:inherit doom-modeline-urgent :weight normal)))
'((t (:inherit doom-modeline-urgent)))
"Face for battery error status."
:group 'doom-modeline-faces)
@ -852,7 +906,7 @@ Also see the face `doom-modeline-unread-number'."
:group 'doom-modeline-faces)
(defface doom-modeline-compilation
'((t (:inherit doom-modeline-warning :weight normal :slant italic :height 0.9)))
'((t (:inherit doom-modeline-warning :slant italic :height 0.9)))
"Face for compilation progress."
:group 'doom-modeline-faces)
@ -905,8 +959,9 @@ Also see the face `doom-modeline-unread-number'."
;; FIXME #183: Force to calculate mode-line height
;; @see https://github.com/seagle0128/doom-modeline/issues/183
;; @see https://github.com/seagle0128/doom-modeline/issues/483
(defun doom-modeline-redisplay (&rest _)
"Call `redisplay' to trigger mode-line height calculations.
(unless (>= emacs-major-version 29)
(defun doom-modeline-redisplay (&rest _)
"Call `redisplay' to trigger mode-line height calculations.
Certain functions, including e.g. `fit-window-to-buffer', base
their size calculations on values which are incorrect if the
@ -923,18 +978,20 @@ but it will only trigger a redisplay when there is a non nil
`mode-line-format' and the height of the mode-line is different
from that of the `default' face. This function is intended to be
used as an advice to window creation functions."
(when (and (bound-and-true-p doom-modeline-mode)
mode-line-format
(/= (frame-char-height) (window-mode-line-height)))
(redisplay t)))
(unless (>= emacs-major-version 29)
(when (and (bound-and-true-p doom-modeline-mode)
mode-line-format
(/= (frame-char-height) (window-mode-line-height)))
(redisplay t)))
(advice-add #'fit-window-to-buffer :before #'doom-modeline-redisplay))
;; For `flychecker-color-mode-line'
(with-eval-after-load 'flychecker-color-mode-line
(defvar flycheck-color-mode-line-face-to-color)
(setq flycheck-color-mode-line-face-to-color 'doom-modeline))
(defun doom-modeline-icon-displayable-p ()
"Return non-nil if icons are displayable."
(and doom-modeline-icon
(display-graphic-p)
(featurep 'all-the-icons)))
(and doom-modeline-icon (featurep 'nerd-icons)))
(defun doom-modeline-mwheel-available-p ()
"Whether mouse wheel is available."
@ -959,11 +1016,11 @@ used as an advice to window creation functions."
(defvar-local doom-modeline--limited-width-p nil)
(defun doom-modeline--segment-visible (name)
"Whether a segment should be displayed"
(and
(or (doom-modeline--active)
(member name doom-modeline-always-visible-segments))
(not doom-modeline--limited-width-p)))
"Whether the segment NAME should be displayed."
(and
(or (doom-modeline--active)
(member name doom-modeline-always-visible-segments))
(not doom-modeline--limited-width-p)))
(defun doom-modeline-set-selected-window (&rest _)
"Set `doom-modeline-current-window' appropriately."
@ -1084,24 +1141,7 @@ Example:
(rhs-forms (doom-modeline--prepare-segments rhs)))
(defalias sym
(lambda ()
(list lhs-forms
(propertize
" "
'face (doom-modeline-face)
'display `(space
:align-to
(- (+ right right-fringe right-margin scroll-bar)
,(let ((rhs-str (format-mode-line (cons "" rhs-forms))))
(if (and (>= emacs-major-version 29)
(fboundp 'string-pixel-width))
(/ (string-pixel-width rhs-str)
(doom-modeline--font-width)
1.0)
(* (string-width rhs-str)
(if (display-graphic-p)
(/ (doom-modeline--font-width) (frame-char-width) 0.95)
1.0)))))))
rhs-forms))
`(,lhs-forms ,rhs-forms))
(concat "Modeline:\n"
(format " %s\n %s"
(prin1-to-string lhs)
@ -1113,7 +1153,10 @@ Example:
Throws an error if it doesn't exist."
(let ((fn (intern-soft (format "doom-modeline-format--%s" key))))
(when (functionp fn)
`(:eval (,fn)))))
(let* ((modeline (funcall fn))
(lhs (car modeline))
(rhs (cdr modeline)))
`(,lhs mode-line-format-right-align ,rhs)))))
(defun doom-modeline-set-modeline (key &optional default)
"Set the modeline format. Does nothing if the modeline KEY doesn't exist.
@ -1122,7 +1165,7 @@ If DEFAULT is non-nil, set the default mode-line for all buffers."
(setf (if default
(default-value 'mode-line-format)
mode-line-format)
(list "%e" modeline))))
modeline)))
;;
@ -1159,20 +1202,14 @@ If INACTIVE-FACE is nil, `mode-line-inactive' face will be used."
(and (facep inactive-face) inactive-face)
'mode-line-inactive)))
;; Since 27, the calculation of char height was changed
;; @see https://github.com/seagle0128/doom-modeline/issues/271
(defun doom-modeline--font-height ()
"Calculate the actual char height of the mode-line."
(let ((height (face-attribute 'mode-line :height))
(char-height (window-font-height nil 'mode-line)))
(round
(* (pcase system-type
('darwin (if doom-modeline-icon 1.7 1.0))
('windows-nt (if doom-modeline-icon 1.3 1.0))
(_ (if (and doom-modeline-icon (< emacs-major-version 27)) 1.4 1.0)))
(cond ((integerp height) (/ height 10))
((floatp height) (* height char-height))
(t char-height))))))
(* 1.0 (cond ((integerp height) (/ height 10))
((floatp height) (* height char-height))
(t char-height))))))
(defun doom-modeline--original-value (sym)
"Return the original value for SYM, if any.
@ -1211,10 +1248,10 @@ See https://github.com/seagle0128/doom-modeline/issues/301."
(defun doom-modeline-icon (icon-set icon-name unicode text &rest args)
"Display icon of ICON-NAME with ARGS in mode-line.
ICON-SET includes `octicon', `faicon', `material', `alltheicons' and `fileicon',
etc.
ICON-SET includes `ipsicon', `octicon', `pomicon', `powerline', `faicon',
`wicon', `sucicon', `devicon', `codicon', `flicon' and `mdicon', etc.
UNICODE is the unicode char fallback. TEXT is the ASCII char fallback.
ARGS is same as `all-the-icons-octicon' and others."
ARGS is same as `nerd-icons-octicon' and others."
(let ((face `(:inherit (doom-modeline
,(or (plist-get args :face) 'mode-line)))))
(cond
@ -1222,7 +1259,7 @@ ARGS is same as `all-the-icons-octicon' and others."
((and (doom-modeline-icon-displayable-p)
icon-name
(not (string-empty-p icon-name)))
(when-let* ((func (all-the-icons--function-name icon-set))
(when-let* ((func (nerd-icons--function-name icon-set))
(icon (and (fboundp func)
(apply func icon-name args))))
(doom-modeline-propertize-icon icon face)))
@ -1238,6 +1275,10 @@ ARGS is same as `all-the-icons-octicon' and others."
;; Fallback
(t ""))))
(defun doom-modeline-icon-for-buffer ()
"Get the formatted icon for the current buffer."
(nerd-icons-icon-for-buffer))
(defun doom-modeline-display-icon (icon)
"Display ICON in mode-line."
(if (doom-modeline--active)
@ -1254,8 +1295,7 @@ ARGS is same as `all-the-icons-octicon' and others."
"Create the bar image.
Use FACE for the bar, WIDTH and HEIGHT are the image size in pixels."
(when (and (display-graphic-p)
(image-type-available-p 'pbm)
(when (and (image-type-available-p 'pbm)
(numberp width) (> width 0)
(numberp height) (> height 0))
(propertize
@ -1421,12 +1461,12 @@ If INCLUDE-PROJECT is non-nil, the project path will be included."
'face 'doom-modeline-buffer-file))))))
(defun doom-modeline--buffer-file-name (file-path
_true-file-path
true-file-path
&optional
truncate-project-root-parent
truncate-project-relative-path
hide-project-root-parent)
"Propertize buffer name given by FILE-PATH.
"Propertize buffer name given by FILE-PATH or TRUE-FILE-PATH.
If TRUNCATE-PROJECT-ROOT-PARENT is non-nil will be saved by truncating project
root parent down fish-shell style.
@ -1464,7 +1504,10 @@ Example:
;; relative path
(propertize
(when-let (relative-path (file-relative-name
(or (file-name-directory file-path) "./")
(or (file-name-directory
(if doom-modeline-buffer-file-true-name
true-file-path file-path))
"./")
project-root))
(if (string= relative-path "./")
""

10
org/elpa/doom-modeline-20230219.1605/doom-modeline-env.el → org/elpa/doom-modeline-20230807.1218/doom-modeline-env.el
View File

@ -1,6 +1,6 @@
;;; doom-modeline-env.el --- A environment parser for doom-modeline -*- lexical-binding: t -*-
;; Copyright (C) 2019-2020 Justin Barclay, Vincent Zhang
;; Copyright (C) 2019-2023 Vincent Zhang, Justin Barclay
;; This file is not part of GNU Emacs.
@ -200,7 +200,7 @@ PARSER should be a function for parsing COMMAND's output line-by-line, to
;;;###autoload (autoload 'doom-modeline-env-setup-python "doom-modeline-env")
(doom-modeline-def-env python
:hooks 'python-mode-hook
:hooks '(python-mode-hook python-ts-mode-hook)
:command (lambda () (cond ((and (fboundp 'pipenv-project-p)
(pipenv-project-p))
(list "pipenv" "run"
@ -220,7 +220,7 @@ PARSER should be a function for parsing COMMAND's output line-by-line, to
;;;###autoload (autoload 'doom-modeline-env-setup-ruby "doom-modeline-env")
(doom-modeline-def-env ruby
:hooks '(ruby-mode-hook enh-ruby-mode-hook)
:hooks '(ruby-mode-hook ruby-ts-mode-hook enh-ruby-mode-hook)
:command (lambda () (list (or doom-modeline-env-ruby-executable "ruby") "--version"))
:parser (lambda (line)
(car (split-string
@ -244,7 +244,7 @@ PARSER should be a function for parsing COMMAND's output line-by-line, to
;;;###autoload (autoload 'doom-modeline-env-setup-go "doom-modeline-env")
(doom-modeline-def-env go
:hooks 'go-mode-hook
:hooks '(go-mode-hook go-ts-mode-hook)
:command (lambda () (list (or doom-modeline-env-go-executable "go") "version"))
:parser (lambda (line)
(cadr
@ -262,7 +262,7 @@ PARSER should be a function for parsing COMMAND's output line-by-line, to
;;;###autoload (autoload 'doom-modeline-env-setup-rust "doom-modeline-env")
(doom-modeline-def-env rust
:hooks 'rust-mode-hook
:hooks '(rust-mode-hook rust-ts-mode-hook)
:command (lambda () (list (or doom-modeline-env-rust-executable "rustc") "--version"))
:parser (lambda (line)
(car

7
org/elpa/doom-modeline-20230219.1605/doom-modeline-pkg.el → org/elpa/doom-modeline-20230807.1218/doom-modeline-pkg.el
View File

@ -1,8 +1,11 @@
(define-package "doom-modeline" "20230219.1605" "A minimal and modern mode-line"
(define-package "doom-modeline" "20230807.1218" "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 "6125309c2caa3c98591a4c802e9b4dd2f7ea83e9" :authors
:commit "de4af51c04237555ee3030502bdb57597cefb181" :authors
'(("Vincent Zhang" . "seagle0128@gmail.com"))
:maintainers
'(("Vincent Zhang" . "seagle0128@gmail.com"))
:maintainer
'("Vincent Zhang" . "seagle0128@gmail.com")

539
org/elpa/doom-modeline-20230406.623/doom-modeline-segments.el → org/elpa/doom-modeline-20230807.1218/doom-modeline-segments.el
View File

@ -1,6 +1,6 @@
;;; doom-modeline-segments.el --- The segments for doom-modeline -*- lexical-binding: t; -*-
;; Copyright (C) 2018-2020 Vincent Zhang
;; Copyright (C) 2018-2023 Vincent Zhang
;; This file is not part of GNU Emacs.
@ -57,6 +57,7 @@
(defvar boon-insert-state)
(defvar boon-off-state)
(defvar boon-special-state)
(defvar display-time-string)
(defvar edebug-execution-mode)
(defvar eglot--managed-mode)
(defvar erc-modified-channels-alist)
@ -84,8 +85,10 @@
(defvar minions-mode-line-minor-modes-map)
(defvar mlscroll-minimum-current-width)
(defvar mlscroll-right-align)
(defvar mu4e--modeline-item)
(defvar mu4e-alert-mode-line)
(defvar mu4e-alert-modeline-formatter)
(defvar mu4e-modeline-mode)
(defvar nyan-minimum-window-width)
(defvar objed--obj-state)
(defvar objed--object)
@ -104,9 +107,7 @@
(defvar tracking-buffers)
(defvar winum-auto-setup-mode-line)
(defvar xah-fly-insert-state-p)
(defvar display-time-string)
(declare-function all-the-icons-icon-for-buffer "ext:all-the-icons")
(declare-function anzu--reset-status "ext:anzu")
(declare-function anzu--where-is-here "ext:anzu")
(declare-function async-inject-variables "ext:async")
@ -203,6 +204,7 @@
(declare-function mc/num-cursors "ext:multiple-cursors-core")
(declare-function minions--prominent-modes "ext:minions")
(declare-function mlscroll-mode-line "ext:mlscroll")
(declare-function mu4e--modeline-string "ext:mu4e-modeline")
(declare-function mu4e-alert-default-mode-line-formatter "ext:mu4e-alert")
(declare-function mu4e-alert-enable-mode-line-display "ext:mu4e-alert")
(declare-function nyan-create "ext:nyan-mode")
@ -254,15 +256,12 @@
(setq doom-modeline--buffer-file-icon
(when (and doom-modeline-major-mode-icon
(doom-modeline-icon-displayable-p))
(let ((icon (all-the-icons-icon-for-buffer)))
(let ((icon (doom-modeline-icon-for-buffer)))
(propertize (if (or (null icon) (symbolp icon))
(doom-modeline-icon 'faicon "file-o" nil nil
:face 'all-the-icons-dsilver
:height 0.9
:v-adjust 0.0)
(doom-modeline-icon 'faicon "nf-fa-file_o" nil nil
:face 'nerd-icons-dsilver)
(doom-modeline-propertize-icon icon))
'help-echo (format "Major-mode: %s" (format-mode-line mode-name))
'display '(raise -0.135))))))
'help-echo (format "Major-mode: %s" (format-mode-line mode-name)))))))
(add-hook 'find-file-hook #'doom-modeline-update-buffer-file-icon)
(add-hook 'after-change-major-mode-hook #'doom-modeline-update-buffer-file-icon)
(add-hook 'clone-indirect-buffer-hook #'doom-modeline-update-buffer-file-icon)
@ -279,11 +278,8 @@
(defun doom-modeline-buffer-file-state-icon (icon unicode text face)
"Displays an ICON of buffer state with FACE.
UNICODE and TEXT are the alternatives if it is not applicable.
Uses `all-the-icons-material' to fetch the icon."
(doom-modeline-icon 'material icon unicode text
:face face
:height 1.1
:v-adjust -0.225))
Uses `nerd-icons-mdicon' to fetch the icon."
(doom-modeline-icon 'mdicon icon unicode text :face face))
(defvar-local doom-modeline--buffer-file-state-icon nil)
(defun doom-modeline-update-buffer-file-state-icon (&rest _)
@ -294,29 +290,28 @@ Uses `all-the-icons-material' to fetch the icon."
(concat
(cond (buffer-read-only
(doom-modeline-buffer-file-state-icon
"lock" "🔒" "%1*" `(:inherit doom-modeline-warning
:weight ,(if doom-modeline-icon
'normal
'bold))))
"nf-md-lock" "🔒" "%1*"
'doom-modeline-warning))
((and buffer-file-name (buffer-modified-p)
doom-modeline-buffer-modification-icon)
(doom-modeline-buffer-file-state-icon
"save" "💾" "%1*" `(:inherit doom-modeline-buffer-modified
:weight ,(if doom-modeline-icon
'normal
'bold))))
"nf-md-content_save_edit" "💾" "%1*"
'doom-modeline-warning))
((and buffer-file-name
(not (file-remote-p buffer-file-name)) ; Avoid freezing while connection is lost
;; Avoid freezing while connection is lost
(not (file-remote-p buffer-file-name))
(not (file-exists-p buffer-file-name)))
(doom-modeline-buffer-file-state-icon
"do_not_disturb_alt" "🚫" "!" 'doom-modeline-urgent))
"nf-md-cancel" "🚫" "!"
'doom-modeline-urgent))
(t ""))
(when (or (buffer-narrowed-p)
(and (bound-and-true-p fancy-narrow-mode)
(fancy-narrow-active-p))
(bound-and-true-p dired-narrow-mode))
(doom-modeline-buffer-file-state-icon
"vertical_align_center" "↕" "><" 'doom-modeline-warning)))))))
"nf-md-unfold_less_horizontal" "↕" "><"
'doom-modeline-warning)))))))
(defvar-local doom-modeline--buffer-file-name nil)
(defun doom-modeline-update-buffer-file-name (&rest _)
@ -439,8 +434,7 @@ read-only or non-existent)."
"Display calculator icons and info."
(concat
(doom-modeline-spc)
(when-let ((icon (doom-modeline-icon 'faicon "calculator" nil nil
:height 0.85 :v-adjust -0.05)))
(when-let ((icon (doom-modeline-icon 'faicon "nf-fa-calculator" "🖩" "")))
(concat
(doom-modeline-display-icon icon)
(doom-modeline-vspc)))
@ -455,14 +449,15 @@ project directory is important."
(if (and buffer-file-name (buffer-modified-p))
'doom-modeline-buffer-modified
'doom-modeline-buffer-path))))
(concat (doom-modeline-spc)
(and doom-modeline-major-mode-icon
(concat (doom-modeline-icon
'octicon "file-directory" "🖿" ""
:face face :v-adjust -0.05 :height 1.25)
(doom-modeline-vspc)))
(doom-modeline--buffer-state-icon)
(propertize (abbreviate-file-name default-directory) 'face face))))
(concat
(doom-modeline-spc)
(and doom-modeline-major-mode-icon
(concat
(doom-modeline-icon
'octicon "nf-oct-file_directory" "🖿" "" :face face)
(doom-modeline-vspc)))
(doom-modeline--buffer-state-icon)
(propertize (abbreviate-file-name default-directory) 'face face))))
(doom-modeline-def-segment buffer-default-directory-simple
"Displays `default-directory'.
@ -470,13 +465,14 @@ project directory is important."
This is for special buffers like the scratch buffer where knowing the current
project directory is important."
(let ((face (doom-modeline-face 'doom-modeline-buffer-path)))
(concat (doom-modeline-spc)
(and doom-modeline-major-mode-icon
(concat (doom-modeline-icon
'octicon "file-directory" "🖿" ""
:face face :v-adjust -0.05 :height 1.25)
(doom-modeline-vspc)))
(propertize (abbreviate-file-name default-directory) 'face face))))
(concat
(doom-modeline-spc)
(and doom-modeline-major-mode-icon
(concat
(doom-modeline-icon
'octicon "nf-oct-file_directory" "🖿" "" :face face)
(doom-modeline-vspc)))
(propertize (abbreviate-file-name default-directory) 'face face))))
;;
@ -631,9 +627,9 @@ project directory is important."
help-echo ,help-echo
local-map ,mode-line-minor-mode-keymap)
,(doom-modeline-spc)
(:propertize ("" ,(doom-modeline-icon 'octicon "gear" "⚙"
(:propertize ("" ,(doom-modeline-icon 'octicon "nf-oct-gear" "⚙"
minions-mode-line-lighter
:face face :v-adjust -0.05))
:face face))
mouse-face ,mouse-face
help-echo "Minions
mouse-1: Display minor modes menu"
@ -651,13 +647,12 @@ mouse-1: Display minor modes menu"
;; VCS
;;
(defun doom-modeline-vcs-icon (icon &optional unicode text face voffset)
(defun doom-modeline-vcs-icon (icon &optional unicode text face)
"Displays the vcs ICON with FACE and VOFFSET.
UNICODE and TEXT are fallbacks.
Uses `all-the-icons-octicon' to fetch the icon."
(doom-modeline-icon 'octicon icon unicode text
:face face :v-adjust (or voffset -0.1)))
Uses `nerd-icons-octicon' to fetch the icon."
(doom-modeline-icon 'devicon icon unicode text :face face))
(defvar-local doom-modeline--vcs-icon nil)
(defun doom-modeline-update-vcs-icon (&rest _)
@ -667,15 +662,15 @@ Uses `all-the-icons-octicon' to fetch the icon."
(let* ((backend (vc-backend buffer-file-name))
(state (vc-state buffer-file-name backend)))
(cond ((memq state '(edited added))
(doom-modeline-vcs-icon "git-compare" "🔃" "*" 'doom-modeline-info -0.05))
(doom-modeline-vcs-icon "nf-dev-git_compare" "🔃" "*" 'doom-modeline-info))
((eq state 'needs-merge)
(doom-modeline-vcs-icon "git-merge" "🔀" "?" 'doom-modeline-info))
(doom-modeline-vcs-icon "nf-dev-git_merge" "🔀" "?" 'doom-modeline-info))
((eq state 'needs-update)
(doom-modeline-vcs-icon "arrow-down" "⬇" "!" 'doom-modeline-warning))
(doom-modeline-vcs-icon "nf-dev-git_pull_request" "⬇" "!" 'doom-modeline-warning))
((memq state '(removed conflict unregistered))
(doom-modeline-vcs-icon "alert" "⚠" "!" 'doom-modeline-urgent))
(doom-modeline-icon 'octicon "nf-oct-alert" "⚠" "!" :face 'doom-modeline-urgent))
(t
(doom-modeline-vcs-icon "git-branch" "" "@" 'doom-modeline-info -0.05)))))))
(doom-modeline-vcs-icon "nf-dev-git_branch" "" "@" 'doom-modeline-info)))))))
(add-hook 'find-file-hook #'doom-modeline-update-vcs-icon)
(add-hook 'after-save-hook #'doom-modeline-update-vcs-icon)
(advice-add #'vc-refresh-state :after #'doom-modeline-update-vcs-icon)
@ -707,18 +702,19 @@ Uses `all-the-icons-octicon' to fetch the icon."
(state (vc-state buffer-file-name backend))
(str (if vc-display-status
(substring vc-mode (+ (if (eq backend 'Hg) 2 3) 2))
"")))
""))
(face (cond ((eq state 'needs-update)
'doom-modeline-warning)
((memq state '(removed conflict unregistered))
'doom-modeline-urgent)
(t 'doom-modeline-info))))
(propertize (if (length> str doom-modeline-vcs-max-length)
(concat
(substring str 0 (- doom-modeline-vcs-max-length 3))
doom-modeline-ellipsis)
str)
'mouse-face 'doom-modeline-highlight
'face (cond ((eq state 'needs-update)
'doom-modeline-warning)
((memq state '(removed conflict unregistered))
'doom-modeline-urgent)
(t 'doom-modeline-info)))))))
'face `(:inherit (,face bold)))))))
(add-hook 'find-file-hook #'doom-modeline-update-vcs-text)
(add-hook 'after-save-hook #'doom-modeline-update-vcs-text)
(advice-add #'vc-refresh-state :after #'doom-modeline-update-vcs-text)
@ -747,9 +743,8 @@ Uses `all-the-icons-octicon' to fetch the icon."
"Displays the checker ICON with FACE.
UNICODE and TEXT are fallbacks.
Uses `all-the-icons-material' to fetch the icon."
(doom-modeline-icon 'material icon unicode text
:face face :height 1.0 :v-adjust -0.225))
Uses `nerd-icons-mdicon' to fetch the icon."
(doom-modeline-icon 'mdicon icon unicode text :face face))
(defun doom-modeline-checker-text (text &optional face)
"Displays TEXT with FACE."
@ -784,16 +779,16 @@ level."
('finished (if flycheck-current-errors
(let-alist (doom-modeline--flycheck-count-errors)
(doom-modeline-checker-icon
"error_outline" "❗" "!"
"nf-md-alert_circle_outline" "❗" "!"
(cond ((> .error 0) 'doom-modeline-urgent)
((> .warning 0) 'doom-modeline-warning)
(t 'doom-modeline-info))))
(doom-modeline-checker-icon "check" "✔" "-" 'doom-modeline-info)))
('running (doom-modeline-checker-icon "hourglass_empty" "⏳" "*" 'doom-modeline-debug))
('no-checker (doom-modeline-checker-icon "sim_card_alert" "⚠" "-" 'doom-modeline-debug))
('errored (doom-modeline-checker-icon "sim_card_alert" "⚠" "-" 'doom-modeline-urgent))
('interrupted (doom-modeline-checker-icon "pause_circle_outline" "⏸" "=" 'doom-modeline-debug))
('suspicious (doom-modeline-checker-icon "info_outline" "❓" "?" 'doom-modeline-debug))
(doom-modeline-checker-icon "nf-md-check_circle_outline" "✔" "" 'doom-modeline-info)))
('running (doom-modeline-checker-icon "nf-md-timer_sand" "⏳" "*" 'doom-modeline-debug))
('no-checker (doom-modeline-checker-icon "nf-md-alert_box_outline" "⚠" "-" 'doom-modeline-debug))
('errored (doom-modeline-checker-icon "nf-md-alert_circle_outline" "⚠" "!" 'doom-modeline-urgent))
('interrupted (doom-modeline-checker-icon "nf-md-pause_circle_outline" "⦷" "." 'doom-modeline-debug))
('suspicious (doom-modeline-checker-icon "nf-md-information_outline" "❓" "?" 'doom-modeline-debug))
(_ nil))))
(propertize icon
'help-echo (concat "Flycheck\n"
@ -859,7 +854,8 @@ mouse-2: Show help for minor mode")
'doom-modeline-warning)
(doom-modeline-checker-text (number-to-string .info)
'doom-modeline-info))))))
;; ('running nil)
('running (and doom-modeline--flycheck-text
(propertize doom-modeline--flycheck-text 'face 'doom-modeline-debug)))
;; ('no-checker nil)
;; ('errored (doom-modeline-checker-text "Error" 'doom-modeline-urgent))
;; ('interrupted (doom-modeline-checker-text "Interrupted" 'doom-modeline-debug))
@ -875,8 +871,8 @@ mouse-2: Show help for minor mode")
(format "error: %d, warning: %d, info: %d\n" .error .warning .info)))
"mouse-1: Show all errors
mouse-3: Next error"
(if (doom-modeline-mwheel-available-p)
"\nwheel-up/wheel-down: Previous/next error")))
(when (doom-modeline-mwheel-available-p)
"\nwheel-up/wheel-down: Previous/next error")))
('running "Checking...")
('no-checker "No Checker")
('errored "Error")
@ -927,9 +923,9 @@ mouse-3: Next error"
(when-let
((icon
(cond
(some-waiting (doom-modeline-checker-icon "hourglass_empty" "⏳" "*" 'doom-modeline-urgent))
((null known) (doom-modeline-checker-icon "sim_card_alert" "⚠" "-" 'doom-modeline-debug))
(all-disabled (doom-modeline-checker-icon "sim_card_alert" "⚠" "-" 'doom-modeline-warning))
(some-waiting (doom-modeline-checker-icon "nf-md-timer_sand" "⏳" "*" 'doom-modeline-debug))
((null known) (doom-modeline-checker-icon "nf-md-alert_box_outline" "⚠" "!" 'doom-modeline-urgent))
(all-disabled (doom-modeline-checker-icon "nf-md-alert_outline" "⚠" "!" 'doom-modeline-warning))
(t (let ((.error 0)
(.warning 0)
(.note 0))
@ -947,11 +943,11 @@ mouse-3: Next error"
((> severity note-level) (cl-incf .warning))
(t (cl-incf .note))))))
(if (> (+ .error .warning .note) 0)
(doom-modeline-checker-icon "error_outline" "❗" "!"
(doom-modeline-checker-icon "nf-md-alert_circle_outline" "❗" "!"
(cond ((> .error 0) 'doom-modeline-urgent)
((> .warning 0) 'doom-modeline-warning)
(t 'doom-modeline-info)))
(doom-modeline-checker-icon "check" "✔" "-" 'doom-modeline-info))))))))
(doom-modeline-checker-icon "nf-md-check_circle_outline" "✔" "-" 'doom-modeline-info))))))))
(propertize
icon
'help-echo (concat "Flymake\n"
@ -1023,7 +1019,8 @@ mouse-2: Show help for minor mode"
(when-let
((text
(cond
(some-waiting doom-modeline--flymake-text)
(some-waiting (and doom-modeline--flymake-text
(propertize doom-modeline--flymake-text 'face 'doom-modeline-debug)))
((null known) nil)
(all-disabled nil)
(t (let ((num (+ .error .warning .note)))
@ -1102,8 +1099,8 @@ Displayed when in a major mode in `doom-modeline-continuous-word-count-modes'.
Respects `doom-modeline-enable-word-count'."
(when (and doom-modeline-enable-word-count
(member major-mode doom-modeline-continuous-word-count-modes))
(propertize (format " %dW" (count-words (point-min) (point-max)))
'face (doom-modeline-face))))
(propertize (format " %dW" (count-words (point-min) (point-max)))
'face (doom-modeline-face))))
;;
@ -1124,9 +1121,9 @@ block selection."
(eq evil-state 'visual)))
(doom-modeline--active))
(cl-destructuring-bind (beg . end)
(if (and (bound-and-true-p evil-local-mode) (eq evil-state 'visual))
(cons evil-visual-beginning evil-visual-end)
(cons (region-beginning) (region-end)))
(if (and (bound-and-true-p evil-local-mode) (eq evil-state 'visual))
(cons evil-visual-beginning evil-visual-end)
(cons (region-beginning) (region-end)))
(propertize
(let ((lines (count-lines beg (min end (point-max)))))
(concat (doom-modeline-spc)
@ -1162,16 +1159,14 @@ block selection."
'(:inherit (doom-modeline-panel variable-pitch)))))
(concat
sep
(doom-modeline-icon 'material "fiber_manual_record" "●"
(doom-modeline-icon 'mdicon "nf-md-record" "●"
(if (bound-and-true-p evil-this-macro)
(char-to-string evil-this-macro)
"Macro")
:face 'doom-modeline-panel
:v-adjust -0.225)
:face 'doom-modeline-panel)
vsep
(doom-modeline-icon 'octicon "triangle-right" "▶" ">"
:face 'doom-modeline-panel
:v-adjust -0.05)
(doom-modeline-icon 'octicon "nf-oct-triangle_right" "▶" ">"
:face 'doom-modeline-panel)
sep))))
;; `anzu' and `evil-anzu' expose current/total state that can be displayed in the
@ -1219,7 +1214,8 @@ Requires `anzu', also `evil-anzu' if using `evil-mode' for compatibility with
'face (doom-modeline-face 'doom-modeline-panel))))
(defsubst doom-modeline--evil-substitute ()
"Show number of matches for evil-ex substitutions and highlights in real time."
"Show number of matches for `evil-ex' in real time.
The number of matches contains substitutions and highlightings."
(when (and (bound-and-true-p evil-local-mode)
(or (assq 'evil-ex-substitute evil-ex-active-highlights-alist)
(assq 'evil-ex-global-match evil-ex-active-highlights-alist)
@ -1279,19 +1275,18 @@ Requires `anzu', also `evil-anzu' if using `evil-mode' for compatibility with
(defsubst doom-modeline--multiple-cursors ()
"Show the number of multiple cursors."
(cl-destructuring-bind (count . face)
(cond ((bound-and-true-p multiple-cursors-mode)
(cons (mc/num-cursors)
(doom-modeline-face 'doom-modeline-panel)))
((bound-and-true-p evil-mc-cursor-list)
(cons (length evil-mc-cursor-list)
(doom-modeline-face (if evil-mc-frozen
'doom-modeline-bar
'doom-modeline-panel))))
((cons nil nil)))
(cond ((bound-and-true-p multiple-cursors-mode)
(cons (mc/num-cursors)
(doom-modeline-face 'doom-modeline-panel)))
((bound-and-true-p evil-mc-cursor-list)
(cons (length evil-mc-cursor-list)
(doom-modeline-face (if evil-mc-frozen
'doom-modeline-bar
'doom-modeline-panel))))
((cons nil nil)))
(when count
(concat (propertize " " 'face face)
(or (doom-modeline-icon 'faicon "i-cursor" nil nil
:face face :v-adjust -0.0575)
(or (doom-modeline-icon 'faicon "nf-fa-i_cursor" "" "" :face face)
(propertize "I"
'face `(:inherit ,face :height 1.4 :weight normal)
'display '(raise -0.1)))
@ -1312,7 +1307,8 @@ Requires `anzu', also `evil-anzu' if using `evil-mode' for compatibility with
'face (doom-modeline-face 'doom-modeline-panel))))))
(defun doom-modeline--override-phi-search (orig-fun &rest args)
"Override the mode-line of `phi-search' and `phi-replace'."
"Override the mode-line of `phi-search' and `phi-replace'.
Apply ORIG-FUN with ARGS."
(if (bound-and-true-p doom-modeline-mode)
(apply orig-fun mode-line-format (cdr args))
(apply orig-fun args)))
@ -1362,8 +1358,8 @@ regions, 5. The current/total for the highlight term (with `symbol-overlay'),
;; TODO: Include other information
(cond ((eq major-mode 'image-mode)
(cl-destructuring-bind (width . height)
(when (fboundp 'image-size)
(image-size (image-get-display-property) :pixels))
(when (fboundp 'image-size)
(image-size (image-get-display-property) :pixels))
(format " %dx%d " width height)))))
@ -1549,7 +1545,8 @@ Requires `eyebrowse-mode' to be enabled or `tab-bar-mode' tabs to be created."
((name (cond
((and (bound-and-true-p eyebrowse-mode)
(length> (eyebrowse--get 'window-configs) 1))
(assq-delete-all 'eyebrowse-mode mode-line-misc-info)
(setq mode-line-misc-info
(assq-delete-all 'eyebrowse-mode mode-line-misc-info))
(when-let*
((num (eyebrowse--get 'current-slot))
(tag (nth 2 (assoc num (eyebrowse--get 'window-configs)))))
@ -1584,15 +1581,16 @@ Requires `eyebrowse-mode' to be enabled or `tab-bar-mode' tabs to be created."
(not (persp-contain-buffer-p (current-buffer) persp)))
'doom-modeline-persp-buffer-not-in-persp
'doom-modeline-persp-name))
(icon (doom-modeline-icon 'material "folder" "🖿" "#"
:face `(:inherit ,face :slant normal)
:height 1.1
:v-adjust -0.225)))
(icon (doom-modeline-icon 'octicon "nf-oct-repo" "🖿" "#"
:face `(:inherit ,face :slant normal))))
(when (or doom-modeline-display-default-persp-name
(not (string-equal persp-nil-name name)))
(concat (doom-modeline-spc)
(concat " "
(propertize (concat (and doom-modeline-persp-icon
(concat icon (doom-modeline-vspc)))
(concat icon
(propertize
" "
'display '((space :relative-width 0.5)))))
(propertize name 'face face))
'help-echo "mouse-1: Switch perspective
mouse-2: Show help for minor mode"
@ -1605,7 +1603,7 @@ mouse-2: Show help for minor mode"
(interactive)
(describe-function 'persp-mode)))
map))
(doom-modeline-spc)))))))
" "))))))
(add-hook 'buffer-list-update-hook #'doom-modeline-update-persp-name)
(add-hook 'find-file-hook #'doom-modeline-update-persp-name)
@ -1746,13 +1744,12 @@ mouse-1: Display Line and Column Mode Menu"
"Display the model icon with FACE and HELP-ECHO.
TEXT is alternative if icon is not available."
(propertize (doom-modeline-icon
'material
'mdicon
(when doom-modeline-modal-icon
(or icon "fiber_manual_record"))
(or icon "nf-md-record"))
(or unicode "●")
text
:face (doom-modeline-face face)
:v-adjust -0.225)
:face (doom-modeline-face face))
'help-echo help-echo))
(defsubst doom-modeline--evil ()
@ -1770,29 +1767,47 @@ TEXT is alternative if icon is not available."
((evil-operator-state-p) 'doom-modeline-evil-operator-state)
((evil-replace-state-p) 'doom-modeline-evil-replace-state)
(t 'doom-modeline-evil-normal-state))
(evil-state-property evil-state :name t))))
(evil-state-property evil-state :name t)
(cond
((evil-normal-state-p) "nf-md-alpha_n_circle")
((evil-emacs-state-p) "nf-md-alpha_e_circle")
((evil-insert-state-p) "nf-md-alpha_i_circle")
((evil-motion-state-p) "nf-md-alpha_m_circle")
((evil-visual-state-p) "nf-md-alpha_v_circle")
((evil-operator-state-p) "nf-md-alpha_o_circle")
((evil-replace-state-p) "nf-md-alpha_r_circle")
(t "nf-md-alpha_n_circle"))
(cond
((evil-normal-state-p) "🅝")
((evil-emacs-state-p) "🅔")
((evil-insert-state-p) "🅘")
((evil-motion-state-p) "🅜")
((evil-visual-state-p) "🅥")
((evil-operator-state-p) "🅞")
((evil-replace-state-p) "🅡")
(t "🅝")))))
(defsubst doom-modeline--overwrite ()
"The current overwrite state which is enabled by command `overwrite-mode'."
(when (and (bound-and-true-p overwrite-mode)
(not (bound-and-true-p evil-local-mode)))
(doom-modeline--modal-icon
"<O>" 'doom-modeline-overwrite "Overwrite mode"
"border_color" "🧷")))
"<W>" 'doom-modeline-overwrite "Overwrite mode"
"nf-md-note_edit" "🅦")))
(defsubst doom-modeline--god ()
"The current god state which is enabled by the command `god-mode'."
(when (bound-and-true-p god-local-mode)
(doom-modeline--modal-icon
"<G>" 'doom-modeline-god "God mode"
"account_circle" "🙇")))
"nf-md-account_circle" "🅖")))
(defsubst doom-modeline--ryo ()
"The current ryo-modal state which is enabled by the command `ryo-modal-mode'."
(when (bound-and-true-p ryo-modal-mode)
(doom-modeline--modal-icon
"<R>" 'doom-modeline-ryo "Ryo modal"
"add_circle" "✪")))
"nf-md-star_circle" "✪")))
(defsubst doom-modeline--xah-fly-keys ()
"The current `xah-fly-keys' state."
@ -1800,10 +1815,10 @@ TEXT is alternative if icon is not available."
(if xah-fly-insert-state-p
(doom-modeline--modal-icon
"<I>" 'doom-modeline-fly-insert-state "Xah-fly insert mode"
"flight" "🛧")
"nf-md-airplane_edit" "🛧")
(doom-modeline--modal-icon
"<C>" 'doom-modeline-fly-normal-state "Xah-fly command mode"
"flight" "🛧"))))
"nf-md-airplane_cog" "🛧"))))
(defsubst doom-modeline--boon ()
"The current Boon state. Requires `boon-mode' to be enabled."
@ -1817,7 +1832,7 @@ TEXT is alternative if icon is not available."
(boon-off-state 'doom-modeline-boon-off-state)
(t 'doom-modeline-boon-off-state))
(boon-modeline-string)
"local_cafe" "🍵")))
"nf-md-coffee" "🍵")))
(defsubst doom-modeline--meow ()
"The current Meow state. Requires `meow-mode' to be enabled."
@ -1946,8 +1961,7 @@ mouse-3: Describe current input method")
(defun doom-modeline-repl-icon (text face)
"Display REPL icon (or TEXT in terminal) with FACE."
(doom-modeline-icon 'faicon "terminal" "$" text
:face face :height 1.0 :v-adjust -0.0575))
(doom-modeline-icon 'faicon "nf-fa-terminal" "$" text :face face))
(defvar doom-modeline--cider nil)
@ -1995,8 +2009,7 @@ mouse-3: Describe current input method")
(defun doom-modeline-lsp-icon (text face)
"Display LSP icon (or TEXT in terminal) with FACE."
(doom-modeline-icon 'faicon "rocket" "🚀" text
:face face :height 1.0 :v-adjust -0.0575))
(doom-modeline-icon 'octicon "nf-oct-rocket" "🚀" text :face face))
(defvar-local doom-modeline--lsp nil)
(defun doom-modeline-update-lsp (&rest _)
@ -2189,11 +2202,14 @@ Example:
(with-timeout (10)
(ignore-errors
(when-let* ((username (ghub--username ghub-default-host))
(token (ghub--token ghub-default-host username 'ghub t)))
(ghub-get "/notifications" nil
:query '((notifications . "true"))
(token (or (ghub--token ghub-default-host username 'forge t)
(ghub--token ghub-default-host username 'ghub t))))
(ghub-get "/notifications"
'((all . t))
:host ghub-default-host
:username username
:auth token
:unpaginate t
:noerror t))))))
(lambda (result)
(message "") ; suppress message
@ -2223,21 +2239,19 @@ Example:
"The GitHub notifications."
(when (and doom-modeline-github
(doom-modeline--segment-visible 'github)
(numberp doom-modeline--github-notification-number)
(> doom-modeline--github-notification-number 0))
(numberp doom-modeline--github-notification-number))
(concat
(doom-modeline-spc)
(propertize
(concat
(doom-modeline-icon 'faicon "github" "🔔" "#"
:face 'doom-modeline-notification
:v-adjust -0.0575)
(doom-modeline-vspc)
;; GitHub API is paged, and the limit is 50
(doom-modeline-icon 'octicon "nf-oct-mark_github" "🔔" "&"
:face 'doom-modeline-notification)
(and (> doom-modeline--github-notification-number 0) (doom-modeline-vspc))
(propertize
(if (>= doom-modeline--github-notification-number 50)
"50+"
(number-to-string doom-modeline--github-notification-number))
(cond
((<= doom-modeline--github-notification-number 0) "")
((> doom-modeline--github-notification-number 99) "99+")
(t (number-to-string doom-modeline--github-notification-number)))
'face '(:inherit
(doom-modeline-unread-number doom-modeline-notification))))
'help-echo "Github Notifications
@ -2288,9 +2302,9 @@ mouse-3: Fetch notifications"
(add-hook 'dap-session-created-hook #'doom-modeline--debug-visual)
(add-hook 'dap-terminated-hook #'doom-modeline--normal-visual)
(defun doom-modeline-debug-icon (face &rest args)
(defun doom-modeline-debug-icon (face)
"Display debug icon with FACE and ARGS."
(doom-modeline-icon 'faicon "bug" "🐛" "!" :face face :v-adjust -0.0575 args))
(doom-modeline-icon 'codicon "nf-cod-debug" "🐛" "!" :face face))
(defun doom-modeline--debug-dap ()
"The current `dap-mode' state."
@ -2397,46 +2411,55 @@ mouse-1: Toggle Debug on Quit"
;;
;; `mu4e-alert' notifications
;; `mu4e' notifications
;;
(doom-modeline-def-segment mu4e
"Show notifications of any unread emails in `mu4e'."
(when (and doom-modeline-mu4e
(doom-modeline--segment-visible 'mu4e)
(bound-and-true-p mu4e-alert-mode-line)
(numberp mu4e-alert-mode-line)
;; don't display if the unread mails count is zero
(> mu4e-alert-mode-line 0))
(concat
(doom-modeline-spc)
(propertize
(concat
(doom-modeline-icon 'material "email" "📧" "#"
:face 'doom-modeline-notification
:height 1.1 :v-adjust -0.2)
(doom-modeline-vspc)
(propertize
(if (> mu4e-alert-mode-line doom-modeline-number-limit)
(format "%d+" doom-modeline-number-limit)
(number-to-string mu4e-alert-mode-line))
'face '(:inherit
(doom-modeline-unread-number doom-modeline-notification))))
'mouse-face 'doom-modeline-highlight
'keymap '(mode-line keymap
(mouse-1 . mu4e-alert-view-unread-mails)
(mouse-2 . mu4e-alert-view-unread-mails)
(mouse-3 . mu4e-alert-view-unread-mails))
'help-echo (concat (if (= mu4e-alert-mode-line 1)
"You have an unread email"
(format "You have %s unread emails" mu4e-alert-mode-line))
"\nClick here to view "
(if (= mu4e-alert-mode-line 1) "it" "them")))
(doom-modeline-spc))))
(doom-modeline--segment-visible 'mu4e))
(let ((icon (doom-modeline-icon 'mdicon "nf-md-email" "📧" "#"
:face 'doom-modeline-notification)))
(cond ((and (bound-and-true-p mu4e-alert-mode-line)
(numberp mu4e-alert-mode-line)
;; don't display if the unread mails count is zero
(> mu4e-alert-mode-line 0))
(concat
(doom-modeline-spc)
(propertize
(concat
icon
(doom-modeline-vspc)
(propertize
(if (> mu4e-alert-mode-line doom-modeline-number-limit)
(format "%d+" doom-modeline-number-limit)
(number-to-string mu4e-alert-mode-line))
'face '(:inherit
(doom-modeline-unread-number doom-modeline-notification))))
'mouse-face 'doom-modeline-highlight
'keymap '(mode-line keymap
(mouse-1 . mu4e-alert-view-unread-mails)
(mouse-2 . mu4e-alert-view-unread-mails)
(mouse-3 . mu4e-alert-view-unread-mails))
'help-echo (concat (if (= mu4e-alert-mode-line 1)
"You have an unread email"
(format "You have %s unread emails" mu4e-alert-mode-line))
"\nClick here to view "
(if (= mu4e-alert-mode-line 1) "it" "them")))
(doom-modeline-spc)))
((bound-and-true-p mu4e-modeline-mode)
(concat
(doom-modeline-spc)
icon
(doom-modeline-vspc)
(propertize (mu4e--modeline-string)
'face 'doom-modeline-notification)
(doom-modeline-spc)))))))
(defun doom-modeline-override-mu4e-alert (&rest _)
"Delete `mu4e-alert-mode-line' from global modeline string."
(when (featurep 'mu4e-alert)
(when (and (featurep 'mu4e-alert)
(bound-and-true-p mu4e-alert-mode-line))
(if (and doom-modeline-mu4e
(bound-and-true-p doom-modeline-mode))
;; Delete original modeline
@ -2450,12 +2473,26 @@ mouse-1: Toggle Debug on Quit"
:after #'doom-modeline-override-mu4e-alert)
(add-hook 'doom-modeline-mode-hook #'doom-modeline-override-mu4e-alert)
(defun doom-modeline-override-mu4e-modeline (&rest _)
"Delete `mu4e-alert-mode-line' from global modeline string."
(when (bound-and-true-p mu4e-modeline-mode)
(if (and doom-modeline-mu4e
(bound-and-true-p doom-modeline-mode))
;; Delete original modeline
(setq global-mode-string
(delete mu4e--modeline-item global-mode-string))
;; Recover default settings
(add-to-list 'global-mode-string mu4e--modeline-item))))
(add-hook 'mu4e-modeline-mode-hook #'doom-modeline-override-mu4e-modeline)
(add-hook 'doom-modeline-mode-hook #'doom-modeline-override-mu4e-modeline)
(doom-modeline-add-variable-watcher
'doom-modeline-mu4e
(lambda (_sym val op _where)
(when (eq op 'set)
(setq doom-modeline-mu4e val)
(doom-modeline-override-mu4e-alert))))
(doom-modeline-override-mu4e-alert)
(doom-modeline-override-mu4e-modeline))))
;;
@ -2517,9 +2554,8 @@ mouse-1: Toggle Debug on Quit"
(doom-modeline-spc)
(propertize
(concat
(doom-modeline-icon 'material "email" "📧" "#"
:face 'doom-modeline-notification
:height 1.1 :v-adjust -0.2)
(doom-modeline-icon 'mdicon "nf-md-email" "📧" "#"
:face 'doom-modeline-notification)
(doom-modeline-vspc)
(propertize
(if (> doom-modeline--gnus-unread-mail doom-modeline-number-limit)
@ -2622,9 +2658,8 @@ to be an icon and we don't want to remove that so we just return the original."
(doom-modeline-spc)
(propertize (concat
(doom-modeline-icon 'material "message" "🗊" "#"
:face 'doom-modeline-notification
:height 1.0 :v-adjust -0.225)
(doom-modeline-icon 'mdicon "nf-md-message_processing" "🗊" "#"
:face 'doom-modeline-notification)
(doom-modeline-vspc)
;; Display the number of unread buffers
(propertize (number-to-string number)
@ -2698,6 +2733,13 @@ mouse-3: Switch to next unread buffer")))
;; Battery status
;;
(defun doom-modeline-battery-icon (icon unicode text face)
"Displays the battery ICON with FACE.
UNICODE and TEXT are fallbacks.
Uses `nerd-icons-mdicon' to fetch the icon."
(doom-modeline-icon 'mdicon icon unicode text :face face))
(defvar doom-modeline--battery-status nil)
(defun doom-modeline-update-battery-status ()
"Update battery status."
@ -2707,7 +2749,9 @@ mouse-3: Switch to next unread buffer")))
(let* ((data (and battery-status-function
(functionp battery-status-function)
(funcall battery-status-function)))
(charging? (string-equal "AC" (cdr (assoc ?L data))))
(status (cdr (assoc ?L data)))
(charging? (or (string-equal "AC" status)
(string-equal "on-line" status)))
(percentage (car (read-from-string (or (cdr (assq ?p data)) "ERR"))))
(valid-percentage? (and (numberp percentage)
(>= percentage 0)
@ -2720,25 +2764,62 @@ mouse-3: Switch to next unread buffer")))
(t 'doom-modeline-battery-full))
'doom-modeline-battery-error))
(icon (if valid-percentage?
(cond (charging?
(doom-modeline-icon 'alltheicon "battery-charging" "🔋" "+"
:face face :height 1.4 :v-adjust -0.1))
((> percentage 95)
(doom-modeline-icon 'faicon "battery-full" "🔋" "-"
:face face :v-adjust -0.0575))
((> percentage 70)
(doom-modeline-icon 'faicon "battery-three-quarters" "🔋" "-"
:face face :v-adjust -0.0575))
((> percentage 40)
(doom-modeline-icon 'faicon "battery-half" "🔋" "-"
:face face :v-adjust -0.0575))
((> percentage battery-load-critical)
(doom-modeline-icon 'faicon "battery-quarter" "🔋" "-"
:face face :v-adjust -0.0575))
(t (doom-modeline-icon 'faicon "battery-empty" "🔋" "!"
:face face :v-adjust -0.0575)))
(doom-modeline-icon 'faicon "battery-empty" "⚠" "N/A"
:face face :v-adjust -0.0575)))
(cond
((>= percentage 100)
(doom-modeline-battery-icon (if charging?
"nf-md-battery_charging_100"
"nf-md-battery")
"🔋" "-" face))
((>= percentage 90)
(doom-modeline-battery-icon (if charging?
"nf-md-battery_charging_90"
"nf-md-battery_90")
"🔋" "-" face))
((>= percentage 80)
(doom-modeline-battery-icon (if charging?
"nf-md-battery_charging_80"
"nf-md-battery_80")
"🔋" "-" face))
((>= percentage 70)
(doom-modeline-battery-icon (if charging?
"nf-md-battery_charging_70"
"nf-md-battery_70")
"🔋" "-" face))
((>= percentage 60)
(doom-modeline-battery-icon (if charging?
"nf-md-battery_charging_60"
"nf-md-battery_60")
"🔋" "-" face))
((>= percentage 50)
(doom-modeline-battery-icon (if charging?
"nf-md-battery_charging_50"
"nf-md-battery_50")
"🔋" "-" face))
((>= percentage 40)
(doom-modeline-battery-icon (if charging?
"nf-md-battery_charging_40"
"nf-md-battery_40")
"🔋" "-" face))
((>= percentage 30)
(doom-modeline-battery-icon (if charging?
"nf-md-battery_charging_30"
"nf-md-battery_30")
"🔋" "-" face))
((>= percentage 20)
(doom-modeline-battery-icon (if charging?
"nf-md-battery_charging_20"
"nf-md-battery_20")
"🔋" "-" face))
((>= percentage 10)
(doom-modeline-battery-icon (if charging?
"nf-md-battery_charging_10"
"nf-md-battery_10")
"🪫" "-" face))
(t (doom-modeline-battery-icon (if charging?
"nf-md-battery_charging_outline"
"nf-md-battery_outline")
"🪫" "!" face)))
(doom-modeline-battery-icon "nf-md-battery_alert" "⚠" "N/A" face)))
(text (if valid-percentage? (format "%d%s" percentage "%%") ""))
(help-echo (if (and battery-echo-area-format data valid-percentage?)
(battery-format battery-echo-area-format data)
@ -2811,13 +2892,11 @@ mouse-3: Switch to next unread buffer")))
(when (and doom-modeline-icon doom-modeline-major-mode-icon)
(concat
(doom-modeline-spc)
(doom-modeline-icon 'faicon "archive" nil nil
(doom-modeline-icon 'faicon "nf-fa-archive" nil nil
:face (doom-modeline-face
(if doom-modeline-major-mode-color-icon
'all-the-icons-silver
'mode-line))
:height 1.0
:v-adjust -0.0575)))
'nerd-icons-silver
'mode-line)))))
(doom-modeline-display-text
(format-mode-line 'mode-line-buffer-identification))))
@ -2845,12 +2924,10 @@ The cdr can also be a function that returns a name to use.")
(doom-modeline-spc)
(when doom-modeline-icon
(concat
(doom-modeline-icon 'fileicon "elisp" nil nil
(doom-modeline-icon 'sucicon "nf-custom-emacs" nil nil
:face (doom-modeline-face
(and doom-modeline-major-mode-color-icon
'all-the-icons-blue))
:height 1.0
:v-adjust -0.15)
'nerd-icons-blue)))
(doom-modeline-spc)))
(propertize
(let ((custom (cdr (assoc (buffer-name) doom-modeline--helm-buffer-ids)))
@ -2931,29 +3008,26 @@ The cdr can also be a function that returns a name to use.")
(let ((face (doom-modeline-face
(if grip--process
(pcase (process-status grip--process)
('run 'doom-modeline-buffer-path)
('run 'doom-modeline-info)
('exit 'doom-modeline-warning)
(_ 'doom-modeline-urgent))
'doom-modeline-urgent))))
(propertize (doom-modeline-icon 'material "pageview" "🗐" "@"
:face (if doom-modeline-icon
`(:inherit ,face :weight normal)
face)
:height 1.2 :v-adjust -0.2)
'help-echo (format "Preview on %s
(propertize
(doom-modeline-icon 'codicon "nf-cod-open_preview" "🗐" "@" :face face)
'help-echo (format "Preview on %s
mouse-1: Preview in browser
mouse-2: Stop preview
mouse-3: Restart preview"
(grip--preview-url))
'mouse-face 'doom-modeline-highlight
'local-map (let ((map (make-sparse-keymap)))
(define-key map [mode-line mouse-1]
#'grip-browse-preview)
(define-key map [mode-line mouse-2]
#'grip-stop-preview)
(define-key map [mode-line mouse-3]
#'grip-restart-preview)
map)))
(grip--preview-url))
'mouse-face 'doom-modeline-highlight
'local-map (let ((map (make-sparse-keymap)))
(define-key map [mode-line mouse-1]
#'grip-browse-preview)
(define-key map [mode-line mouse-2]
#'grip-stop-preview)
(define-key map [mode-line mouse-3]
#'grip-restart-preview)
map)))
(doom-modeline-spc))))
;;
@ -2982,16 +3056,15 @@ mouse-3: Restart preview"
(doom-modeline-spc)
(when doom-modeline-time-icon
(concat
(doom-modeline-icon 'octicon "calendar" "📅" ""
:face 'doom-modeline-time
:v-adjust -0.05)
(doom-modeline-icon 'octicon "nf-oct-clock" "⏰" ""
:face '(:inherit doom-modeline-time :weight normal))
(and (or doom-modeline-icon doom-modeline-unicode-fallback)
(doom-modeline-spc))))
(propertize display-time-string
'face (doom-modeline-face 'doom-modeline-time)))))
(defun doom-modeline-override-time ()
"Override default display-time mode-line."
"Override default `display-time' mode-line."
(or global-mode-string (setq global-mode-string '("")))
(if (and doom-modeline-time
(bound-and-true-p doom-modeline-mode))

38
org/elpa/doom-modeline-20230406.623/doom-modeline.el → org/elpa/doom-modeline-20230807.1218/doom-modeline.el
View File

@ -1,11 +1,11 @@
;;; doom-modeline.el --- A minimal and modern mode-line -*- lexical-binding: t; -*-
;; Copyright (C) 2018-2020 Vincent Zhang
;; Copyright (C) 2018-2023 Vincent Zhang
;; Author: Vincent Zhang <seagle0128@gmail.com>
;; Homepage: https://github.com/seagle0128/doom-modeline
;; Version: 3.3.3
;; Package-Requires: ((emacs "25.1") (compat "28.1.1.1") (shrink-path "0.2.0"))
;; 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.
@ -129,7 +129,7 @@
(doom-modeline-def-modeline 'pdf
'(bar window-number matches buffer-info pdf-pages)
'(compilation misc-info major-mode process vcs time))
'(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)
@ -171,22 +171,22 @@ If DEFAULT is non-nil, set the default mode-line for all buffers."
(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)
'((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))
(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 ()

2
org/elpa/elisp-refs-20220704.2141/elisp-refs-pkg.el
View File

@ -1,2 +0,0 @@
;;; Generated package description from elisp-refs.el -*- no-byte-compile: t -*-
(define-package "elisp-refs" "20220704.2141" "find callers of elisp functions or macros" '((dash "2.12.0") (s "1.11.0")) :commit "af73739084637c8ebadad337a8fe58ff4f1d2ec1" :authors '(("Wilfred Hughes" . "me@wilfred.me.uk")) :maintainer '("Wilfred Hughes" . "me@wilfred.me.uk") :keywords '("lisp"))

4
org/elpa/elisp-refs-20220704.2141/elisp-refs-autoloads.el → org/elpa/elisp-refs-20230419.405/elisp-refs-autoloads.el
View File

@ -57,6 +57,10 @@ search.
(register-definition-prefixes "elisp-refs" '("elisp-"))
;;;***
;;;### (autoloads nil nil ("elisp-refs-pkg.el") (0 0 0 0))
;;;***
;; Local Variables:

14
org/elpa/elisp-refs-20230419.405/elisp-refs-pkg.el Normal file
View 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:

98
org/elpa/elisp-refs-20220704.2141/elisp-refs.el → org/elpa/elisp-refs-20230419.405/elisp-refs.el
View File

@ -3,9 +3,7 @@
;; Copyright (C) 2016-2020 Wilfred Hughes <me@wilfred.me.uk>
;; Author: Wilfred Hughes <me@wilfred.me.uk>
;; Version: 1.5
;; Package-Version: 20220704.2141
;; Package-Commit: af73739084637c8ebadad337a8fe58ff4f1d2ec1
;; Version: 1.6
;; Keywords: lisp
;; Package-Requires: ((dash "2.12.0") (s "1.11.0"))
@ -39,6 +37,10 @@
(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)
@ -67,7 +69,7 @@ in the current buffer."
between START-POS and END-POS (inclusive) in BUFFER.
Positions exclude quote characters, so given 'foo or `foo, we
report the position of the f.
report the position of the symbol foo.
Not recursive, so we don't consider subelements of nested sexps."
(let ((positions nil))
@ -89,18 +91,25 @@ Not recursive, so we don't consider subelements of nested sexps."
(scan-error nil)))
(nreverse positions)))
(defun elisp-refs--read-buffer-form ()
(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)
SYMBOL-POSITIONS are 0-indexed, relative to 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 (read (current-buffer)))
(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
(read-positioning-symbols (current-buffer))))
nil))
(end-pos (point))
(start-pos (elisp-refs--start-pos end-pos)))
(list form start-pos end-pos symbols read-start-pos)))
@ -109,14 +118,14 @@ SYMBOL-POSITIONS are 0-indexed, relative to READ-START-POS."
"A buffer-local variable used by `elisp-refs--contents-buffer'.
Internal implementation detail.")
(defun elisp-refs--read-all-buffer-forms (buffer)
(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) forms))
(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,
@ -130,12 +139,12 @@ Internal implementation detail.")
(defun elisp-refs--proper-list-p (val)
"Is VAL a proper list?"
(if (fboundp 'format-proper-list-p)
;; Emacs stable.
(with-no-warnings (format-proper-list-p val))
;; Function was renamed in Emacs master:
;; http://git.savannah.gnu.org/cgit/emacs.git/commit/?id=2fde6275b69fd113e78243790bf112bbdd2fe2bf
(with-no-warnings (proper-list-p val))))
(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
@ -171,7 +180,7 @@ START-POS and END-POS should be the position of FORM within BUFFER."
;; 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 form subforms-positions)
(--each (-zip-pair form subforms-positions)
(-let [(subform subform-start subform-end) it]
(when (or
(and (consp subform) (elisp-refs--proper-list-p subform))
@ -308,27 +317,52 @@ with its start and end position."
(-non-nil
(--mapcat
(-let [(form start-pos end-pos symbol-positions _read-start-pos) it]
;; Optimisation: don't bother walking a form if contains no
;; references to the symbol we're looking for.
(when (assq symbol symbol-positions)
;; 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))))
(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."
(-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))
(let* ((symbols-with-pos (fboundp 'symbol-with-pos-pos))
(forms (elisp-refs--read-all-buffer-forms buffer symbols-with-pos)))
(elisp-refs--read-all-buffer-forms buffer))))
(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."

0
org/elpa/f-20220911.711/f-autoloads.el → org/elpa/f-20230704.1346/f-autoloads.el
View File

6
org/elpa/f-20220911.711/f-pkg.el → org/elpa/f-20230704.1346/f-pkg.el
View File

@ -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")
(s "1.7.0")
(dash "2.2.0"))
:commit "d50dca48929575642912bb5bbb2585709ba38f82" :authors
:commit "19e1da061e759b05e8c480b426287a063ca39484" :authors
'(("Johan Andersson" . "johan.rejeep@gmail.com"))
:maintainers
'(("Lucien Cartier-Tilet" . "lucien@phundrak.com"))
:maintainer
'("Lucien Cartier-Tilet" . "lucien@phundrak.com")
:keywords

87
org/elpa/f-20220911.711/f-shortdoc.el → org/elpa/f-20230704.1346/f-shortdoc.el
View File

@ -29,7 +29,8 @@
;;; Code:
(when (version<= "28.1" emacs-version)
(require 'shortdoc)
(when (< emacs-major-version 29)
(require 'shortdoc))
(define-short-documentation-group f
"Paths"
@ -283,10 +284,16 @@
:result nil)
(f-hidden-p
:no-eval (f-hidden-p "/path/to/foo")
:result nil
:no-eval (f-hidden-p "/path/to/.foo")
:result t)
:eval (f-hidden-p "path/to/foo")
:eval (f-hidden-p ".path/to/foo")
:eval (f-hidden-p "path/.to/foo")
: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
:no-eval (f-empty-p "/path/to/empty-file")
@ -298,6 +305,30 @@
:no-eval (f-empty-p "/path/to/dir-with-contents/")
: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"
(f-size
:no-eval* (f-size "path/to/file.txt")
@ -309,16 +340,46 @@
:eval (f-depth "/usr/local/bin"))
(f-change-time
:no-eval* (f-change-time "path/to/file.txt")
:no-eval* (f-change-time "path/to/dir"))
:no-eval (f-change-time "path/to/file.txt")
: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
:no-eval* (f-modification-time "path/to/file.txt")
:no-eval* (f-modification-time "path/to/dir"))
:no-eval (f-modification-time "path/to/file.txt")
: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
:no-eval* (f-access-time "path/to/file.txt")
:no-eval* (f-access-time "path/to/dir"))
:no-eval (f-access-time "path/to/file.txt")
: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"
(f-this-file
@ -328,8 +389,8 @@
:eval (f-path-separator))
(f-glob
:noeval* (f-glob "path/to/*.el")
:noeval* (f-glob "*.el" "path/to"))
:no-eval* (f-glob "path/to/*.el")
:no-eval* (f-glob "*.el" "path/to"))
(f-entries
:no-eval* (f-entries "path/to/dir")

202
org/elpa/f-20220911.711/f.el → org/elpa/f-20230704.1346/f.el
View File

@ -28,6 +28,11 @@
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; 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:
@ -68,7 +73,7 @@ will discard all the preceeding arguments and make this absolute
path the new root of the generated path."
(let (path
(relative (f-relative-p (car args))))
(-map
(mapc
(lambda (arg)
(setq path (cond ((not path) arg)
((f-absolute-p arg)
@ -209,9 +214,9 @@ This function expects no duplicate paths."
(defun f-read-bytes (path &optional beg end)
"Read binary data from PATH.
Return the binary data as unibyte string. The optional second and
third arguments BEG and END specify what portion of the file to
read."
Return the binary data as unibyte string. The optional second
and third arguments BEG and END specify what portion of the file
to read."
(with-temp-buffer
(set-buffer-multibyte nil)
(setq buffer-file-coding-system 'binary)
@ -277,7 +282,7 @@ If APPEND is non-nil, append the DATA to the existing contents."
"Create directories DIRS.
DIRS should be a successive list of directories forming together
a full path. The easiest way to call this function with a fully
a full path. The easiest way to call this function with a fully
formed path is using `f-split' alongside it:
(apply #\\='f-mkdir (f-split \"path/to/file\"))
@ -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)
"Return t if PATH-A is desendant of PATH-B."
(unless (f-same-p path-a path-b)
(string-prefix-p (f-full path-b)
(f-full path-a))))
(let ((path-a (f-split (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)
(defun f-hidden-p (path)
"Return t if PATH is hidden, nil otherwise."
(unless (f-exists-p path)
(error "Path does not exist: %s" path))
(string= (substring path 0 1) "."))
(defun f-hidden-p (path &optional behavior)
"Return t if PATH is hidden, nil otherwise.
BEHAVIOR controls when a path should be considered as hidden
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)
@ -491,26 +529,142 @@ detect the depth.
'/' will be zero depth, '/usr' will be one depth. And so on."
(- (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.
The status change time (ctime) of PATH in the same format as
`current-time'. See `file-attributes' for technical details."
(nth 6 (file-attributes path)))
`current-time'. For details on TIMESTAMP-P and the format of the
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.
The modification time (mtime) of PATH in the same format as
`current-time'. See `file-attributes' for technical details."
(nth 5 (file-attributes path)))
`current-time'. For details on TIMESTAMP-P and the format of the
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.
The access time (atime) of PATH is in the same format as
`current-time'. See `file-attributes' for technical details."
(nth 4 (file-attributes path)))
`current-time'. For details on TIMESTAMP-P and the format of the
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
@ -544,7 +698,7 @@ The access time (atime) of PATH is in the same format as
(member (f-filename file) '("." "..")))
(directory-files path t))))
(cond (recursive
(-map
(mapc
(lambda (entry)
(if (f-file-p entry)
(setq result (cons entry result))

261
org/elpa/helm-20221107.1658/emacs-helm.sh
View File

@ -1,261 +0,0 @@
#!/usr/bin/env sh
## Copyright (C) 2012 ~ 2021 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
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
;;
-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)
(require 'helm-config)
(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 -Q -l "$CONF_FILE" "$@"

284
org/elpa/helm-20221107.1658/helm-adaptive.el
View File

@ -1,284 +0,0 @@
;;; helm-adaptive.el --- Adaptive Sorting of Candidates. -*- lexical-binding: t -*-
;; Original Author: Tamas Patrovics
;; Copyright (C) 2007 Tamas Patrovics
;; Copyright (C) 2012 ~ 2021 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
(cl-subseq (cdr selection-info) 0 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

1179
org/elpa/helm-20221107.1658/helm-autoloads.el
View File

File diff suppressed because it is too large Load Diff

809
org/elpa/helm-20221107.1658/helm-bookmark.el
View File

@ -1,809 +0,0 @@
;;; helm-bookmark.el --- Helm for Emacs regular Bookmarks. -*- lexical-binding: t -*-
;; Copyright (C) 2012 ~ 2021 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")
(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."
:type 'boolean)
(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-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 (candidate)
"Jump to bookmark action."
(let ((current-prefix-arg helm-current-prefix-arg)
non-essential)
(bookmark-jump candidate)))
(defun helm-bookmark-jump-other-frame (candidate)
"Jump to bookmark in other frame action."
(let ((current-prefix-arg helm-current-prefix-arg)
non-essential)
(bookmark-jump candidate 'switch-to-buffer-other-frame)))
(defun helm-bookmark-jump-other-window (candidate)
"Jump to bookmark in other window action."
(let (non-essential)
(bookmark-jump-other-window candidate)))
;;; 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))
(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
unless (memq action '(helm-bookmark-jump-other-frame
helm-bookmark-jump-other-window))
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)
(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 from keyboard."
'helm-bookmark-jump-other-window)
(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."
(cl-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)
(when helm-bookmark-use-icon
(require 'all-the-icons))
(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

1177
org/elpa/helm-20221107.1658/helm-buffers.el
View File

File diff suppressed because it is too large Load Diff

159
org/elpa/helm-20221107.1658/helm-color.el
View File

@ -1,159 +0,0 @@
;;; helm-color.el --- colors and faces -*- lexical-binding: t -*-
;; Copyright (C) 2012 ~ 2021 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
org/elpa/helm-20221107.1658/helm-comint.el
View File

@ -1,226 +0,0 @@
;;; 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
org/elpa/helm-20221107.1658/helm-command.el
View File

@ -1,413 +0,0 @@
;;; helm-command.el --- Helm execute-exended-command. -*- lexical-binding: t -*-
;; Copyright (C) 2012 ~ 2021 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

32
org/elpa/helm-20221107.1658/helm-config.el
View File

@ -1,32 +0,0 @@
;;; helm-config.el --- Applications library for `helm.el' -*- lexical-binding: t -*-
;; Copyright (C) 2012 ~ 2021 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:
;;
;; Requiring this file is not needed when using a package manager to
;; install helm as this one will take care of creating and loading the
;; autoload file.
;;; Code:
;;; Load the autoload file generated by the make file.
(load "helm-autoloads" nil t)
(provide 'helm-config)
;;; helm-config.el ends here

388
org/elpa/helm-20221107.1658/helm-dabbrev.el
View File

@ -1,388 +0,0 @@
;;; helm-dabbrev.el --- Helm implementation of dabbrev. -*- lexical-binding: t -*-
;; Copyright (C) 2012 ~ 2021 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

483
org/elpa/helm-20221107.1658/helm-elisp-package.el
View File

@ -1,483 +0,0 @@
;;; helm-elisp-package.el --- helm interface for package.el -*- lexical-binding: t -*-
;; Copyright (C) 2012 ~ 2021 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

1050
org/elpa/helm-20221107.1658/helm-elisp.el
View File

File diff suppressed because it is too large Load Diff

254
org/elpa/helm-20221107.1658/helm-epa.el
View File

@ -1,254 +0,0 @@
;;; helm-epa.el --- helm interface for epa/epg -*- lexical-binding: t; -*-
;; Copyright (C) 2012 ~ 2021 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
org/elpa/helm-20221107.1658/helm-eshell.el
View File

@ -1,494 +0,0 @@
;;; helm-eshell.el --- pcomplete and eshell completion for helm. -*- lexical-binding: t -*-
;; Copyright (C) 2012 ~ 2021 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
org/elpa/helm-20221107.1658/helm-eval.el
View File

@ -1,215 +0,0 @@
;;; helm-eval.el --- eval expressions from helm. -*- lexical-binding: t -*-
;; Copyright (C) 2012 ~ 2021 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

258
org/elpa/helm-20221107.1658/helm-external.el
View File

@ -1,258 +0,0 @@
;;; helm-external.el --- Run Externals commands within Emacs with helm completion. -*- lexical-binding: t -*-
;; Copyright (C) 2012 ~ 2021 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)
;;; 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)))
(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)
(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

138
org/elpa/helm-20221107.1658/helm-fd.el
View File

@ -1,138 +0,0 @@
;;; helm-fd.el --- helm interface for fd command line tool. -*- lexical-binding: t -*-
;; Copyright (C) 2012 ~ 2021 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 (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

Some files were not shown because too many files have changed in this diff Show More