Compare commits
No commits in common. "9aad3f21939fb39e60e587ef694d642553f2d7d3" and "ea7d9387e7831b5744f50c39af732ead21c2dd0a" have entirely different histories.
9aad3f2193
...
ea7d9387e7
|
|
@ -1,8 +1,6 @@
|
|||
(define-package "all-the-icons" "20230615.2016" "A library for inserting Developer icons"
|
||||
(define-package "all-the-icons" "20230316.1906" "A library for inserting Developer icons"
|
||||
'((emacs "24.3"))
|
||||
:commit "f491f39c21336d354e85bdb4cca281e0a0c2f880" :authors
|
||||
'(("Dominic Charlesworth" . "dgc336@gmail.com"))
|
||||
:maintainers
|
||||
:commit "d922aff57ac8308d3ed067f9151cc76d342855f2" :authors
|
||||
'(("Dominic Charlesworth" . "dgc336@gmail.com"))
|
||||
:maintainer
|
||||
'("Dominic Charlesworth" . "dgc336@gmail.com")
|
||||
|
|
@ -284,8 +284,6 @@
|
|||
("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)
|
||||
|
|
@ -412,7 +410,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)
|
||||
("pptx" all-the-icons-fileicon "powerpoint" :face all-the-icons-orange)
|
||||
("ppttx" 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)
|
||||
|
|
@ -611,7 +609,6 @@ 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)
|
||||
|
|
@ -1257,6 +1254,8 @@ 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")
|
||||
File diff suppressed because it is too large
Load diff
214
org/elpa/async-20230216.559/async-autoloads.el
Normal file
214
org/elpa/async-20230216.559/async-autoloads.el
Normal file
|
|
@ -0,0 +1,214 @@
|
|||
;;; 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
|
||||
|
|
@ -1,9 +1,7 @@
|
|||
(define-package "async" "20230528.622" "Asynchronous processing in Emacs"
|
||||
(define-package "async" "20230216.559" "Asynchronous processing in Emacs"
|
||||
'((emacs "24.4"))
|
||||
:commit "3ae74c0a4ba223ba373e0cb636c385e08d8838be" :authors
|
||||
:commit "71cc50f27ffc598a89aeaa593488d87818647d02" :authors
|
||||
'(("John Wiegley" . "jwiegley@gmail.com"))
|
||||
:maintainers
|
||||
'(("Thierry Volpiatto" . "thievol@posteo.net"))
|
||||
:maintainer
|
||||
'("Thierry Volpiatto" . "thievol@posteo.net")
|
||||
:keywords
|
||||
453
org/elpa/async-20230216.559/async.el
Normal file
453
org/elpa/async-20230216.559/async.el
Normal file
|
|
@ -0,0 +1,453 @@
|
|||
;;; 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
|
||||
|
|
@ -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 create-dir)
|
||||
async-quiet-switch)
|
||||
(let (to)
|
||||
(dolist (from fn-list)
|
||||
(setq to (funcall name-constructor from))
|
||||
|
|
@ -344,17 +344,7 @@ 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)))))))
|
||||
(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))))))
|
||||
(set-visited-file-name to t t))))))))
|
||||
;; Start async process.
|
||||
(when async-fn-list
|
||||
(process-put
|
||||
|
|
@ -363,8 +353,7 @@ 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-create-destination-dirs ',create-dir))
|
||||
,dired-copy-preserve-time))
|
||||
(setq overwrite-backup-query nil)
|
||||
;; Inline `backup-file' as long as it is not
|
||||
;; available in emacs.
|
||||
211
org/elpa/async-20230323.643/async-bytecomp.el
Normal file
211
org/elpa/async-20230323.643/async-bytecomp.el
Normal file
|
|
@ -0,0 +1,211 @@
|
|||
;;; 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
|
||||
12
org/elpa/async-20230323.643/async-pkg.el
Normal file
12
org/elpa/async-20230323.643/async-pkg.el
Normal file
|
|
@ -0,0 +1,12 @@
|
|||
(define-package "async" "20230323.643" "Asynchronous processing in Emacs"
|
||||
'((emacs "24.4"))
|
||||
:commit "34feabe1142863a2c96f75afda1a2ae4aa0813f6" :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:
|
||||
455
org/elpa/async-20230323.643/dired-async.el
Normal file
455
org/elpa/async-20230323.643/dired-async.el
Normal file
|
|
@ -0,0 +1,455 @@
|
|||
;;; 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
Normal file
71
org/elpa/async-20230323.643/smtpmail-async.el
Normal file
|
|
@ -0,0 +1,71 @@
|
|||
;;; 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
|
||||
|
|
@ -168,31 +168,10 @@ Default is 'hand. The following scopes are possible:
|
|||
;;; Icons
|
||||
;;
|
||||
(defcustom centaur-tabs-set-icons nil
|
||||
"When non nil, display an icon based on `centaur-tabs-icon-type' alongside the tab name."
|
||||
"When non nil, display an icon from all-the-icons 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.")
|
||||
|
|
@ -212,41 +191,19 @@ 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 icon for TAB using FACE's background.
|
||||
"Generate all-the-icons icon for TAB using FACE's background.
|
||||
If icon gray out option enabled, gray out icon if not SELECTED."
|
||||
(if centaur-tabs-icon-type
|
||||
(if (featurep 'all-the-icons)
|
||||
(with-current-buffer (car tab)
|
||||
(let* ((icon
|
||||
(if (and (buffer-file-name)
|
||||
(centaur-tabs--auto-mode-match?))
|
||||
(centaur-tabs--icon-for-file
|
||||
(all-the-icons-auto-mode-match?))
|
||||
(all-the-icons-icon-for-file
|
||||
(file-name-nondirectory (buffer-file-name))
|
||||
:v-adjust centaur-tabs-icon-v-adjust
|
||||
:height centaur-tabs-icon-scale-factor)
|
||||
(centaur-tabs--icon-for-mode
|
||||
(all-the-icons-icon-for-mode
|
||||
major-mode
|
||||
:v-adjust centaur-tabs-icon-v-adjust
|
||||
:height centaur-tabs-icon-scale-factor)))
|
||||
|
|
@ -36,10 +36,6 @@
|
|||
(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)
|
||||
|
|
@ -1,10 +1,8 @@
|
|||
(define-package "centaur-tabs" "20230607.1501" "Aesthetic, modern looking customizable tabs plugin"
|
||||
(define-package "centaur-tabs" "20230109.457" "Aesthetic, modern looking customizable tabs plugin"
|
||||
'((emacs "24.4")
|
||||
(powerline "2.4")
|
||||
(cl-lib "0.5"))
|
||||
:commit "0bb1aa18d475319df85f192dce3327802866c3c3" :authors
|
||||
'(("Emmanuel Bustos" . "ema2159@gmail.com"))
|
||||
:maintainers
|
||||
:commit "a2890d968d877b269a814a691356fc5877833c39" :authors
|
||||
'(("Emmanuel Bustos" . "ema2159@gmail.com"))
|
||||
:maintainer
|
||||
'("Emmanuel Bustos" . "ema2159@gmail.com")
|
||||
|
|
@ -1,8 +1,6 @@
|
|||
(define-package "dash" "20230714.723" "A modern list library for Emacs"
|
||||
(define-package "dash" "20221013.836" "A modern list library for Emacs"
|
||||
'((emacs "24"))
|
||||
:commit "f46268c75cb7c18361d3cee942cd4dc14a03aef4" :authors
|
||||
'(("Magnar Sveen" . "magnars@gmail.com"))
|
||||
:maintainers
|
||||
:commit "3df46d7d9fe74f52a661565888e4d31fd760f0df" :authors
|
||||
'(("Magnar Sveen" . "magnars@gmail.com"))
|
||||
:maintainer
|
||||
'("Magnar Sveen" . "magnars@gmail.com")
|
||||
3933
org/elpa/dash-20221013.836/dash.el
Normal file
3933
org/elpa/dash-20221013.836/dash.el
Normal file
File diff suppressed because it is too large
Load diff
4856
org/elpa/dash-20221013.836/dash.info
Normal file
4856
org/elpa/dash-20221013.836/dash.info
Normal file
File diff suppressed because it is too large
Load diff
87
org/elpa/dash-20230304.2223/dash-autoloads.el
Normal file
87
org/elpa/dash-20230304.2223/dash-autoloads.el
Normal file
|
|
@ -0,0 +1,87 @@
|
|||
;;; 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
Normal file
12
org/elpa/dash-20230304.2223/dash-pkg.el
Normal file
|
|
@ -0,0 +1,12 @@
|
|||
(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:
|
||||
|
|
@ -35,13 +35,13 @@
|
|||
(unless (fboundp 'gv-define-setter)
|
||||
(require 'cl))
|
||||
|
||||
;; - 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)))))
|
||||
;; 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)))))
|
||||
|
||||
(defgroup dash ()
|
||||
"Customize group for Dash, a modern list library."
|
||||
|
|
@ -223,7 +223,6 @@ 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)
|
||||
|
|
@ -259,7 +258,6 @@ 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)
|
||||
|
|
@ -291,7 +289,6 @@ 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)))
|
||||
|
|
@ -323,7 +320,6 @@ 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)
|
||||
|
|
@ -353,7 +349,6 @@ 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)))
|
||||
|
|
@ -379,7 +374,6 @@ 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)
|
||||
|
|
@ -406,7 +400,6 @@ 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))))
|
||||
|
|
@ -431,7 +424,6 @@ 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)
|
||||
|
|
@ -461,7 +453,6 @@ 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))))
|
||||
|
|
@ -486,7 +477,6 @@ 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)
|
||||
|
|
@ -509,7 +499,6 @@ 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)
|
||||
|
|
@ -545,7 +534,6 @@ 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.
|
||||
|
|
@ -571,7 +559,6 @@ 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)
|
||||
|
|
@ -602,12 +589,11 @@ 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 (side-effect-free t))
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(--filter it list))
|
||||
|
||||
(defmacro --map-indexed (form list)
|
||||
|
|
@ -632,7 +618,6 @@ 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)
|
||||
|
|
@ -651,7 +636,6 @@ 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)
|
||||
|
|
@ -663,7 +647,6 @@ 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)
|
||||
|
|
@ -685,7 +668,6 @@ 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)
|
||||
|
|
@ -730,7 +712,6 @@ 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)
|
||||
|
|
@ -754,7 +735,6 @@ 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)
|
||||
|
|
@ -836,14 +816,12 @@ 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)
|
||||
|
|
@ -856,7 +834,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 (side-effect-free t))
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(let* ((len (length args))
|
||||
(tail (nthcdr (- len 2) args))
|
||||
(last (cdr tail)))
|
||||
|
|
@ -871,7 +849,6 @@ 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)
|
||||
|
|
@ -897,7 +874,6 @@ 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)
|
||||
|
|
@ -921,7 +897,6 @@ 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)
|
||||
|
|
@ -955,7 +930,6 @@ 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)
|
||||
|
|
@ -969,7 +943,6 @@ 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
|
||||
|
|
@ -1060,7 +1033,6 @@ 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)
|
||||
|
|
@ -1077,7 +1049,6 @@ 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?)
|
||||
|
|
@ -1116,7 +1087,6 @@ 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?)
|
||||
|
|
@ -1135,7 +1105,6 @@ 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?)
|
||||
|
|
@ -1158,7 +1127,6 @@ 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?)
|
||||
|
|
@ -1172,7 +1140,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 (side-effect-free t))
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(let ((length (length list))
|
||||
(new-list nil))
|
||||
;; to defaults to the end of the list
|
||||
|
|
@ -1213,7 +1181,6 @@ 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)
|
||||
|
|
@ -1238,7 +1205,6 @@ 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)
|
||||
|
|
@ -1247,7 +1213,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 (side-effect-free t))
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(--take-while (< it-index n) list))
|
||||
|
||||
(defun -take-last (n list)
|
||||
|
|
@ -1256,7 +1222,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 (side-effect-free t))
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(copy-sequence (last list n)))
|
||||
|
||||
(defalias '-drop #'nthcdr
|
||||
|
|
@ -1273,7 +1239,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 (side-effect-free t))
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(nbutlast (copy-sequence list) n))
|
||||
|
||||
(defun -split-at (n list)
|
||||
|
|
@ -1283,7 +1249,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 (side-effect-free t))
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(let (result)
|
||||
(--each-while list (< it-index n)
|
||||
(push (pop list) result))
|
||||
|
|
@ -1322,7 +1288,6 @@ 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)))
|
||||
|
|
@ -1396,7 +1361,6 @@ 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)
|
||||
|
|
@ -1424,7 +1388,6 @@ 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)))
|
||||
|
|
@ -1451,7 +1414,6 @@ 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)
|
||||
|
|
@ -1524,7 +1486,6 @@ 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)
|
||||
|
|
@ -1563,7 +1524,6 @@ 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)
|
||||
|
|
@ -1590,24 +1550,20 @@ 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))
|
||||
|
||||
|
|
@ -1636,12 +1592,11 @@ 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 (side-effect-free t))
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(let (result)
|
||||
(when list
|
||||
(!cons (car list) result)
|
||||
|
|
@ -1653,7 +1608,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 (side-effect-free t))
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(when lists
|
||||
(let (result)
|
||||
(while (-none? 'null lists)
|
||||
|
|
@ -1692,7 +1647,6 @@ 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)
|
||||
|
|
@ -1890,7 +1844,6 @@ 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)
|
||||
|
|
@ -1919,7 +1872,6 @@ 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)))
|
||||
|
|
@ -1946,7 +1898,6 @@ 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)
|
||||
|
|
@ -1976,7 +1927,6 @@ 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)
|
||||
|
|
@ -2007,7 +1957,6 @@ 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)
|
||||
|
|
@ -2040,7 +1989,6 @@ 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)
|
||||
|
|
@ -2186,7 +2134,6 @@ 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)))
|
||||
|
|
@ -2195,7 +2142,6 @@ 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)))
|
||||
|
|
@ -2919,7 +2865,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 worthwhile.
|
||||
;; from the equality function, so it doesn't seem worthwile.
|
||||
(car (memq (or -compare-fn #'equal) '(equal eq eql))))
|
||||
|
||||
(defvar dash--short-list-length 32
|
||||
|
|
@ -2935,7 +2881,6 @@ 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
|
||||
|
|
@ -2965,7 +2910,6 @@ 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
|
||||
|
|
@ -2988,7 +2932,6 @@ 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
|
||||
|
|
@ -3010,7 +2953,6 @@ 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))
|
||||
|
|
@ -3036,7 +2978,6 @@ 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)
|
||||
|
|
@ -3052,7 +2993,6 @@ 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))
|
||||
|
|
@ -3172,7 +3112,6 @@ 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'.
|
||||
|
|
@ -3186,7 +3125,6 @@ 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
|
||||
|
|
@ -3194,9 +3132,8 @@ Duplicate elements of LIST are determined by `equal', or by
|
|||
res))
|
||||
|
||||
(defun -tails (list)
|
||||
"Return all suffixes of LIST."
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(-reductions-r-from #'cons nil list))
|
||||
"Return all suffixes of LIST"
|
||||
(-reductions-r-from 'cons nil list))
|
||||
|
||||
(defun -common-prefix (&rest lists)
|
||||
"Return the longest common prefix of LISTS."
|
||||
|
|
@ -3206,7 +3143,6 @@ 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)
|
||||
|
|
@ -3217,7 +3153,6 @@ 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?)
|
||||
|
|
@ -3231,7 +3166,6 @@ 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)
|
||||
|
|
@ -3297,7 +3231,6 @@ 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)
|
||||
|
|
@ -3321,7 +3254,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 (side-effect-free t))
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(and (>= n 0) (make-list n x)))
|
||||
|
||||
(defun -sum (list)
|
||||
|
|
@ -3364,7 +3297,6 @@ 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)
|
||||
|
|
@ -3373,7 +3305,6 @@ 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)
|
||||
|
|
@ -3396,7 +3327,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 (side-effect-free t))
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(unless (natnump count)
|
||||
(signal 'wrong-type-argument (list #'natnump count)))
|
||||
(or start (setq start 0))
|
||||
|
|
@ -3409,7 +3340,6 @@ 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)
|
||||
|
|
@ -3431,7 +3361,6 @@ 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)
|
||||
|
|
@ -3478,7 +3407,6 @@ 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))
|
||||
|
|
@ -3506,7 +3434,6 @@ 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))
|
||||
|
|
@ -3523,7 +3450,6 @@ 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))
|
||||
|
|
@ -3545,7 +3471,6 @@ 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)
|
||||
|
|
@ -3569,7 +3494,6 @@ 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)
|
||||
|
|
@ -3610,7 +3534,6 @@ 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))
|
||||
|
|
@ -3628,7 +3551,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 (side-effect-free t))
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(-tree-map #'identity list))
|
||||
|
||||
;;; Combinators
|
||||
|
|
@ -3818,7 +3741,6 @@ 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)
|
||||
|
|
@ -3830,7 +3752,6 @@ 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 _)
|
||||
|
|
@ -3868,7 +3789,6 @@ 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
|
||||
|
|
@ -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 (list (list 1))) (b (-clone a))) (setcar (car a) 2) b)
|
||||
⇒ ((1))
|
||||
(let* ((a '(1 2 3)) (b (-clone a))) (nreverse a) b)
|
||||
⇒ (1 2 3)
|
||||
|
||||
|
||||
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-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
|
||||
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
|
||||
|
||||
End Tag Table
|
||||
|
||||
18
org/elpa/dash-20230304.2223/dir
Normal file
18
org/elpa/dash-20230304.2223/dir
Normal file
|
|
@ -0,0 +1,18 @@
|
|||
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.
|
||||
|
Before Width: | Height: | Size: 43 KiB After Width: | Height: | Size: 43 KiB |
|
Before Width: | Height: | Size: 32 KiB After Width: | Height: | Size: 32 KiB |
|
|
@ -1,9 +1,7 @@
|
|||
(define-package "dashboard" "20230726.2018" "A startup screen extracted from Spacemacs"
|
||||
(define-package "dashboard" "20230220.1916" "A startup screen extracted from Spacemacs"
|
||||
'((emacs "26.1"))
|
||||
:commit "6480e0797b41c8ce1de4f37ba8016d177c22ab04" :authors
|
||||
:commit "221ee4b77db77199380c519c4ba52c06abc725e9" :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
|
||||
1366
org/elpa/dashboard-20230220.1916/dashboard-widgets.el
Normal file
1366
org/elpa/dashboard-20230220.1916/dashboard-widgets.el
Normal file
File diff suppressed because it is too large
Load diff
469
org/elpa/dashboard-20230220.1916/dashboard.el
Normal file
469
org/elpa/dashboard-20230220.1916/dashboard.el
Normal file
|
|
@ -0,0 +1,469 @@
|
|||
;;; 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
Normal file
8
org/elpa/dashboard-20230331.2304/banners/1.txt
Normal file
|
|
@ -0,0 +1,8 @@
|
|||
|
||||
######## ## ## ### ###### ######
|
||||
## ### ### ## ## ## ## ## ##
|
||||
## #### #### ## ## ## ##
|
||||
###### ## ### ## ## ## ## ######
|
||||
## ## ## ######### ## ##
|
||||
## ## ## ## ## ## ## ## ##
|
||||
######## ## ## ## ## ###### ######
|
||||
6
org/elpa/dashboard-20230331.2304/banners/2.txt
Normal file
6
org/elpa/dashboard-20230331.2304/banners/2.txt
Normal file
|
|
@ -0,0 +1,6 @@
|
|||
_______ .___ ___. ___ ______ _______.
|
||||
| ____|| \/ | / \ / | / |
|
||||
| |__ | \ / | / ^ \ | ,----' | (----`
|
||||
| __| | |\/| | / /_\ \ | | \ \
|
||||
| |____ | | | | / _____ \ | `----.----) |
|
||||
|_______||__| |__| /__/ \__\ \______|_______/
|
||||
8
org/elpa/dashboard-20230331.2304/banners/3.txt
Normal file
8
org/elpa/dashboard-20230331.2304/banners/3.txt
Normal file
|
|
@ -0,0 +1,8 @@
|
|||
_______ _____ ______ ________ ________ ________
|
||||
|\ ___ \ |\ _ \ _ \|\ __ \|\ ____\|\ ____\
|
||||
\ \ __/|\ \ \\\__\ \ \ \ \|\ \ \ \___|\ \ \___|_
|
||||
\ \ \_|/_\ \ \\|__| \ \ \ __ \ \ \ \ \_____ \
|
||||
\ \ \_|\ \ \ \ \ \ \ \ \ \ \ \ \____\|____|\ \
|
||||
\ \_______\ \__\ \ \__\ \__\ \__\ \_______\____\_\ \
|
||||
\|_______|\|__| \|__|\|__|\|__|\|_______|\_________\
|
||||
\|_________|
|
||||
17
org/elpa/dashboard-20230331.2304/banners/4.txt
Normal file
17
org/elpa/dashboard-20230331.2304/banners/4.txt
Normal file
|
|
@ -0,0 +1,17 @@
|
|||
_ ___ _ _
|
||||
_ ___ __ ___ __ _ ___
|
||||
__ _ ___ __ ___
|
||||
_ ___ _
|
||||
_ _ __ _
|
||||
___ __ _
|
||||
__ _
|
||||
_ _ _
|
||||
_ _ _
|
||||
_ _ _
|
||||
__ ___
|
||||
_ _ _ _
|
||||
_ _
|
||||
_ _
|
||||
_ _
|
||||
_
|
||||
__
|
||||
BIN
org/elpa/dashboard-20230331.2304/banners/emacs.png
Normal file
BIN
org/elpa/dashboard-20230331.2304/banners/emacs.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 43 KiB |
BIN
org/elpa/dashboard-20230331.2304/banners/logo.png
Normal file
BIN
org/elpa/dashboard-20230331.2304/banners/logo.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 32 KiB |
44
org/elpa/dashboard-20230331.2304/dashboard-autoloads.el
Normal file
44
org/elpa/dashboard-20230331.2304/dashboard-autoloads.el
Normal file
|
|
@ -0,0 +1,44 @@
|
|||
;;; dashboard-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*-
|
||||
;;
|
||||
;;; Code:
|
||||
|
||||
(add-to-list 'load-path (directory-file-name
|
||||
(or (file-name-directory #$) (car load-path))))
|
||||
|
||||
|
||||
;;;### (autoloads nil "dashboard" "dashboard.el" (0 0 0 0))
|
||||
;;; Generated autoloads from dashboard.el
|
||||
|
||||
(autoload 'dashboard-open "dashboard" "\
|
||||
Open (or refresh) the *dashboard* buffer.
|
||||
|
||||
\(fn &rest _)" t nil)
|
||||
|
||||
(autoload 'dashboard-setup-startup-hook "dashboard" "\
|
||||
Setup post initialization hooks.
|
||||
If a command line argument is provided, assume a filename and skip displaying
|
||||
Dashboard." nil nil)
|
||||
|
||||
(register-definition-prefixes "dashboard" '("dashboard-"))
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil "dashboard-widgets" "dashboard-widgets.el"
|
||||
;;;;;; (0 0 0 0))
|
||||
;;; Generated autoloads from dashboard-widgets.el
|
||||
|
||||
(register-definition-prefixes "dashboard-widgets" '("dashboard-" "org-time-less-p" "recentf-list"))
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil nil ("dashboard-pkg.el") (0 0 0 0))
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; coding: utf-8
|
||||
;; End:
|
||||
;;; dashboard-autoloads.el ends here
|
||||
12
org/elpa/dashboard-20230331.2304/dashboard-pkg.el
Normal file
12
org/elpa/dashboard-20230331.2304/dashboard-pkg.el
Normal file
|
|
@ -0,0 +1,12 @@
|
|||
(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:
|
||||
|
|
@ -12,7 +12,7 @@
|
|||
;;; License: GPLv3
|
||||
;;
|
||||
;; Created: October 05, 2016
|
||||
;; Package-Version: 1.9.0-SNAPSHOT
|
||||
;; Package-Version: 1.8.0-SNAPSHOT
|
||||
;; Keywords: startup, screen, tools, dashboard
|
||||
;; Package-Requires: ((emacs "26.1"))
|
||||
;;; Commentary:
|
||||
|
|
@ -31,11 +31,6 @@
|
|||
(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")
|
||||
|
|
@ -141,70 +136,6 @@ 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
|
||||
|
|
@ -276,66 +207,20 @@ 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 (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)))
|
||||
(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)
|
||||
(propertize ">" 'face 'dashboard-footer))
|
||||
"Footer's icon."
|
||||
:type 'string
|
||||
|
|
@ -424,6 +309,19 @@ 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
|
||||
|
|
@ -580,29 +478,31 @@ 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)
|
||||
(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 " ")))
|
||||
;; 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 " "))
|
||||
|
||||
(insert (propertize heading 'face 'dashboard-heading))
|
||||
|
||||
|
|
@ -849,19 +749,21 @@ to widget creation."
|
|||
(insert "\n ")
|
||||
|
||||
(when (and (dashboard-display-icons-p)
|
||||
dashboard-set-file-icons)
|
||||
dashboard-set-file-icons
|
||||
(or (fboundp 'all-the-icons-icon-for-dir)
|
||||
(require 'all-the-icons nil 'noerror)))
|
||||
(let* ((path (car (last (split-string ,@rest " - "))))
|
||||
(icon (if (and (not (file-remote-p path))
|
||||
(file-directory-p path))
|
||||
(dashboard-icon-for-dir path nil "")
|
||||
(all-the-icons-icon-for-dir path nil "")
|
||||
(cond
|
||||
((or (string-equal ,section-name "Agenda for today:")
|
||||
(string-equal ,section-name "Agenda for the coming week:"))
|
||||
dashboard-agenda-item-icon)
|
||||
(all-the-icons-octicon "primitive-dot" :height 1.0 :v-adjust 0.01))
|
||||
((file-remote-p path)
|
||||
dashboard-remote-path-icon)
|
||||
(t (dashboard-icon-for-file (file-name-nondirectory path)
|
||||
:v-adjust -0.05))))))
|
||||
(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))))))
|
||||
(setq tag (concat icon " " ,@rest))))
|
||||
|
||||
(widget-create 'item
|
||||
|
|
@ -884,11 +786,8 @@ to widget creation."
|
|||
(when-let ((footer (and dashboard-set-footer (dashboard-random-footer))))
|
||||
(insert "\n")
|
||||
(dashboard-insert-center
|
||||
(dashboard-replace-displayable dashboard-footer-icon)
|
||||
(if (and (stringp dashboard-footer-icon)
|
||||
(not (string-empty-p dashboard-footer-icon)))
|
||||
" "
|
||||
"")
|
||||
dashboard-footer-icon
|
||||
" "
|
||||
(propertize footer 'face 'dashboard-footer)
|
||||
"\n")))
|
||||
|
||||
|
|
@ -12,7 +12,7 @@
|
|||
;;; License: GPLv3
|
||||
;;
|
||||
;; Created: October 05, 2016
|
||||
;; Package-Version: 1.9.0-SNAPSHOT
|
||||
;; Package-Version: 1.8.0-SNAPSHOT
|
||||
;; Keywords: startup, screen, tools, dashboard
|
||||
;; Package-Requires: ((emacs "26.1"))
|
||||
;;; Commentary:
|
||||
|
|
@ -453,25 +453,12 @@ 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)))
|
||||
|
|
@ -59,10 +59,6 @@ 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:
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
;;; 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,6 +4,8 @@
|
|||
|
||||
;; 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"))
|
||||
|
|
@ -319,8 +321,6 @@ 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)
|
||||
|
|
@ -1,14 +0,0 @@
|
|||
(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:
|
||||
1475
org/elpa/doom-modeline-20230219.1605/doom-modeline-core.el
Normal file
1475
org/elpa/doom-modeline-20230219.1605/doom-modeline-core.el
Normal file
File diff suppressed because it is too large
Load diff
|
|
@ -1,6 +1,6 @@
|
|||
;;; doom-modeline-env.el --- A environment parser for doom-modeline -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2019-2023 Vincent Zhang, Justin Barclay
|
||||
;; Copyright (C) 2019-2020 Justin Barclay, Vincent Zhang
|
||||
|
||||
;; 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 python-ts-mode-hook)
|
||||
:hooks 'python-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 ruby-ts-mode-hook enh-ruby-mode-hook)
|
||||
: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
|
||||
|
|
@ -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 go-ts-mode-hook)
|
||||
:hooks 'go-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 rust-ts-mode-hook)
|
||||
:hooks 'rust-mode-hook
|
||||
:command (lambda () (list (or doom-modeline-env-rust-executable "rustc") "--version"))
|
||||
:parser (lambda (line)
|
||||
(car
|
||||
|
|
@ -1,11 +1,8 @@
|
|||
(define-package "doom-modeline" "20230807.1218" "A minimal and modern mode-line"
|
||||
(define-package "doom-modeline" "20230219.1605" "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 "de4af51c04237555ee3030502bdb57597cefb181" :authors
|
||||
'(("Vincent Zhang" . "seagle0128@gmail.com"))
|
||||
:maintainers
|
||||
:commit "6125309c2caa3c98591a4c802e9b4dd2f7ea83e9" :authors
|
||||
'(("Vincent Zhang" . "seagle0128@gmail.com"))
|
||||
:maintainer
|
||||
'("Vincent Zhang" . "seagle0128@gmail.com")
|
||||
3027
org/elpa/doom-modeline-20230219.1605/doom-modeline-segments.el
Normal file
3027
org/elpa/doom-modeline-20230219.1605/doom-modeline-segments.el
Normal file
File diff suppressed because it is too large
Load diff
|
|
@ -1,11 +1,11 @@
|
|||
;;; doom-modeline.el --- A minimal and modern mode-line -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2018-2023 Vincent Zhang
|
||||
;; Copyright (C) 2018-2020 Vincent Zhang
|
||||
|
||||
;; Author: Vincent Zhang <seagle0128@gmail.com>
|
||||
;; Homepage: https://github.com/seagle0128/doom-modeline
|
||||
;; Version: 4.0.0
|
||||
;; Package-Requires: ((emacs "25.1") (compat "28.1.1.1") (nerd-icons "0.0.1") (shrink-path "0.2.0"))
|
||||
;; 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.
|
||||
|
|
@ -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 ()
|
||||
|
|
@ -0,0 +1,91 @@
|
|||
;;; doom-modeline-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*-
|
||||
;;
|
||||
;;; Code:
|
||||
|
||||
(add-to-list 'load-path (directory-file-name
|
||||
(or (file-name-directory #$) (car load-path))))
|
||||
|
||||
|
||||
;;;### (autoloads nil "doom-modeline" "doom-modeline.el" (0 0 0 0))
|
||||
;;; Generated autoloads from doom-modeline.el
|
||||
|
||||
(autoload 'doom-modeline-set-main-modeline "doom-modeline" "\
|
||||
Set main mode-line.
|
||||
If DEFAULT is non-nil, set the default mode-line for all buffers.
|
||||
|
||||
\(fn &optional DEFAULT)" nil nil)
|
||||
|
||||
(defvar doom-modeline-mode nil "\
|
||||
Non-nil if Doom-Modeline mode is enabled.
|
||||
See the `doom-modeline-mode' command
|
||||
for a description of this minor mode.
|
||||
Setting this variable directly does not take effect;
|
||||
either customize it (see the info node `Easy Customization')
|
||||
or call the function `doom-modeline-mode'.")
|
||||
|
||||
(custom-autoload 'doom-modeline-mode "doom-modeline" nil)
|
||||
|
||||
(autoload 'doom-modeline-mode "doom-modeline" "\
|
||||
Toggle `doom-modeline' on or off.
|
||||
|
||||
This is a minor mode. If called interactively, toggle the
|
||||
`Doom-Modeline mode' mode. If the prefix argument is positive,
|
||||
enable the mode, and if it is zero or negative, disable the mode.
|
||||
|
||||
If called from Lisp, toggle the mode if ARG is `toggle'. Enable
|
||||
the mode if ARG is nil, omitted, or is a positive number.
|
||||
Disable the mode if ARG is a negative number.
|
||||
|
||||
To check whether the minor mode is enabled in the current buffer,
|
||||
evaluate `(default-value \\='doom-modeline-mode)'.
|
||||
|
||||
The mode's hook is called both when the mode is enabled and when
|
||||
it is disabled.
|
||||
|
||||
\(fn &optional ARG)" t nil)
|
||||
|
||||
(register-definition-prefixes "doom-modeline" '("doom-modeline-"))
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil "doom-modeline-core" "doom-modeline-core.el"
|
||||
;;;;;; (0 0 0 0))
|
||||
;;; Generated autoloads from doom-modeline-core.el
|
||||
|
||||
(register-definition-prefixes "doom-modeline-core" '("doom-modeline"))
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil "doom-modeline-env" "doom-modeline-env.el"
|
||||
;;;;;; (0 0 0 0))
|
||||
;;; Generated autoloads from doom-modeline-env.el
|
||||
(autoload 'doom-modeline-env-setup-python "doom-modeline-env")
|
||||
(autoload 'doom-modeline-env-setup-ruby "doom-modeline-env")
|
||||
(autoload 'doom-modeline-env-setup-perl "doom-modeline-env")
|
||||
(autoload 'doom-modeline-env-setup-go "doom-modeline-env")
|
||||
(autoload 'doom-modeline-env-setup-elixir "doom-modeline-env")
|
||||
(autoload 'doom-modeline-env-setup-rust "doom-modeline-env")
|
||||
|
||||
(register-definition-prefixes "doom-modeline-env" '("doom-modeline-"))
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil "doom-modeline-segments" "doom-modeline-segments.el"
|
||||
;;;;;; (0 0 0 0))
|
||||
;;; Generated autoloads from doom-modeline-segments.el
|
||||
|
||||
(register-definition-prefixes "doom-modeline-segments" '("doom-modeline-"))
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil nil ("doom-modeline-pkg.el") (0 0 0 0))
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; coding: utf-8
|
||||
;; End:
|
||||
;;; doom-modeline-autoloads.el ends here
|
||||
|
|
@ -1,6 +1,6 @@
|
|||
;;; doom-modeline-core.el --- The core libraries for doom-modeline -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2018-2023 Vincent Zhang
|
||||
;; Copyright (C) 2018-2020 Vincent Zhang
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
|
||||
|
|
@ -30,87 +30,16 @@
|
|||
(require 'subr-x)
|
||||
|
||||
(require 'compat)
|
||||
(require 'nerd-icons)
|
||||
(require 'shrink-path)
|
||||
|
||||
(require 'all-the-icons nil t)
|
||||
|
||||
|
||||
;;
|
||||
;; Compatibility
|
||||
;; Externals
|
||||
;;
|
||||
|
||||
;; 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))
|
||||
(declare-function all-the-icons--function-name "ext:all-the-icons")
|
||||
|
||||
|
||||
;;
|
||||
|
|
@ -121,6 +50,30 @@ the symbol `mode-line-format-right-align' is processed by
|
|||
(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
|
||||
|
|
@ -144,7 +97,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 (+ (frame-char-height) 4)
|
||||
(defcustom doom-modeline-height 25
|
||||
"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
|
||||
|
|
@ -227,14 +180,6 @@ 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.
|
||||
|
||||
|
|
@ -252,7 +197,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 `nerd-icons-color-icons'."
|
||||
It respects `all-the-icons-color-icons'."
|
||||
:type 'boolean
|
||||
:group'doom-modeline)
|
||||
|
||||
|
|
@ -607,7 +552,8 @@ 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)
|
||||
|
||||
|
|
@ -658,7 +604,7 @@ If nil, display only if the mode line is active."
|
|||
:group 'doom-modeline-faces)
|
||||
|
||||
(defface doom-modeline-buffer-minor-mode
|
||||
'((t (:inherit (doom-modeline font-lock-doc-face) :weight normal :slant normal)))
|
||||
'((t (:inherit (doom-modeline font-lock-doc-face) :slant normal)))
|
||||
"Face used for the minor-modes segment in the mode-line."
|
||||
:group 'doom-modeline-faces)
|
||||
|
||||
|
|
@ -689,32 +635,32 @@ This applies to `anzu', `evil-substitute', `iedit' etc."
|
|||
:group 'doom-modeline-faces)
|
||||
|
||||
(defface doom-modeline-input-method
|
||||
'((t (:inherit (doom-modeline-emphasis))))
|
||||
'((t (:inherit (doom-modeline-emphasis bold))))
|
||||
"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) :slant normal)))
|
||||
'((t (:inherit (doom-modeline font-lock-doc-face bold) :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) :slant normal)))
|
||||
'((t (:inherit (doom-modeline font-lock-doc-face bold) :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))))
|
||||
'((t (:inherit (doom-modeline success bold))))
|
||||
"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))))
|
||||
'((t (:inherit (doom-modeline warning bold))))
|
||||
"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))))
|
||||
'((t (:inherit (doom-modeline error bold))))
|
||||
"Face for errors in the mode-line. Used by vcs, checker, etc."
|
||||
:group 'doom-modeline-faces)
|
||||
|
||||
|
|
@ -725,7 +671,7 @@ Also see the face `doom-modeline-unread-number'."
|
|||
:group 'doom-modeline-faces)
|
||||
|
||||
(defface doom-modeline-unread-number
|
||||
'((t (:inherit doom-modeline :slant italic)))
|
||||
'((t (:inherit doom-modeline :slant italic :weight normal)))
|
||||
"Face for unread number in the mode-line. Used by GitHub, mu4e, etc."
|
||||
:group 'doom-modeline-faces)
|
||||
|
||||
|
|
@ -735,7 +681,7 @@ Also see the face `doom-modeline-unread-number'."
|
|||
:group 'doom-modeline-faces)
|
||||
|
||||
(defface doom-modeline-bar-inactive
|
||||
`((t (:inherit doom-modeline)))
|
||||
`((t (:background ,(face-foreground 'mode-line-inactive))))
|
||||
"The face used for the left-most bar in the mode-line of an inactive window."
|
||||
:group 'doom-modeline-faces)
|
||||
|
||||
|
|
@ -746,17 +692,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))))
|
||||
'((t (:inherit (doom-modeline font-lock-builtin-face bold))))
|
||||
"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))))
|
||||
'((t (:inherit (doom-modeline font-lock-keyword-face bold))))
|
||||
"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) :slant normal)))
|
||||
'((t (:inherit (doom-modeline font-lock-doc-face bold) :slant normal)))
|
||||
"Face for the motion state tag in evil indicator."
|
||||
:group 'doom-modeline-faces)
|
||||
|
||||
|
|
@ -766,7 +712,7 @@ Also see the face `doom-modeline-unread-number'."
|
|||
:group 'doom-modeline-faces)
|
||||
|
||||
(defface doom-modeline-evil-operator-state
|
||||
'((t (:inherit (doom-modeline mode-line))))
|
||||
'((t (:inherit doom-modeline-buffer-file)))
|
||||
"Face for the operator state tag in evil indicator."
|
||||
:group 'doom-modeline-faces)
|
||||
|
||||
|
|
@ -791,12 +737,12 @@ Also see the face `doom-modeline-unread-number'."
|
|||
:group 'doom-modeline-faces)
|
||||
|
||||
(defface doom-modeline-ryo
|
||||
'((t (:inherit doom-modeline-info)))
|
||||
'((t (:inherit doom-modeline-ryo)))
|
||||
"Face for RYO indicator."
|
||||
:group 'doom-modeline-faces)
|
||||
|
||||
(defface doom-modeline-fly-insert-state
|
||||
'((t (:inherit (doom-modeline font-lock-keyword-face))))
|
||||
'((t (:inherit (font-lock-keyword-face bold))))
|
||||
"Face for the insert state in xah-fly-keys indicator."
|
||||
:group 'doom-modeline-faces)
|
||||
|
||||
|
|
@ -811,17 +757,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))))
|
||||
'((t (:inherit (doom-modeline font-lock-keyword-face bold))))
|
||||
"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))))
|
||||
'((t (:inherit (doom-modeline font-lock-builtin-face bold))))
|
||||
"Face for the special state tag in boon indicator."
|
||||
:group 'doom-modeline-faces)
|
||||
|
||||
(defface doom-modeline-boon-off-state
|
||||
'((t (:inherit (doom-modeline mode-line))))
|
||||
'((t (:inherit doom-modeline-buffer-file)))
|
||||
"Face for the off state tag in boon indicator."
|
||||
:group 'doom-modeline-faces)
|
||||
|
||||
|
|
@ -831,32 +777,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 italic))))
|
||||
'((t (:inherit (doom-modeline font-lock-doc-face bold 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)))
|
||||
'((t (:inherit doom-modeline-info :weight normal)))
|
||||
"Face for REPL success state."
|
||||
:group 'doom-modeline-faces)
|
||||
|
||||
(defface doom-modeline-repl-warning
|
||||
'((t (:inherit doom-modeline-warning)))
|
||||
'((t (:inherit doom-modeline-warning :weight normal)))
|
||||
"Face for REPL warning state."
|
||||
:group 'doom-modeline-faces)
|
||||
|
||||
(defface doom-modeline-lsp-success
|
||||
'((t (:inherit doom-modeline-info)))
|
||||
'((t (:inherit doom-modeline-info :weight normal)))
|
||||
"Face for LSP success state."
|
||||
:group 'doom-modeline-faces)
|
||||
|
||||
(defface doom-modeline-lsp-warning
|
||||
'((t (:inherit doom-modeline-warning)))
|
||||
'((t (:inherit doom-modeline-warning :weight normal)))
|
||||
"Face for LSP warning state."
|
||||
:group 'doom-modeline-faces)
|
||||
|
||||
(defface doom-modeline-lsp-error
|
||||
'((t (:inherit doom-modeline-urgent)))
|
||||
'((t (:inherit doom-modeline-urgent :weight normal)))
|
||||
"Face for LSP error state."
|
||||
:group 'doom-modeline-faces)
|
||||
|
||||
|
|
@ -866,32 +812,32 @@ Also see the face `doom-modeline-unread-number'."
|
|||
:group 'doom-modeline-faces)
|
||||
|
||||
(defface doom-modeline-battery-charging
|
||||
'((t (:inherit doom-modeline-info)))
|
||||
'((t (:inherit doom-modeline-info :weight normal)))
|
||||
"Face for battery charging status."
|
||||
:group 'doom-modeline-faces)
|
||||
|
||||
(defface doom-modeline-battery-full
|
||||
'((t (:inherit doom-modeline-info)))
|
||||
'((t (:inherit doom-modeline-info :weight normal)))
|
||||
"Face for battery full status."
|
||||
:group 'doom-modeline-faces)
|
||||
|
||||
(defface doom-modeline-battery-normal
|
||||
'((t (:inherit (doom-modeline mode-line))))
|
||||
'((t (:inherit (doom-modeline mode-line) :weight normal)))
|
||||
"Face for battery normal status."
|
||||
:group 'doom-modeline-faces)
|
||||
|
||||
(defface doom-modeline-battery-warning
|
||||
'((t (:inherit doom-modeline-warning)))
|
||||
'((t (:inherit doom-modeline-warning :weight normal)))
|
||||
"Face for battery warning status."
|
||||
:group 'doom-modeline-faces)
|
||||
|
||||
(defface doom-modeline-battery-critical
|
||||
'((t (:inherit doom-modeline-urgent)))
|
||||
'((t (:inherit doom-modeline-urgent :weight normal)))
|
||||
"Face for battery critical status."
|
||||
:group 'doom-modeline-faces)
|
||||
|
||||
(defface doom-modeline-battery-error
|
||||
'((t (:inherit doom-modeline-urgent)))
|
||||
'((t (:inherit doom-modeline-urgent :weight normal)))
|
||||
"Face for battery error status."
|
||||
:group 'doom-modeline-faces)
|
||||
|
||||
|
|
@ -906,7 +852,7 @@ Also see the face `doom-modeline-unread-number'."
|
|||
:group 'doom-modeline-faces)
|
||||
|
||||
(defface doom-modeline-compilation
|
||||
'((t (:inherit doom-modeline-warning :slant italic :height 0.9)))
|
||||
'((t (:inherit doom-modeline-warning :weight normal :slant italic :height 0.9)))
|
||||
"Face for compilation progress."
|
||||
:group 'doom-modeline-faces)
|
||||
|
||||
|
|
@ -959,9 +905,8 @@ 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
|
||||
(unless (>= emacs-major-version 29)
|
||||
(defun doom-modeline-redisplay (&rest _)
|
||||
"Call `redisplay' to trigger mode-line height calculations.
|
||||
(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
|
||||
|
|
@ -978,20 +923,18 @@ 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)))
|
||||
(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)
|
||||
(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 (featurep 'nerd-icons)))
|
||||
(and doom-modeline-icon
|
||||
(display-graphic-p)
|
||||
(featurep 'all-the-icons)))
|
||||
|
||||
(defun doom-modeline-mwheel-available-p ()
|
||||
"Whether mouse wheel is available."
|
||||
|
|
@ -1016,11 +959,11 @@ used as an advice to window creation functions."
|
|||
(defvar-local doom-modeline--limited-width-p nil)
|
||||
|
||||
(defun doom-modeline--segment-visible (name)
|
||||
"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)))
|
||||
"Whether a segment 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."
|
||||
|
|
@ -1141,7 +1084,24 @@ Example:
|
|||
(rhs-forms (doom-modeline--prepare-segments rhs)))
|
||||
(defalias sym
|
||||
(lambda ()
|
||||
`(,lhs-forms ,rhs-forms))
|
||||
(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))
|
||||
(concat "Modeline:\n"
|
||||
(format " %s\n %s"
|
||||
(prin1-to-string lhs)
|
||||
|
|
@ -1153,10 +1113,7 @@ Example:
|
|||
Throws an error if it doesn't exist."
|
||||
(let ((fn (intern-soft (format "doom-modeline-format--%s" key))))
|
||||
(when (functionp fn)
|
||||
(let* ((modeline (funcall fn))
|
||||
(lhs (car modeline))
|
||||
(rhs (cdr modeline)))
|
||||
`(,lhs mode-line-format-right-align ,rhs)))))
|
||||
`(:eval (,fn)))))
|
||||
|
||||
(defun doom-modeline-set-modeline (key &optional default)
|
||||
"Set the modeline format. Does nothing if the modeline KEY doesn't exist.
|
||||
|
|
@ -1165,7 +1122,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)
|
||||
modeline)))
|
||||
(list "%e" modeline))))
|
||||
|
||||
|
||||
;;
|
||||
|
|
@ -1202,14 +1159,20 @@ 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
|
||||
(* 1.0 (cond ((integerp height) (/ height 10))
|
||||
((floatp height) (* height char-height))
|
||||
(t char-height))))))
|
||||
(* (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))))))
|
||||
|
||||
(defun doom-modeline--original-value (sym)
|
||||
"Return the original value for SYM, if any.
|
||||
|
|
@ -1248,10 +1211,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 `ipsicon', `octicon', `pomicon', `powerline', `faicon',
|
||||
`wicon', `sucicon', `devicon', `codicon', `flicon' and `mdicon', etc.
|
||||
ICON-SET includes `octicon', `faicon', `material', `alltheicons' and `fileicon',
|
||||
etc.
|
||||
UNICODE is the unicode char fallback. TEXT is the ASCII char fallback.
|
||||
ARGS is same as `nerd-icons-octicon' and others."
|
||||
ARGS is same as `all-the-icons-octicon' and others."
|
||||
(let ((face `(:inherit (doom-modeline
|
||||
,(or (plist-get args :face) 'mode-line)))))
|
||||
(cond
|
||||
|
|
@ -1259,7 +1222,7 @@ ARGS is same as `nerd-icons-octicon' and others."
|
|||
((and (doom-modeline-icon-displayable-p)
|
||||
icon-name
|
||||
(not (string-empty-p icon-name)))
|
||||
(when-let* ((func (nerd-icons--function-name icon-set))
|
||||
(when-let* ((func (all-the-icons--function-name icon-set))
|
||||
(icon (and (fboundp func)
|
||||
(apply func icon-name args))))
|
||||
(doom-modeline-propertize-icon icon face)))
|
||||
|
|
@ -1275,10 +1238,6 @@ ARGS is same as `nerd-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)
|
||||
|
|
@ -1295,7 +1254,8 @@ ARGS is same as `nerd-icons-octicon' and others."
|
|||
"Create the bar image.
|
||||
|
||||
Use FACE for the bar, WIDTH and HEIGHT are the image size in pixels."
|
||||
(when (and (image-type-available-p 'pbm)
|
||||
(when (and (display-graphic-p)
|
||||
(image-type-available-p 'pbm)
|
||||
(numberp width) (> width 0)
|
||||
(numberp height) (> height 0))
|
||||
(propertize
|
||||
|
|
@ -1461,12 +1421,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 or TRUE-FILE-PATH.
|
||||
"Propertize buffer name given by FILE-PATH.
|
||||
|
||||
If TRUNCATE-PROJECT-ROOT-PARENT is non-nil will be saved by truncating project
|
||||
root parent down fish-shell style.
|
||||
|
|
@ -1504,10 +1464,7 @@ Example:
|
|||
;; relative path
|
||||
(propertize
|
||||
(when-let (relative-path (file-relative-name
|
||||
(or (file-name-directory
|
||||
(if doom-modeline-buffer-file-true-name
|
||||
true-file-path file-path))
|
||||
"./")
|
||||
(or (file-name-directory file-path) "./")
|
||||
project-root))
|
||||
(if (string= relative-path "./")
|
||||
""
|
||||
276
org/elpa/doom-modeline-20230406.623/doom-modeline-env.el
Normal file
276
org/elpa/doom-modeline-20230406.623/doom-modeline-env.el
Normal file
|
|
@ -0,0 +1,276 @@
|
|||
;;; doom-modeline-env.el --- A environment parser for doom-modeline -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2019-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
Normal file
14
org/elpa/doom-modeline-20230406.623/doom-modeline-pkg.el
Normal file
|
|
@ -0,0 +1,14 @@
|
|||
(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:
|
||||
|
|
@ -1,6 +1,6 @@
|
|||
;;; doom-modeline-segments.el --- The segments for doom-modeline -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2018-2023 Vincent Zhang
|
||||
;; Copyright (C) 2018-2020 Vincent Zhang
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
|
||||
|
|
@ -57,7 +57,6 @@
|
|||
(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)
|
||||
|
|
@ -85,10 +84,8 @@
|
|||
(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)
|
||||
|
|
@ -107,7 +104,9 @@
|
|||
(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")
|
||||
|
|
@ -204,7 +203,6 @@
|
|||
(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")
|
||||
|
|
@ -256,12 +254,15 @@
|
|||
(setq doom-modeline--buffer-file-icon
|
||||
(when (and doom-modeline-major-mode-icon
|
||||
(doom-modeline-icon-displayable-p))
|
||||
(let ((icon (doom-modeline-icon-for-buffer)))
|
||||
(let ((icon (all-the-icons-icon-for-buffer)))
|
||||
(propertize (if (or (null icon) (symbolp icon))
|
||||
(doom-modeline-icon 'faicon "nf-fa-file_o" nil nil
|
||||
:face 'nerd-icons-dsilver)
|
||||
(doom-modeline-icon 'faicon "file-o" nil nil
|
||||
:face 'all-the-icons-dsilver
|
||||
:height 0.9
|
||||
:v-adjust 0.0)
|
||||
(doom-modeline-propertize-icon icon))
|
||||
'help-echo (format "Major-mode: %s" (format-mode-line mode-name)))))))
|
||||
'help-echo (format "Major-mode: %s" (format-mode-line mode-name))
|
||||
'display '(raise -0.135))))))
|
||||
(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)
|
||||
|
|
@ -278,8 +279,11 @@
|
|||
(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 `nerd-icons-mdicon' to fetch the icon."
|
||||
(doom-modeline-icon 'mdicon icon unicode text :face face))
|
||||
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))
|
||||
|
||||
(defvar-local doom-modeline--buffer-file-state-icon nil)
|
||||
(defun doom-modeline-update-buffer-file-state-icon (&rest _)
|
||||
|
|
@ -290,28 +294,29 @@ Uses `nerd-icons-mdicon' to fetch the icon."
|
|||
(concat
|
||||
(cond (buffer-read-only
|
||||
(doom-modeline-buffer-file-state-icon
|
||||
"nf-md-lock" "🔒" "%1*"
|
||||
'doom-modeline-warning))
|
||||
"lock" "🔒" "%1*" `(:inherit doom-modeline-warning
|
||||
:weight ,(if doom-modeline-icon
|
||||
'normal
|
||||
'bold))))
|
||||
((and buffer-file-name (buffer-modified-p)
|
||||
doom-modeline-buffer-modification-icon)
|
||||
(doom-modeline-buffer-file-state-icon
|
||||
"nf-md-content_save_edit" "💾" "%1*"
|
||||
'doom-modeline-warning))
|
||||
"save" "💾" "%1*" `(:inherit doom-modeline-buffer-modified
|
||||
:weight ,(if doom-modeline-icon
|
||||
'normal
|
||||
'bold))))
|
||||
((and buffer-file-name
|
||||
;; Avoid freezing while connection is lost
|
||||
(not (file-remote-p buffer-file-name))
|
||||
(not (file-remote-p buffer-file-name)) ; Avoid freezing while connection is lost
|
||||
(not (file-exists-p buffer-file-name)))
|
||||
(doom-modeline-buffer-file-state-icon
|
||||
"nf-md-cancel" "🚫" "!"
|
||||
'doom-modeline-urgent))
|
||||
"do_not_disturb_alt" "🚫" "!" '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
|
||||
"nf-md-unfold_less_horizontal" "↕" "><"
|
||||
'doom-modeline-warning)))))))
|
||||
"vertical_align_center" "↕" "><" 'doom-modeline-warning)))))))
|
||||
|
||||
(defvar-local doom-modeline--buffer-file-name nil)
|
||||
(defun doom-modeline-update-buffer-file-name (&rest _)
|
||||
|
|
@ -434,7 +439,8 @@ read-only or non-existent)."
|
|||
"Display calculator icons and info."
|
||||
(concat
|
||||
(doom-modeline-spc)
|
||||
(when-let ((icon (doom-modeline-icon 'faicon "nf-fa-calculator" "🖩" "")))
|
||||
(when-let ((icon (doom-modeline-icon 'faicon "calculator" nil nil
|
||||
:height 0.85 :v-adjust -0.05)))
|
||||
(concat
|
||||
(doom-modeline-display-icon icon)
|
||||
(doom-modeline-vspc)))
|
||||
|
|
@ -449,15 +455,14 @@ 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 "nf-oct-file_directory" "🖿" "" :face face)
|
||||
(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 "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))))
|
||||
|
||||
(doom-modeline-def-segment buffer-default-directory-simple
|
||||
"Displays `default-directory'.
|
||||
|
|
@ -465,14 +470,13 @@ 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 "nf-oct-file_directory" "🖿" "" :face face)
|
||||
(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 "file-directory" "🖿" ""
|
||||
:face face :v-adjust -0.05 :height 1.25)
|
||||
(doom-modeline-vspc)))
|
||||
(propertize (abbreviate-file-name default-directory) 'face face))))
|
||||
|
||||
|
||||
;;
|
||||
|
|
@ -627,9 +631,9 @@ project directory is important."
|
|||
help-echo ,help-echo
|
||||
local-map ,mode-line-minor-mode-keymap)
|
||||
,(doom-modeline-spc)
|
||||
(:propertize ("" ,(doom-modeline-icon 'octicon "nf-oct-gear" "⚙"
|
||||
(:propertize ("" ,(doom-modeline-icon 'octicon "gear" "⚙"
|
||||
minions-mode-line-lighter
|
||||
:face face))
|
||||
:face face :v-adjust -0.05))
|
||||
mouse-face ,mouse-face
|
||||
help-echo "Minions
|
||||
mouse-1: Display minor modes menu"
|
||||
|
|
@ -647,12 +651,13 @@ mouse-1: Display minor modes menu"
|
|||
;; VCS
|
||||
;;
|
||||
|
||||
(defun doom-modeline-vcs-icon (icon &optional unicode text face)
|
||||
(defun doom-modeline-vcs-icon (icon &optional unicode text face voffset)
|
||||
"Displays the vcs ICON with FACE and VOFFSET.
|
||||
|
||||
UNICODE and TEXT are fallbacks.
|
||||
Uses `nerd-icons-octicon' to fetch the icon."
|
||||
(doom-modeline-icon 'devicon icon unicode text :face face))
|
||||
Uses `all-the-icons-octicon' to fetch the icon."
|
||||
(doom-modeline-icon 'octicon icon unicode text
|
||||
:face face :v-adjust (or voffset -0.1)))
|
||||
|
||||
(defvar-local doom-modeline--vcs-icon nil)
|
||||
(defun doom-modeline-update-vcs-icon (&rest _)
|
||||
|
|
@ -662,15 +667,15 @@ Uses `nerd-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 "nf-dev-git_compare" "🔃" "*" 'doom-modeline-info))
|
||||
(doom-modeline-vcs-icon "git-compare" "🔃" "*" 'doom-modeline-info -0.05))
|
||||
((eq state 'needs-merge)
|
||||
(doom-modeline-vcs-icon "nf-dev-git_merge" "🔀" "?" 'doom-modeline-info))
|
||||
(doom-modeline-vcs-icon "git-merge" "🔀" "?" 'doom-modeline-info))
|
||||
((eq state 'needs-update)
|
||||
(doom-modeline-vcs-icon "nf-dev-git_pull_request" "⬇" "!" 'doom-modeline-warning))
|
||||
(doom-modeline-vcs-icon "arrow-down" "⬇" "!" 'doom-modeline-warning))
|
||||
((memq state '(removed conflict unregistered))
|
||||
(doom-modeline-icon 'octicon "nf-oct-alert" "⚠" "!" :face 'doom-modeline-urgent))
|
||||
(doom-modeline-vcs-icon "alert" "⚠" "!" 'doom-modeline-urgent))
|
||||
(t
|
||||
(doom-modeline-vcs-icon "nf-dev-git_branch" "" "@" 'doom-modeline-info)))))))
|
||||
(doom-modeline-vcs-icon "git-branch" "" "@" 'doom-modeline-info -0.05)))))))
|
||||
(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)
|
||||
|
|
@ -702,19 +707,18 @@ Uses `nerd-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 `(:inherit (,face bold)))))))
|
||||
'face (cond ((eq state 'needs-update)
|
||||
'doom-modeline-warning)
|
||||
((memq state '(removed conflict unregistered))
|
||||
'doom-modeline-urgent)
|
||||
(t 'doom-modeline-info)))))))
|
||||
(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)
|
||||
|
|
@ -743,8 +747,9 @@ Uses `nerd-icons-octicon' to fetch the icon."
|
|||
"Displays the checker 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))
|
||||
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))
|
||||
|
||||
(defun doom-modeline-checker-text (text &optional face)
|
||||
"Displays TEXT with FACE."
|
||||
|
|
@ -779,16 +784,16 @@ level."
|
|||
('finished (if flycheck-current-errors
|
||||
(let-alist (doom-modeline--flycheck-count-errors)
|
||||
(doom-modeline-checker-icon
|
||||
"nf-md-alert_circle_outline" "❗" "!"
|
||||
"error_outline" "❗" "!"
|
||||
(cond ((> .error 0) 'doom-modeline-urgent)
|
||||
((> .warning 0) 'doom-modeline-warning)
|
||||
(t 'doom-modeline-info))))
|
||||
(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))
|
||||
(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))
|
||||
(_ nil))))
|
||||
(propertize icon
|
||||
'help-echo (concat "Flycheck\n"
|
||||
|
|
@ -854,8 +859,7 @@ mouse-2: Show help for minor mode")
|
|||
'doom-modeline-warning)
|
||||
(doom-modeline-checker-text (number-to-string .info)
|
||||
'doom-modeline-info))))))
|
||||
('running (and doom-modeline--flycheck-text
|
||||
(propertize doom-modeline--flycheck-text 'face 'doom-modeline-debug)))
|
||||
;; ('running nil)
|
||||
;; ('no-checker nil)
|
||||
;; ('errored (doom-modeline-checker-text "Error" 'doom-modeline-urgent))
|
||||
;; ('interrupted (doom-modeline-checker-text "Interrupted" 'doom-modeline-debug))
|
||||
|
|
@ -871,8 +875,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"
|
||||
(when (doom-modeline-mwheel-available-p)
|
||||
"\nwheel-up/wheel-down: Previous/next error")))
|
||||
(if (doom-modeline-mwheel-available-p)
|
||||
"\nwheel-up/wheel-down: Previous/next error")))
|
||||
('running "Checking...")
|
||||
('no-checker "No Checker")
|
||||
('errored "Error")
|
||||
|
|
@ -923,9 +927,9 @@ mouse-3: Next error"
|
|||
(when-let
|
||||
((icon
|
||||
(cond
|
||||
(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))
|
||||
(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))
|
||||
(t (let ((.error 0)
|
||||
(.warning 0)
|
||||
(.note 0))
|
||||
|
|
@ -943,11 +947,11 @@ mouse-3: Next error"
|
|||
((> severity note-level) (cl-incf .warning))
|
||||
(t (cl-incf .note))))))
|
||||
(if (> (+ .error .warning .note) 0)
|
||||
(doom-modeline-checker-icon "nf-md-alert_circle_outline" "❗" "!"
|
||||
(doom-modeline-checker-icon "error_outline" "❗" "!"
|
||||
(cond ((> .error 0) 'doom-modeline-urgent)
|
||||
((> .warning 0) 'doom-modeline-warning)
|
||||
(t 'doom-modeline-info)))
|
||||
(doom-modeline-checker-icon "nf-md-check_circle_outline" "✔" "-" 'doom-modeline-info))))))))
|
||||
(doom-modeline-checker-icon "check" "✔" "-" 'doom-modeline-info))))))))
|
||||
(propertize
|
||||
icon
|
||||
'help-echo (concat "Flymake\n"
|
||||
|
|
@ -1019,8 +1023,7 @@ mouse-2: Show help for minor mode"
|
|||
(when-let
|
||||
((text
|
||||
(cond
|
||||
(some-waiting (and doom-modeline--flymake-text
|
||||
(propertize doom-modeline--flymake-text 'face 'doom-modeline-debug)))
|
||||
(some-waiting doom-modeline--flymake-text)
|
||||
((null known) nil)
|
||||
(all-disabled nil)
|
||||
(t (let ((num (+ .error .warning .note)))
|
||||
|
|
@ -1099,8 +1102,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))))
|
||||
|
||||
|
||||
;;
|
||||
|
|
@ -1121,9 +1124,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)
|
||||
|
|
@ -1159,14 +1162,16 @@ block selection."
|
|||
'(:inherit (doom-modeline-panel variable-pitch)))))
|
||||
(concat
|
||||
sep
|
||||
(doom-modeline-icon 'mdicon "nf-md-record" "●"
|
||||
(doom-modeline-icon 'material "fiber_manual_record" "●"
|
||||
(if (bound-and-true-p evil-this-macro)
|
||||
(char-to-string evil-this-macro)
|
||||
"Macro")
|
||||
:face 'doom-modeline-panel)
|
||||
:face 'doom-modeline-panel
|
||||
:v-adjust -0.225)
|
||||
vsep
|
||||
(doom-modeline-icon 'octicon "nf-oct-triangle_right" "▶" ">"
|
||||
:face 'doom-modeline-panel)
|
||||
(doom-modeline-icon 'octicon "triangle-right" "▶" ">"
|
||||
:face 'doom-modeline-panel
|
||||
:v-adjust -0.05)
|
||||
sep))))
|
||||
|
||||
;; `anzu' and `evil-anzu' expose current/total state that can be displayed in the
|
||||
|
|
@ -1214,8 +1219,7 @@ 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' in real time.
|
||||
The number of matches contains substitutions and highlightings."
|
||||
"Show number of matches for evil-ex substitutions and highlights in real time."
|
||||
(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)
|
||||
|
|
@ -1275,18 +1279,19 @@ The number of matches contains substitutions and highlightings."
|
|||
(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 "nf-fa-i_cursor" "" "" :face face)
|
||||
(or (doom-modeline-icon 'faicon "i-cursor" nil nil
|
||||
:face face :v-adjust -0.0575)
|
||||
(propertize "I"
|
||||
'face `(:inherit ,face :height 1.4 :weight normal)
|
||||
'display '(raise -0.1)))
|
||||
|
|
@ -1307,8 +1312,7 @@ The number of matches contains substitutions and highlightings."
|
|||
'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'.
|
||||
Apply ORIG-FUN with ARGS."
|
||||
"Override the mode-line of `phi-search' and `phi-replace'."
|
||||
(if (bound-and-true-p doom-modeline-mode)
|
||||
(apply orig-fun mode-line-format (cdr args))
|
||||
(apply orig-fun args)))
|
||||
|
|
@ -1358,8 +1362,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)))))
|
||||
|
||||
|
||||
|
|
@ -1545,8 +1549,7 @@ 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))
|
||||
(setq mode-line-misc-info
|
||||
(assq-delete-all 'eyebrowse-mode 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)))))
|
||||
|
|
@ -1581,16 +1584,15 @@ 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 'octicon "nf-oct-repo" "🖿" "#"
|
||||
:face `(:inherit ,face :slant normal))))
|
||||
(icon (doom-modeline-icon 'material "folder" "🖿" "#"
|
||||
:face `(:inherit ,face :slant normal)
|
||||
:height 1.1
|
||||
:v-adjust -0.225)))
|
||||
(when (or doom-modeline-display-default-persp-name
|
||||
(not (string-equal persp-nil-name name)))
|
||||
(concat " "
|
||||
(concat (doom-modeline-spc)
|
||||
(propertize (concat (and doom-modeline-persp-icon
|
||||
(concat icon
|
||||
(propertize
|
||||
" "
|
||||
'display '((space :relative-width 0.5)))))
|
||||
(concat icon (doom-modeline-vspc)))
|
||||
(propertize name 'face face))
|
||||
'help-echo "mouse-1: Switch perspective
|
||||
mouse-2: Show help for minor mode"
|
||||
|
|
@ -1603,7 +1605,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)
|
||||
|
|
@ -1744,12 +1746,13 @@ 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
|
||||
'mdicon
|
||||
'material
|
||||
(when doom-modeline-modal-icon
|
||||
(or icon "nf-md-record"))
|
||||
(or icon "fiber_manual_record"))
|
||||
(or unicode "●")
|
||||
text
|
||||
:face (doom-modeline-face face))
|
||||
:face (doom-modeline-face face)
|
||||
:v-adjust -0.225)
|
||||
'help-echo help-echo))
|
||||
|
||||
(defsubst doom-modeline--evil ()
|
||||
|
|
@ -1767,47 +1770,29 @@ 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)
|
||||
(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 "🅝")))))
|
||||
(evil-state-property evil-state :name 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
|
||||
"<W>" 'doom-modeline-overwrite "Overwrite mode"
|
||||
"nf-md-note_edit" "🅦")))
|
||||
"<O>" 'doom-modeline-overwrite "Overwrite mode"
|
||||
"border_color" "🧷")))
|
||||
|
||||
(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"
|
||||
"nf-md-account_circle" "🅖")))
|
||||
"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"
|
||||
"nf-md-star_circle" "✪")))
|
||||
"add_circle" "✪")))
|
||||
|
||||
(defsubst doom-modeline--xah-fly-keys ()
|
||||
"The current `xah-fly-keys' state."
|
||||
|
|
@ -1815,10 +1800,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"
|
||||
"nf-md-airplane_edit" "🛧")
|
||||
"flight" "🛧")
|
||||
(doom-modeline--modal-icon
|
||||
"<C>" 'doom-modeline-fly-normal-state "Xah-fly command mode"
|
||||
"nf-md-airplane_cog" "🛧"))))
|
||||
"flight" "🛧"))))
|
||||
|
||||
(defsubst doom-modeline--boon ()
|
||||
"The current Boon state. Requires `boon-mode' to be enabled."
|
||||
|
|
@ -1832,7 +1817,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)
|
||||
"nf-md-coffee" "🍵")))
|
||||
"local_cafe" "🍵")))
|
||||
|
||||
(defsubst doom-modeline--meow ()
|
||||
"The current Meow state. Requires `meow-mode' to be enabled."
|
||||
|
|
@ -1961,7 +1946,8 @@ 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 "nf-fa-terminal" "$" text :face face))
|
||||
(doom-modeline-icon 'faicon "terminal" "$" text
|
||||
:face face :height 1.0 :v-adjust -0.0575))
|
||||
|
||||
(defvar doom-modeline--cider nil)
|
||||
|
||||
|
|
@ -2009,7 +1995,8 @@ 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 'octicon "nf-oct-rocket" "🚀" text :face face))
|
||||
(doom-modeline-icon 'faicon "rocket" "🚀" text
|
||||
:face face :height 1.0 :v-adjust -0.0575))
|
||||
|
||||
(defvar-local doom-modeline--lsp nil)
|
||||
(defun doom-modeline-update-lsp (&rest _)
|
||||
|
|
@ -2202,14 +2189,11 @@ Example:
|
|||
(with-timeout (10)
|
||||
(ignore-errors
|
||||
(when-let* ((username (ghub--username ghub-default-host))
|
||||
(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
|
||||
(token (ghub--token ghub-default-host username 'ghub t)))
|
||||
(ghub-get "/notifications" nil
|
||||
:query '((notifications . "true"))
|
||||
:username username
|
||||
:auth token
|
||||
:unpaginate t
|
||||
:noerror t))))))
|
||||
(lambda (result)
|
||||
(message "") ; suppress message
|
||||
|
|
@ -2239,19 +2223,21 @@ Example:
|
|||
"The GitHub notifications."
|
||||
(when (and doom-modeline-github
|
||||
(doom-modeline--segment-visible 'github)
|
||||
(numberp doom-modeline--github-notification-number))
|
||||
(numberp doom-modeline--github-notification-number)
|
||||
(> doom-modeline--github-notification-number 0))
|
||||
(concat
|
||||
(doom-modeline-spc)
|
||||
(propertize
|
||||
(concat
|
||||
(doom-modeline-icon 'octicon "nf-oct-mark_github" "🔔" "&"
|
||||
:face 'doom-modeline-notification)
|
||||
(and (> doom-modeline--github-notification-number 0) (doom-modeline-vspc))
|
||||
(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
|
||||
(propertize
|
||||
(cond
|
||||
((<= doom-modeline--github-notification-number 0) "")
|
||||
((> doom-modeline--github-notification-number 99) "99+")
|
||||
(t (number-to-string doom-modeline--github-notification-number)))
|
||||
(if (>= doom-modeline--github-notification-number 50)
|
||||
"50+"
|
||||
(number-to-string doom-modeline--github-notification-number))
|
||||
'face '(:inherit
|
||||
(doom-modeline-unread-number doom-modeline-notification))))
|
||||
'help-echo "Github Notifications
|
||||
|
|
@ -2302,9 +2288,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)
|
||||
(defun doom-modeline-debug-icon (face &rest args)
|
||||
"Display debug icon with FACE and ARGS."
|
||||
(doom-modeline-icon 'codicon "nf-cod-debug" "🐛" "!" :face face))
|
||||
(doom-modeline-icon 'faicon "bug" "🐛" "!" :face face :v-adjust -0.0575 args))
|
||||
|
||||
(defun doom-modeline--debug-dap ()
|
||||
"The current `dap-mode' state."
|
||||
|
|
@ -2411,55 +2397,46 @@ mouse-1: Toggle Debug on Quit"
|
|||
|
||||
|
||||
;;
|
||||
;; `mu4e' notifications
|
||||
;; `mu4e-alert' notifications
|
||||
;;
|
||||
|
||||
(doom-modeline-def-segment mu4e
|
||||
"Show notifications of any unread emails in `mu4e'."
|
||||
(when (and doom-modeline-mu4e
|
||||
(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)))))))
|
||||
(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))))
|
||||
|
||||
(defun doom-modeline-override-mu4e-alert (&rest _)
|
||||
"Delete `mu4e-alert-mode-line' from global modeline string."
|
||||
(when (and (featurep 'mu4e-alert)
|
||||
(bound-and-true-p mu4e-alert-mode-line))
|
||||
(when (featurep 'mu4e-alert)
|
||||
(if (and doom-modeline-mu4e
|
||||
(bound-and-true-p doom-modeline-mode))
|
||||
;; Delete original modeline
|
||||
|
|
@ -2473,26 +2450,12 @@ 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-modeline))))
|
||||
(doom-modeline-override-mu4e-alert))))
|
||||
|
||||
|
||||
;;
|
||||
|
|
@ -2554,8 +2517,9 @@ mouse-1: Toggle Debug on Quit"
|
|||
(doom-modeline-spc)
|
||||
(propertize
|
||||
(concat
|
||||
(doom-modeline-icon 'mdicon "nf-md-email" "📧" "#"
|
||||
:face 'doom-modeline-notification)
|
||||
(doom-modeline-icon 'material "email" "📧" "#"
|
||||
:face 'doom-modeline-notification
|
||||
:height 1.1 :v-adjust -0.2)
|
||||
(doom-modeline-vspc)
|
||||
(propertize
|
||||
(if (> doom-modeline--gnus-unread-mail doom-modeline-number-limit)
|
||||
|
|
@ -2658,8 +2622,9 @@ 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 'mdicon "nf-md-message_processing" "🗊" "#"
|
||||
:face 'doom-modeline-notification)
|
||||
(doom-modeline-icon 'material "message" "🗊" "#"
|
||||
:face 'doom-modeline-notification
|
||||
:height 1.0 :v-adjust -0.225)
|
||||
(doom-modeline-vspc)
|
||||
;; Display the number of unread buffers
|
||||
(propertize (number-to-string number)
|
||||
|
|
@ -2733,13 +2698,6 @@ 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."
|
||||
|
|
@ -2749,9 +2707,7 @@ Uses `nerd-icons-mdicon' to fetch the icon."
|
|||
(let* ((data (and battery-status-function
|
||||
(functionp battery-status-function)
|
||||
(funcall battery-status-function)))
|
||||
(status (cdr (assoc ?L data)))
|
||||
(charging? (or (string-equal "AC" status)
|
||||
(string-equal "on-line" status)))
|
||||
(charging? (string-equal "AC" (cdr (assoc ?L data))))
|
||||
(percentage (car (read-from-string (or (cdr (assq ?p data)) "ERR"))))
|
||||
(valid-percentage? (and (numberp percentage)
|
||||
(>= percentage 0)
|
||||
|
|
@ -2764,62 +2720,25 @@ Uses `nerd-icons-mdicon' to fetch the icon."
|
|||
(t 'doom-modeline-battery-full))
|
||||
'doom-modeline-battery-error))
|
||||
(icon (if valid-percentage?
|
||||
(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)))
|
||||
(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)))
|
||||
(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)
|
||||
|
|
@ -2892,11 +2811,13 @@ Uses `nerd-icons-mdicon' to fetch the icon."
|
|||
(when (and doom-modeline-icon doom-modeline-major-mode-icon)
|
||||
(concat
|
||||
(doom-modeline-spc)
|
||||
(doom-modeline-icon 'faicon "nf-fa-archive" nil nil
|
||||
(doom-modeline-icon 'faicon "archive" nil nil
|
||||
:face (doom-modeline-face
|
||||
(if doom-modeline-major-mode-color-icon
|
||||
'nerd-icons-silver
|
||||
'mode-line)))))
|
||||
'all-the-icons-silver
|
||||
'mode-line))
|
||||
:height 1.0
|
||||
:v-adjust -0.0575)))
|
||||
(doom-modeline-display-text
|
||||
(format-mode-line 'mode-line-buffer-identification))))
|
||||
|
||||
|
|
@ -2924,10 +2845,12 @@ The cdr can also be a function that returns a name to use.")
|
|||
(doom-modeline-spc)
|
||||
(when doom-modeline-icon
|
||||
(concat
|
||||
(doom-modeline-icon 'sucicon "nf-custom-emacs" nil nil
|
||||
(doom-modeline-icon 'fileicon "elisp" nil nil
|
||||
:face (doom-modeline-face
|
||||
(and doom-modeline-major-mode-color-icon
|
||||
'nerd-icons-blue)))
|
||||
'all-the-icons-blue))
|
||||
:height 1.0
|
||||
:v-adjust -0.15)
|
||||
(doom-modeline-spc)))
|
||||
(propertize
|
||||
(let ((custom (cdr (assoc (buffer-name) doom-modeline--helm-buffer-ids)))
|
||||
|
|
@ -3008,26 +2931,29 @@ 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-info)
|
||||
('run 'doom-modeline-buffer-path)
|
||||
('exit 'doom-modeline-warning)
|
||||
(_ 'doom-modeline-urgent))
|
||||
'doom-modeline-urgent))))
|
||||
(propertize
|
||||
(doom-modeline-icon 'codicon "nf-cod-open_preview" "🗐" "@" :face face)
|
||||
'help-echo (format "Preview on %s
|
||||
(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
|
||||
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))))
|
||||
|
||||
;;
|
||||
|
|
@ -3056,15 +2982,16 @@ mouse-3: Restart preview"
|
|||
(doom-modeline-spc)
|
||||
(when doom-modeline-time-icon
|
||||
(concat
|
||||
(doom-modeline-icon 'octicon "nf-oct-clock" "⏰" ""
|
||||
:face '(:inherit doom-modeline-time :weight normal))
|
||||
(doom-modeline-icon 'octicon "calendar" "📅" ""
|
||||
:face 'doom-modeline-time
|
||||
:v-adjust -0.05)
|
||||
(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))
|
||||
249
org/elpa/doom-modeline-20230406.623/doom-modeline.el
Normal file
249
org/elpa/doom-modeline-20230406.623/doom-modeline.el
Normal file
|
|
@ -0,0 +1,249 @@
|
|||
;;; 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
|
||||
|
|
@ -57,10 +57,6 @@ search.
|
|||
|
||||
(register-definition-prefixes "elisp-refs" '("elisp-"))
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil nil ("elisp-refs-pkg.el") (0 0 0 0))
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
2
org/elpa/elisp-refs-20220704.2141/elisp-refs-pkg.el
Normal file
2
org/elpa/elisp-refs-20220704.2141/elisp-refs-pkg.el
Normal file
|
|
@ -0,0 +1,2 @@
|
|||
;;; 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"))
|
||||
|
|
@ -3,7 +3,9 @@
|
|||
;; Copyright (C) 2016-2020 Wilfred Hughes <me@wilfred.me.uk>
|
||||
|
||||
;; Author: Wilfred Hughes <me@wilfred.me.uk>
|
||||
;; Version: 1.6
|
||||
;; Version: 1.5
|
||||
;; Package-Version: 20220704.2141
|
||||
;; Package-Commit: af73739084637c8ebadad337a8fe58ff4f1d2ec1
|
||||
;; Keywords: lisp
|
||||
;; Package-Requires: ((dash "2.12.0") (s "1.11.0"))
|
||||
|
||||
|
|
@ -37,10 +39,6 @@
|
|||
(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)
|
||||
|
|
@ -69,7 +67,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 symbol foo.
|
||||
report the position of the f.
|
||||
|
||||
Not recursive, so we don't consider subelements of nested sexps."
|
||||
(let ((positions nil))
|
||||
|
|
@ -91,25 +89,18 @@ Not recursive, so we don't consider subelements of nested sexps."
|
|||
(scan-error nil)))
|
||||
(nreverse positions)))
|
||||
|
||||
(defun elisp-refs--read-buffer-form (symbols-with-pos)
|
||||
(defun elisp-refs--read-buffer-form ()
|
||||
"Read a form from the current buffer, starting at point.
|
||||
Returns a list:
|
||||
\(form form-start-pos form-end-pos symbol-positions read-start-pos)
|
||||
|
||||
In Emacs 28 and earlier, SYMBOL-POSITIONS is a list of 0-indexed
|
||||
symbol positions relative to READ-START-POS, according to
|
||||
`read-symbol-positions-list'.
|
||||
|
||||
In Emacs 29+, SYMBOL-POSITIONS is nil. If SYMBOLS-WITH-POS is
|
||||
non-nil, forms are read with `read-positioning-symbols'."
|
||||
SYMBOL-POSITIONS are 0-indexed, relative to READ-START-POS."
|
||||
(let* ((read-with-symbol-positions t)
|
||||
(read-start-pos (point))
|
||||
(form (if (and symbols-with-pos (fboundp 'read-positioning-symbols))
|
||||
(read-positioning-symbols (current-buffer))
|
||||
(read (current-buffer))))
|
||||
(form (read (current-buffer)))
|
||||
(symbols (if (boundp 'read-symbol-positions-list)
|
||||
read-symbol-positions-list
|
||||
nil))
|
||||
(read-positioning-symbols (current-buffer))))
|
||||
(end-pos (point))
|
||||
(start-pos (elisp-refs--start-pos end-pos)))
|
||||
(list form start-pos end-pos symbols read-start-pos)))
|
||||
|
|
@ -118,14 +109,14 @@ non-nil, forms are read with `read-positioning-symbols'."
|
|||
"A buffer-local variable used by `elisp-refs--contents-buffer'.
|
||||
Internal implementation detail.")
|
||||
|
||||
(defun elisp-refs--read-all-buffer-forms (buffer symbols-with-pos)
|
||||
(defun elisp-refs--read-all-buffer-forms (buffer)
|
||||
"Read all the forms in BUFFER, along with their positions."
|
||||
(with-current-buffer buffer
|
||||
(goto-char (point-min))
|
||||
(let ((forms nil))
|
||||
(condition-case err
|
||||
(while t
|
||||
(push (elisp-refs--read-buffer-form symbols-with-pos) forms))
|
||||
(push (elisp-refs--read-buffer-form) forms))
|
||||
(error
|
||||
(if (or (equal (car err) 'end-of-file)
|
||||
;; TODO: this shouldn't occur in valid elisp files,
|
||||
|
|
@ -139,12 +130,12 @@ Internal implementation detail.")
|
|||
|
||||
(defun elisp-refs--proper-list-p (val)
|
||||
"Is VAL a proper list?"
|
||||
(if (fboundp 'proper-list-p)
|
||||
;; `proper-list-p' was added in Emacs 27.1.
|
||||
;; http://git.savannah.gnu.org/cgit/emacs.git/commit/?id=2fde6275b69fd113e78243790bf112bbdd2fe2bf
|
||||
(with-no-warnings (proper-list-p val))
|
||||
;; Earlier Emacs versions only had format-proper-list-p.
|
||||
(with-no-warnings (format-proper-list-p val))))
|
||||
(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))))
|
||||
|
||||
(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
|
||||
|
|
@ -180,7 +171,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-pair form subforms-positions)
|
||||
(--each (-zip form subforms-positions)
|
||||
(-let [(subform subform-start subform-end) it]
|
||||
(when (or
|
||||
(and (consp subform) (elisp-refs--proper-list-p subform))
|
||||
|
|
@ -317,52 +308,27 @@ with its start and end position."
|
|||
(-non-nil
|
||||
(--mapcat
|
||||
(-let [(form start-pos end-pos symbol-positions _read-start-pos) it]
|
||||
;; Optimisation: if we have a list of positions for the current
|
||||
;; form (Emacs 28 and earlier), and it doesn't contain the
|
||||
;; symbol we're looking for, don't bother walking the form.
|
||||
(when (or (null symbol-positions) (assq symbol symbol-positions))
|
||||
;; Optimisation: don't bother walking a form if contains no
|
||||
;; references to the symbol we're looking for.
|
||||
(when (assq symbol symbol-positions)
|
||||
(elisp-refs--walk buffer form start-pos end-pos symbol match-p)))
|
||||
(elisp-refs--read-all-buffer-forms buffer nil))))
|
||||
|
||||
(defun elisp-refs--walk-positioned-symbols (forms symbol)
|
||||
"Given a nested list of FORMS, return a list of all positions of SYMBOL.
|
||||
Assumes `symbol-with-pos-pos' is defined (Emacs 29+)."
|
||||
(cond
|
||||
((symbol-with-pos-p forms)
|
||||
(let ((symbols-with-pos-enabled t))
|
||||
(if (eq forms symbol)
|
||||
(list (list symbol
|
||||
(symbol-with-pos-pos forms)
|
||||
(+ (symbol-with-pos-pos forms) (length (symbol-name symbol))))))))
|
||||
((elisp-refs--proper-list-p forms)
|
||||
;; Proper list, use `--mapcat` to reduce how much we recurse.
|
||||
(--mapcat (elisp-refs--walk-positioned-symbols it symbol) forms))
|
||||
((consp forms)
|
||||
;; Improper list, we have to recurse on head and tail.
|
||||
(append (elisp-refs--walk-positioned-symbols (car forms) symbol)
|
||||
(elisp-refs--walk-positioned-symbols (cdr forms) symbol)))
|
||||
((vectorp forms)
|
||||
(--mapcat (elisp-refs--walk-positioned-symbols it symbol) forms))))
|
||||
(elisp-refs--read-all-buffer-forms buffer))))
|
||||
|
||||
(defun elisp-refs--read-and-find-symbol (buffer symbol)
|
||||
"Read all the forms in BUFFER, and return a list of all
|
||||
positions of SYMBOL."
|
||||
(let* ((symbols-with-pos (fboundp 'symbol-with-pos-pos))
|
||||
(forms (elisp-refs--read-all-buffer-forms buffer symbols-with-pos)))
|
||||
(-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))
|
||||
|
||||
(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)))))
|
||||
(elisp-refs--read-all-buffer-forms buffer))))
|
||||
|
||||
(defun elisp-refs--filter-obarray (pred)
|
||||
"Return a list of all the items in `obarray' where PRED returns t."
|
||||
|
|
@ -1,14 +0,0 @@
|
|||
(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:
|
||||
|
|
@ -1,11 +1,9 @@
|
|||
(define-package "f" "20230704.1346" "Modern API for working with files and directories"
|
||||
(define-package "f" "20220911.711" "Modern API for working with files and directories"
|
||||
'((emacs "24.1")
|
||||
(s "1.7.0")
|
||||
(dash "2.2.0"))
|
||||
:commit "19e1da061e759b05e8c480b426287a063ca39484" :authors
|
||||
:commit "d50dca48929575642912bb5bbb2585709ba38f82" :authors
|
||||
'(("Johan Andersson" . "johan.rejeep@gmail.com"))
|
||||
:maintainers
|
||||
'(("Lucien Cartier-Tilet" . "lucien@phundrak.com"))
|
||||
:maintainer
|
||||
'("Lucien Cartier-Tilet" . "lucien@phundrak.com")
|
||||
:keywords
|
||||
|
|
@ -29,8 +29,7 @@
|
|||
;;; Code:
|
||||
|
||||
(when (version<= "28.1" emacs-version)
|
||||
(when (< emacs-major-version 29)
|
||||
(require 'shortdoc))
|
||||
(require 'shortdoc)
|
||||
|
||||
(define-short-documentation-group f
|
||||
"Paths"
|
||||
|
|
@ -284,16 +283,10 @@
|
|||
:result nil)
|
||||
|
||||
(f-hidden-p
|
||||
: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))
|
||||
:no-eval (f-hidden-p "/path/to/foo")
|
||||
:result nil
|
||||
:no-eval (f-hidden-p "/path/to/.foo")
|
||||
:result t)
|
||||
|
||||
(f-empty-p
|
||||
:no-eval (f-empty-p "/path/to/empty-file")
|
||||
|
|
@ -305,30 +298,6 @@
|
|||
: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")
|
||||
|
|
@ -340,46 +309,16 @@
|
|||
:eval (f-depth "/usr/local/bin"))
|
||||
|
||||
(f-change-time
|
||||
: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)
|
||||
:no-eval* (f-change-time "path/to/file.txt")
|
||||
:no-eval* (f-change-time "path/to/dir"))
|
||||
|
||||
(f-modification-time
|
||||
: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)
|
||||
:no-eval* (f-modification-time "path/to/file.txt")
|
||||
:no-eval* (f-modification-time "path/to/dir"))
|
||||
|
||||
(f-access-time
|
||||
: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)
|
||||
:no-eval* (f-access-time "path/to/file.txt")
|
||||
:no-eval* (f-access-time "path/to/dir"))
|
||||
|
||||
"Misc"
|
||||
(f-this-file
|
||||
|
|
@ -389,8 +328,8 @@
|
|||
:eval (f-path-separator))
|
||||
|
||||
(f-glob
|
||||
:no-eval* (f-glob "path/to/*.el")
|
||||
:no-eval* (f-glob "*.el" "path/to"))
|
||||
:noeval* (f-glob "path/to/*.el")
|
||||
:noeval* (f-glob "*.el" "path/to"))
|
||||
|
||||
(f-entries
|
||||
:no-eval* (f-entries "path/to/dir")
|
||||
|
|
@ -28,11 +28,6 @@
|
|||
;; 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:
|
||||
|
||||
|
||||
|
|
@ -73,7 +68,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))))
|
||||
(mapc
|
||||
(-map
|
||||
(lambda (arg)
|
||||
(setq path (cond ((not path) arg)
|
||||
((f-absolute-p arg)
|
||||
|
|
@ -214,9 +209,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)
|
||||
|
|
@ -282,7 +277,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\"))
|
||||
|
|
@ -454,49 +449,16 @@ 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)
|
||||
(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)))
|
||||
(string-prefix-p (f-full path-b)
|
||||
(f-full path-a))))
|
||||
|
||||
(defalias 'f-descendant-of? 'f-descendant-of-p)
|
||||
|
||||
(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))))))
|
||||
(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) "."))
|
||||
|
||||
(defalias 'f-hidden? 'f-hidden-p)
|
||||
|
||||
|
|
@ -529,142 +491,26 @@ detect the depth.
|
|||
'/' will be zero depth, '/usr' will be one depth. And so on."
|
||||
(- (length (f-split (f-expand path))) 1))
|
||||
|
||||
;; 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)
|
||||
(defun f-change-time (path)
|
||||
"Return the last status change time of PATH.
|
||||
|
||||
The status change time (ctime) of PATH in the same format as
|
||||
`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)))))
|
||||
`current-time'. See `file-attributes' for technical details."
|
||||
(nth 6 (file-attributes path)))
|
||||
|
||||
(defun f-modification-time (path &optional timestamp-p)
|
||||
(defun f-modification-time (path)
|
||||
"Return the last modification time of PATH.
|
||||
|
||||
The modification time (mtime) of PATH in the same format as
|
||||
`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)))))
|
||||
`current-time'. See `file-attributes' for technical details."
|
||||
(nth 5 (file-attributes path)))
|
||||
|
||||
(defun f-access-time (path &optional timestamp-p)
|
||||
(defun f-access-time (path)
|
||||
"Return the last access time of PATH.
|
||||
|
||||
The access time (atime) of PATH is in the same format as
|
||||
`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)
|
||||
`current-time'. See `file-attributes' for technical details."
|
||||
(nth 4 (file-attributes path)))
|
||||
|
||||
|
||||
;;;; Misc
|
||||
|
|
@ -698,7 +544,7 @@ For more info on METHOD, see `f--date-compare'."
|
|||
(member (f-filename file) '("." "..")))
|
||||
(directory-files path t))))
|
||||
(cond (recursive
|
||||
(mapc
|
||||
(-map
|
||||
(lambda (entry)
|
||||
(if (f-file-p entry)
|
||||
(setq result (cons entry result))
|
||||
261
org/elpa/helm-20221107.1658/emacs-helm.sh
Executable file
261
org/elpa/helm-20221107.1658/emacs-helm.sh
Executable file
|
|
@ -0,0 +1,261 @@
|
|||
#!/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
Normal file
284
org/elpa/helm-20221107.1658/helm-adaptive.el
Normal file
|
|
@ -0,0 +1,284 @@
|
|||
;;; helm-adaptive.el --- Adaptive Sorting of Candidates. -*- lexical-binding: t -*-
|
||||
|
||||
;; Original Author: Tamas Patrovics
|
||||
|
||||
;; Copyright (C) 2007 Tamas Patrovics
|
||||
;; Copyright (C) 2012 ~ 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
Normal file
1179
org/elpa/helm-20221107.1658/helm-autoloads.el
Normal file
File diff suppressed because it is too large
Load diff
809
org/elpa/helm-20221107.1658/helm-bookmark.el
Normal file
809
org/elpa/helm-20221107.1658/helm-bookmark.el
Normal file
|
|
@ -0,0 +1,809 @@
|
|||
;;; 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
Normal file
1177
org/elpa/helm-20221107.1658/helm-buffers.el
Normal file
File diff suppressed because it is too large
Load diff
159
org/elpa/helm-20221107.1658/helm-color.el
Normal file
159
org/elpa/helm-20221107.1658/helm-color.el
Normal file
|
|
@ -0,0 +1,159 @@
|
|||
;;; 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
|
||||
|
|
@ -102,7 +102,7 @@ If BUFFER is nil, use current buffer."
|
|||
(funcall it)
|
||||
(comint-next-prompt 1)))
|
||||
(push (list (buffer-substring-no-properties
|
||||
it (pos-eol))
|
||||
it (point-at-eol))
|
||||
it (buffer-name) count)
|
||||
result)
|
||||
(setq count (1+ count))))
|
||||
|
|
@ -218,7 +218,7 @@ See `helm-comint-prompts-list'."
|
|||
(member major-mode helm-comint-mode-list))
|
||||
(helm :sources 'helm-source-comint-input-ring
|
||||
:input (buffer-substring-no-properties (comint-line-beginning-position)
|
||||
(pos-eol))
|
||||
(point-at-eol))
|
||||
:buffer "*helm comint history*")))
|
||||
|
||||
(provide 'helm-comint)
|
||||
413
org/elpa/helm-20221107.1658/helm-command.el
Normal file
413
org/elpa/helm-20221107.1658/helm-command.el
Normal file
|
|
@ -0,0 +1,413 @@
|
|||
;;; 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
|
||||
|
|
@ -1,9 +1,6 @@
|
|||
;;; nerd-icons-data-ipsicon.el --- glyphset ipsicon -*- lexical-binding: t -*-
|
||||
;;; helm-config.el --- Applications library for `helm.el' -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2023 Hongyu Ding <rainstormstudio@yahoo.com>
|
||||
|
||||
;; Author: Hongyu Ding <rainstormstudio@yahoo.com>
|
||||
;; Keywords: lisp
|
||||
;; 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
|
||||
|
|
@ -19,20 +16,17 @@
|
|||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; ipsicon
|
||||
;; from Nerd Font Version: 3.0.1
|
||||
;;
|
||||
;; 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:
|
||||
|
||||
(defvar nerd-icons/ipsicon-alist
|
||||
'(
|
||||
("nf-iec-power" . "\x23fb")
|
||||
("nf-iec-power_off" . "\x2b58")
|
||||
("nf-iec-power_on" . "\x23fd")
|
||||
("nf-iec-sleep_mode" . "\x23fe")
|
||||
("nf-iec-toggle_power" . "\x23fc")
|
||||
))
|
||||
;;; Load the autoload file generated by the make file.
|
||||
|
||||
(provide 'nerd-icons-data-ipsicon)
|
||||
;;; nerd-icons-data-ipsicon.el ends here
|
||||
(load "helm-autoloads" nil t)
|
||||
|
||||
(provide 'helm-config)
|
||||
|
||||
;;; helm-config.el ends here
|
||||
388
org/elpa/helm-20221107.1658/helm-dabbrev.el
Normal file
388
org/elpa/helm-20221107.1658/helm-dabbrev.el
Normal file
|
|
@ -0,0 +1,388 @@
|
|||
;;; 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
Normal file
483
org/elpa/helm-20221107.1658/helm-elisp-package.el
Normal file
|
|
@ -0,0 +1,483 @@
|
|||
;;; helm-elisp-package.el --- helm interface for package.el -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2012 ~ 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
Normal file
1050
org/elpa/helm-20221107.1658/helm-elisp.el
Normal file
File diff suppressed because it is too large
Load diff
254
org/elpa/helm-20221107.1658/helm-epa.el
Normal file
254
org/elpa/helm-20221107.1658/helm-epa.el
Normal file
|
|
@ -0,0 +1,254 @@
|
|||
;;; 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
Normal file
494
org/elpa/helm-20221107.1658/helm-eshell.el
Normal file
|
|
@ -0,0 +1,494 @@
|
|||
;;; 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
Normal file
215
org/elpa/helm-20221107.1658/helm-eval.el
Normal file
|
|
@ -0,0 +1,215 @@
|
|||
;;; 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
|
||||
Some files were not shown because too many files have changed in this diff Show more
Reference in a new issue