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

update packages / add markdown preview mode packages

This commit is contained in:
KemoNine 2022-08-25 11:13:38 -04:00
parent d5f257ce5a
commit d2f3af9076
191 changed files with 163753 additions and 406 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

829
code/elpa/archives/melpa/archive-contents
View File

File diff suppressed because it is too large Load Diff

132
code/elpa/doom-modeline-20220816.1627/doom-modeline-autoloads.el Normal file
View File

@ -0,0 +1,132 @@
;;; 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)
(autoload 'doom-modeline-set-minimal-modeline "doom-modeline" "\
Set minimal mode-line." nil nil)
(autoload 'doom-modeline-set-special-modeline "doom-modeline" "\
Set special mode-line." nil nil)
(autoload 'doom-modeline-set-project-modeline "doom-modeline" "\
Set project mode-line." nil nil)
(autoload 'doom-modeline-set-dashboard-modeline "doom-modeline" "\
Set dashboard mode-line." nil nil)
(autoload 'doom-modeline-set-vcs-modeline "doom-modeline" "\
Set vcs mode-line." nil nil)
(autoload 'doom-modeline-set-info-modeline "doom-modeline" "\
Set Info mode-line." nil nil)
(autoload 'doom-modeline-set-package-modeline "doom-modeline" "\
Set package mode-line." nil nil)
(autoload 'doom-modeline-set-media-modeline "doom-modeline" "\
Set media mode-line." nil nil)
(autoload 'doom-modeline-set-message-modeline "doom-modeline" "\
Set message mode-line." nil nil)
(autoload 'doom-modeline-set-pdf-modeline "doom-modeline" "\
Set pdf mode-line." nil nil)
(autoload 'doom-modeline-set-org-src-modeline "doom-modeline" "\
Set org-src mode-line." nil nil)
(autoload 'doom-modeline-set-helm-modeline "doom-modeline" "\
Set helm mode-line.
\(fn &rest _)" nil nil)
(autoload 'doom-modeline-set-timemachine-modeline "doom-modeline" "\
Set timemachine mode-line." 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-mode-map"))
;;;***
;;;### (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

1378
code/elpa/doom-modeline-20220816.1627/doom-modeline-core.el Normal file
View File

File diff suppressed because it is too large Load Diff

275
code/elpa/doom-modeline-20220816.1627/doom-modeline-env.el Normal file
View File

@ -0,0 +1,275 @@
;;; 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)))"
(let ((proc (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
code/elpa/doom-modeline-20220816.1627/doom-modeline-pkg.el Normal file
View File

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

2962
code/elpa/doom-modeline-20220816.1627/doom-modeline-segments.el Normal file
View File

File diff suppressed because it is too large Load Diff

305
code/elpa/doom-modeline-20220816.1627/doom-modeline.el Normal file
View File

@ -0,0 +1,305 @@
;;; 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.2
;; 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)
'(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)
'(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)
'(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)
'(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)
'(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)
'(misc-info major-mode process time))
(doom-modeline-def-modeline 'info
'(bar window-number buffer-info info-nodes buffer-position parrot selection-info)
'(misc-info buffer-encoding major-mode time))
(doom-modeline-def-modeline 'media
'(bar window-number buffer-size buffer-info)
'(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)
'(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)
'(misc-info major-mode process vcs time))
(doom-modeline-def-modeline 'org-src
'(bar window-number modals matches buffer-info-simple buffer-position word-count parrot selection-info)
'(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))
;;
;; 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))
;;;###autoload
(defun doom-modeline-set-minimal-modeline ()
"Set minimal mode-line."
(doom-modeline-set-modeline 'minimal))
;;;###autoload
(defun doom-modeline-set-special-modeline ()
"Set special mode-line."
(doom-modeline-set-modeline 'special))
;;;###autoload
(defun doom-modeline-set-project-modeline ()
"Set project mode-line."
(doom-modeline-set-modeline 'project))
;;;###autoload
(defun doom-modeline-set-dashboard-modeline ()
"Set dashboard mode-line."
(doom-modeline-set-modeline 'dashboard))
;;;###autoload
(defun doom-modeline-set-vcs-modeline ()
"Set vcs mode-line."
(doom-modeline-set-modeline 'vcs))
;;;###autoload
(defun doom-modeline-set-info-modeline ()
"Set Info mode-line."
(doom-modeline-set-modeline 'info))
;;;###autoload
(defun doom-modeline-set-package-modeline ()
"Set package mode-line."
(doom-modeline-set-modeline 'package))
;;;###autoload
(defun doom-modeline-set-media-modeline ()
"Set media mode-line."
(doom-modeline-set-modeline 'media))
;;;###autoload
(defun doom-modeline-set-message-modeline ()
"Set message mode-line."
(doom-modeline-set-modeline 'message))
;;;###autoload
(defun doom-modeline-set-pdf-modeline ()
"Set pdf mode-line."
(doom-modeline-set-modeline 'pdf))
;;;###autoload
(defun doom-modeline-set-org-src-modeline ()
"Set org-src mode-line."
(doom-modeline-set-modeline 'org-src))
;;;###autoload
(defun doom-modeline-set-helm-modeline (&rest _) ; To advice helm
"Set helm mode-line."
(doom-modeline-set-modeline 'helm))
;;;###autoload
(defun doom-modeline-set-timemachine-modeline ()
"Set timemachine mode-line."
(doom-modeline-set-modeline 'timemachine))
;;
;; Minor mode
;;
(defvar doom-modeline-mode-map (make-sparse-keymap))
;; Suppress warnings
(defvar 2C-mode-line-format)
(declare-function helm-display-mode-line "ext:helm-core")
;;;###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
(doom-modeline-set-main-modeline)))
;; For two-column editing
(setq 2C-mode-line-format (doom-modeline 'special))
;; Add hooks
(add-hook 'Info-mode-hook #'doom-modeline-set-info-modeline)
(add-hook 'dired-mode-hook #'doom-modeline-set-project-modeline)
(add-hook 'dashboard-mode-hook #'doom-modeline-set-dashboard-modeline)
(add-hook 'image-mode-hook #'doom-modeline-set-media-modeline)
(add-hook 'message-mode-hook #'doom-modeline-set-message-modeline)
(add-hook 'git-commit-mode-hook #'doom-modeline-set-message-modeline)
(add-hook 'magit-mode-hook #'doom-modeline-set-vcs-modeline)
(add-hook 'circe-mode-hook #'doom-modeline-set-special-modeline)
(add-hook 'erc-mode-hook #'doom-modeline-set-special-modeline)
(add-hook 'rcirc-mode-hook #'doom-modeline-set-special-modeline)
(add-hook 'pdf-view-mode-hook #'doom-modeline-set-pdf-modeline)
(add-hook 'org-src-mode-hook #'doom-modeline-set-org-src-modeline)
(add-hook 'git-timemachine-mode-hook #'doom-modeline-set-timemachine-modeline)
(add-hook 'paradox-menu-mode-hook #'doom-modeline-set-package-modeline)
(add-hook 'xwidget-webkit-mode-hook #'doom-modeline-set-minimal-modeline)
;; Add advices
(advice-add #'helm-display-mode-line :after #'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))
;; Remove hooks
(remove-hook 'Info-mode-hook #'doom-modeline-set-info-modeline)
(remove-hook 'dired-mode-hook #'doom-modeline-set-project-modeline)
(remove-hook 'dashboard-mode-hook #'doom-modeline-set-dashboard-modeline)
(remove-hook 'image-mode-hook #'doom-modeline-set-media-modeline)
(remove-hook 'message-mode-hook #'doom-modeline-set-message-modeline)
(remove-hook 'git-commit-mode-hook #'doom-modeline-set-message-modeline)
(remove-hook 'magit-mode-hook #'doom-modeline-set-vcs-modeline)
(remove-hook 'circe-mode-hook #'doom-modeline-set-special-modeline)
(remove-hook 'erc-mode-hook #'doom-modeline-set-special-modeline)
(remove-hook 'rcirc-mode-hook #'doom-modeline-set-special-modeline)
(remove-hook 'pdf-view-mode-hook #'doom-modeline-set-pdf-modeline)
(remove-hook 'org-src-mode-hook #'doom-modeline-set-org-src-modeline)
(remove-hook 'git-timemachine-mode-hook #'doom-modeline-set-timemachine-modeline)
(remove-hook 'paradox-menu-mode-hook #'doom-modeline-set-package-modeline)
(remove-hook 'xwidget-webkit-mode-hook #'doom-modeline-set-minimal-modeline)
;; Remove advices
(advice-remove #'helm-display-mode-line #'doom-modeline-set-helm-modeline))))
(provide 'doom-modeline)
;;; doom-modeline.el ends here

26
code/elpa/f-20220814.1054/f-autoloads.el Normal file
View File

@ -0,0 +1,26 @@
;;; f-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 "f" "f.el" (0 0 0 0))
;;; Generated autoloads from f.el
(register-definition-prefixes "f" '("f-"))
;;;***
;;;### (autoloads nil nil ("f-pkg.el" "f-shortdoc.el") (0 0 0 0))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; coding: utf-8
;; End:
;;; f-autoloads.el ends here

14
code/elpa/f-20220814.1054/f-pkg.el Normal file
View File

@ -0,0 +1,14 @@
(define-package "f" "20220814.1054" "Modern API for working with files and directories"
'((emacs "24.1")
(s "1.7.0")
(dash "2.2.0"))
:commit "85c91f95f8b98e153fd959ae467b46bf79622c5d" :authors
'(("Johan Andersson" . "johan.rejeep@gmail.com"))
:maintainer
'("Lucien Cartier-Tilet" . "lucien@phundrak.com")
:keywords
'("files" "directories")
:url "http://github.com/rejeep/f.el")
;; Local Variables:
;; no-byte-compile: t
;; End:

379
code/elpa/f-20220814.1054/f-shortdoc.el Normal file
View File

@ -0,0 +1,379 @@
;; -*- no-byte-compile: t; -*-
;;; f-shortdoc.el --- Shortdoc for f.el -*- lexical-binding: t -*-
;; Author: Lucien Cartier-Tilet <lucien@phundrak.com>
;; Maintainer: Lucien Cartier-Tilet <lucien@phundrak.com>
;; Version: 0.1.0
;; Package-Requires: ((emacs "28.1"))
;; Homepage: https://github.com/rejeep/f.el
;; 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:
;; Shortdoc implementation for f.el
;;; Code:
(when (version<= "28.1" emacs-version)
(require 'shortdoc)
(define-short-documentation-group f
"Paths"
(f-join
:eval (f-join "path")
:eval (f-join "path" "to")
:eval (f-join "/" "path" "to" "heaven")
:eval (f-join "path" "/to" "file"))
(f-split
:eval (f-split "path")
:eval (f-split "path/to")
:eval (f-split "/path/to/heaven")
:eval (f-split "~/back/to/earth"))
(f-expand
:no-eval (f-expand "name")
:result-string "/default/directory/name"
:no-eval (f-expand "name" "other/directory")
:result-string "other/directory/name")
(f-filename
:eval (f-filename "path/to/file.ext")
:eval (f-filename "path/to/directory"))
(f-dirname
:eval (f-dirname "path/to/file.ext")
:eval (f-dirname "path/to/directory")
:eval (f-dirname "/"))
(f-common-parent
:eval (f-common-parent '("foo/bar/baz" "foo/bar/qux" "foo/bar/mux"))
:eval (f-common-parent '("/foo/bar/baz" "/foo/bar/qux" "/foo/bax/mux"))
:eval (f-common-parent '("foo/bar/baz" "quack/bar/qux" "lack/bar/mux")))
(f-ext
:eval (f-ext "path/to/file")
:eval (f-ext "path/to/file.txt")
:eval (f-ext "path/to/file.txt.org"))
(f-no-ext
:eval (f-no-ext "path/to/file")
:eval (f-no-ext "path/to/file.txt")
:eval (f-no-ext "path/to/file.txt.org"))
(f-swap-ext
:eval (f-swap-ext "path/to/file.ext" "org"))
(f-base
:eval (f-base "path/to/file.ext")
:eval (f-base "path/to/directory"))
(f-relative
:eval (f-relative "/some/path/relative/to/my/file.txt" "/some/path/")
:eval (f-relative "/default/directory/my/file.txt"))
(f-short
:no-eval (f-short "/Users/foo/Code/on/macOS")
:result-string "~/Code/on/macOS"
:no-eval (f-short "/home/foo/Code/on/linux")
:result-string "~/Code/on/linux"
:eval (f-short "/path/to/Code/bar"))
(f-long
:eval (f-long "~/Code/bar")
:eval (f-long "/path/to/Code/bar"))
(f-canonical
:eval (f-canonical "/path/to/real/file")
:no-eval (f-canonical "/link/to/file")
:result-string "/path/to/real/file")
(f-slash
:no-eval (f-slash "/path/to/file")
:result-string "/path/to/file"
:no-eval (f-slash "/path/to/dir")
:result-string "/path/to/dir/"
:no-eval (f-slash "/path/to/dir/")
:result-string "/path/to/dir/")
(f-full
:eval (f-full "~/path/to/file")
:eval (f-full "~/path/to/dir")
:eval (f-full "~/path/to/dir/"))
(f-uniquify
:eval (f-uniquify '("/foo/bar" "/foo/baz" "/foo/quux"))
:eval (f-uniquify '("/foo/bar" "/www/bar" "/foo/quux"))
:eval (f-uniquify '("/foo/bar" "/www/bar" "/www/bar/quux"))
:eval (f-uniquify '("/foo/bar" "/foo/baz" "/home/www/bar" "/home/www/baz" "/var/foo" "/opt/foo/www/baz")))
(f-uniquify-alist
:eval (f-uniquify-alist '("/foo/bar" "/foo/baz" "/foo/quux"))
:eval (f-uniquify-alist '("/foo/bar" "/www/bar" "/foo/quux"))
:eval (f-uniquify-alist '("/foo/bar" "/www/bar" "/www/bar/quux"))
:eval (f-uniquify-alist '("/foo/bar" "/foo/baz" "/home/www/bar" "/home/www/baz" "/var/foo" "/opt/foo/www/baz")))
"I/O"
(f-read-bytes
:no-eval* (f-read-bytes "path/to/binary/data"))
(f-write-bytes
:no-eval* (f-write-bytes (unibyte-string 72 101 108 108 111 32 119 111 114 108 100) "path/to/binary/data"))
(f-append-bytes
:no-eval* (f-append-bytes "path/to/file" (unibyte-string 72 101 108 108 111 32 119 111 114 108 100)))
(f-read-text
:no-eval* (f-read-text "path/to/file.txt" 'utf-8)
:no-eval* (f-read "path/to/file.txt" 'utf-8))
(f-write-text
:no-eval* (f-write-text "Hello world" 'utf-8 "path/to/file.txt")
:no-eval* (f-write "Hello world" 'utf-8 "path/to/file.txt"))
(f-append-text
:no-eval* (f-append-text "Hello world" 'utf-8 "path/to/file.txt")
:no-eval* (f-append "Hello world" 'utf-8 "path/to/file.txt"))
"Destructive"
(f-mkdir
:no-eval (f-mkdir "dir")
:result-string "creates /default/directory/dir"
:no-eval (f-mkdir "other" "dir")
:result-string "creates /default/directory/other/dir"
:no-eval (f-mkdir "/" "some" "path")
:result-string "creates /some/path"
:no-eval (f-mkdir "~" "yet" "another" "dir")
:result-string "creates ~/yet/another/dir")
(f-mkdir-full-path
:no-eval (f-mkdir-full-path "dir")
:result-string "creates /default/directory/dir"
:no-eval (f-mkdir-full-path "other/dir")
:result-string "creates /default/directory/other/dir"
:no-eval (f-mkdir-full-path "/some/path")
:result-string "creates /some/path"
:no-eval (f-mkdir-full-path "~/yet/another/dir")
:result-string "creates ~/yet/another/dir")
(f-delete
:no-eval* (f-delete "dir")
:no-eval* (f-delete "other/dir" t)
:no-eval* (f-delete "path/to/file.txt"))
(f-symlink
:no-eval* (f-symlink "path/to/source" "path/to/link"))
(f-move
:no-eval* (f-move "path/to/file.txt" "new-file.txt")
:no-eval* (f-move "path/to/file.txt" "other/path"))
(f-copy
:no-eval* (f-copy "path/to/file.txt" "new-file.txt")
:no-eval* (f-copy "path/to/dir" "other/dir"))
(f-copy-contents
:no-eval* (f-copy-contents "path/to/dir" "path/to/other/dir"))
(f-touch
:no-eval* (f-touch "path/to/existing/file.txt")
:no-eval* (f-touch "path/to/non/existing/file.txt"))
"Predicates"
(f-exists-p
:no-eval* (f-exists-p "path/to/file.txt")
:no-eval* (f-exists-p "path/to/dir"))
(f-directory-p
:no-eval* (f-directory-p "path/to/file.txt")
:no-eval* (f-directory-p "path/to/dir"))
(f-file-p
:no-eval* (f-file-p "path/to/file.txt")
:no-eval* (f-file-p "path/to/dir"))
(f-symlink-p
:no-eval* (f-symlink-p "path/to/file.txt")
:no-eval* (f-symlink-p "path/to/dir")
:no-eval* (f-symlink-p "path/to/link"))
(f-readable-p
:no-eval* (f-readable-p "path/to/file.txt")
:no-eval* (f-readable-p "path/to/dir"))
(f-writable-p
:no-eval* (f-writable-p "path/to/file.txt")
:no-eval* (f-writable-p "path/to/dir"))
(f-executable-p
:no-eval* (f-executable-p "path/to/file.txt")
:no-eval* (f-executable-p "path/to/dir"))
(f-absolute-p
:eval (f-absolute-p "path/to/dir")
:eval (f-absolute-p "/full/path/to/dir"))
(f-relative-p
:eval (f-relative-p "path/to/dir")
:eval (f-relative-p "/full/path/to/dir"))
(f-root-p
:eval (f-root-p "/")
:eval (f-root-p "/not/root"))
(f-ext-p
:eval (f-ext-p "path/to/file.el" "el")
:eval (f-ext-p "path/to/file.el" "txt")
:eval (f-ext-p "path/to/file.el")
:eval (f-ext-p "path/to/file"))
(f-same-p
:eval (f-same-p "foo.txt" "foo.txt")
:eval (f-same-p "foo/bar/../baz" "foo/baz")
:eval (f-same-p "/path/to/foo.txt" "/path/to/bar.txt"))
(f-parent-of-p
:no-eval (f-parent-of-p "/path/to" "/path/to/dir")
:result t
:no-eval (f-parent-of-p "/path/to/dir" "/path/to")
:result nil
:no-eval (f-parent-of-p "/path/to" "/path/to")
:result nil)
(f-child-of-p
:no-eval (f-child-of-p "/path/to" "/path/to/dir")
:result nil
:no-eval (f-child-of-p "/path/to/dir" "/path/to")
:result t
:no-eval (f-child-of-p "/path/to" "/path/to")
:result nil)
(f-ancestor-of-p
:no-eval (f-ancestor-of-p "/path/to" "/path/to/dir")
:result t
:no-eval (f-ancestor-of-p "/path" "/path/to/dir")
:result t
:no-eval (f-ancestor-of-p "/path/to/dir" "/path/to")
:result nil
:no-eval (f-ancestor-of-p "/path/to" "/path/to")
:result nil)
(f-descendant-of-p
:no-eval (f-descendant-of-p "/path/to/dir" "/path/to")
:result t
:no-eval (f-descendant-of-p "/path/to/dir" "/path")
:result t
:no-eval (f-descendant-of-p "/path/to" "/path/to/dir")
:result nil
:no-eval (f-descendant-of-p "/path/to" "/path/to")
:result nil)
(f-hidden-p
:no-eval (f-hidden-p "/path/to/foo")
:result nil
:no-eval (f-hidden-p "/path/to/.foo")
:result t)
(f-empty-p
:no-eval (f-empty-p "/path/to/empty-file")
:result t
:no-eval (f-empty-p "/path/to/file-with-contents")
:result nil
:no-eval (f-empty-p "/path/to/empty-dir/")
:result t
:no-eval (f-empty-p "/path/to/dir-with-contents/")
:result nil)
"Stats"
(f-size
:no-eval* (f-size "path/to/file.txt")
:no-eval* (f-size "path/to/dir"))
(f-depth
:eval (f-depth "/")
:eval (f-depth "/var/")
:eval (f-depth "/usr/local/bin"))
(f-change-time
:no-eval* (f-change-time "path/to/file.txt")
:no-eval* (f-change-time "path/to/dir"))
(f-modification-time
: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")
:no-eval* (f-access-time "path/to/dir"))
"Misc"
(f-this-file
:no-eval* (f-this-file))
(f-path-separator
:eval (f-path-separator))
(f-glob
:noeval* (f-glob "path/to/*.el")
:noeval* (f-glob "*.el" "path/to"))
(f-entries
:no-eval* (f-entries "path/to/dir")
:no-eval* (f-entries "path/to/dir" (lambda (file) (s-matches? "test" file)))
:no-eval* (f-entries "path/to/dir" nil t)
:no-eval* (f--entries "path/to/dir" (s-matches? "test" it)))
(f-directories
:no-eval* (f-directories "path/to/dir")
:no-eval* (f-directories "path/to/dir" (lambda (dir) (equal (f-filename dir) "test")))
:no-eval* (f-directories "path/to/dir" nil t)
:no-eval* (f--directories "path/to/dir" (equal (f-filename it) "test")))
(f-files
:no-eval* (f-files "path/to/dir")
:no-eval* (f-files "path/to/dir" (lambda (file) (equal (f-ext file) "el")))
:no-eval* (f-files "path/to/dir" nil t)
:no-eval* (f--files "path/to/dir" (equal (f-ext it) "el")))
(f-root
:eval (f-root))
(f-traverse-upwards
:no-eval* (f-traverse-upwards
(lambda (path)
(f-exists? (f-expand ".git" path)))
start-path)
:no-eval* (f--traverse-upwards (f-exists? (f-expand ".git" it)) start-path))
(f-with-sandbox
:no-eval (f-with-sandbox foo-path
(f-touch (f-expand "foo" foo-path)))
:no-eval (f-with-sandbox (list foo-path bar-path)
(f-touch (f-expand "foo" foo-path))
(f-touch (f-expand "bar" bar-path)))
:no-eval (f-with-sandbox foo-path
(f-touch (f-expand "bar" bar-path)))))) ;; "Destructive operation outside sandbox"
(eval-when-compile
(when (version< emacs-version "28.1")
(warn "Emacs should not be compiling this file")))
(provide 'f-shortdoc)
;;; f-shortdoc.el ends here

646
code/elpa/f-20220814.1054/f.el Normal file
View File

@ -0,0 +1,646 @@
;;; f.el --- Modern API for working with files and directories -*- lexical-binding: t; -*-
;; Copyright (C) 2013 Johan Andersson
;; Author: Johan Andersson <johan.rejeep@gmail.com>
;; Maintainer: Lucien Cartier-Tilet <lucien@phundrak.com>
;; Version: 0.20.0
;; Package-Requires: ((emacs "24.1") (s "1.7.0") (dash "2.2.0"))
;; Keywords: files, directories
;; Homepage: http://github.com/rejeep/f.el
;; This file is NOT part of GNU Emacs.
;;; License:
;; 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, 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 GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Code:
(require 's)
(require 'dash)
(when (version<= "28.1" emacs-version)
(require 'f-shortdoc))
(put 'f-guard-error 'error-conditions '(error f-guard-error))
(put 'f-guard-error 'error-message "Destructive operation outside sandbox")
(defvar f--guard-paths nil
"List of allowed paths to modify when guarded.
Do not modify this variable.")
(defmacro f--destructive (path &rest body)
"If PATH is allowed to be modified, yield BODY.
If PATH is not allowed to be modified, throw error."
(declare (indent 1))
`(if f--guard-paths
(if (--any? (or (f-same-p it ,path)
(f-ancestor-of-p it ,path)) f--guard-paths)
(progn ,@body)
(signal 'f-guard-error (list ,path f--guard-paths)))
,@body))
;;;; Paths
(defun f-join (&rest args)
"Join ARGS to a single path.
Be aware if one of the arguments is an absolute path, `f-join'
will discard all the preceeding arguments and make this absolute
path the new root of the generated path."
(let (path
(relative (f-relative-p (car args))))
(-map
(lambda (arg)
(setq path (cond ((not path) arg)
((f-absolute-p arg)
(progn
(setq relative nil)
arg))
(t (f-expand arg path)))))
args)
(if relative (f-relative path) path)))
(defun f-split (path)
"Split PATH and return list containing parts."
(let ((parts (split-string path (f-path-separator) 'omit-nulls)))
(if (string= (s-left 1 path) (f-path-separator))
(push (f-path-separator) parts)
parts)))
(defun f-expand (path &optional dir)
"Expand PATH relative to DIR (or `default-directory').
PATH and DIR can be either a directory names or directory file
names. Return a directory name if PATH is a directory name, and
a directory file name otherwise. File name handlers are
ignored."
(let (file-name-handler-alist)
(expand-file-name path dir)))
(defun f-filename (path)
"Return the name of PATH."
(file-name-nondirectory (directory-file-name path)))
(defalias 'f-parent 'f-dirname)
(defun f-dirname (path)
"Return the parent directory to PATH."
(let ((parent (file-name-directory
(directory-file-name (f-expand path default-directory)))))
(unless (f-same-p path parent)
(if (f-relative-p path)
(f-relative parent)
(directory-file-name parent)))))
(defun f-common-parent (paths)
"Return the deepest common parent directory of PATHS."
(cond
((not paths) nil)
((not (cdr paths)) (f-parent (car paths)))
(:otherwise
(let* ((paths (-map 'f-split paths))
(common (caar paths))
(re nil))
(while (and (not (null (car paths))) (--all? (equal (car it) common) paths))
(setq paths (-map 'cdr paths))
(push common re)
(setq common (caar paths)))
(cond
((null re) "")
((and (= (length re) 1) (f-root-p (car re)))
(f-root))
(:otherwise
(concat (apply 'f-join (nreverse re)) "/")))))))
(defalias 'f-ext 'file-name-extension)
(defalias 'f-no-ext 'file-name-sans-extension)
(defun f-swap-ext (path ext)
"Return PATH but with EXT as the new extension.
EXT must not be nil or empty."
(if (s-blank-p ext)
(error "Extension cannot be empty or nil")
(concat (f-no-ext path) "." ext)))
(defun f-base (path)
"Return the name of PATH, excluding the extension of file."
(f-no-ext (f-filename path)))
(defalias 'f-relative 'file-relative-name)
(defalias 'f-short 'abbreviate-file-name)
(defalias 'f-abbrev 'abbreviate-file-name)
(defun f-long (path)
"Return long version of PATH."
(f-expand path))
(defalias 'f-canonical 'file-truename)
(defun f-slash (path)
"Append slash to PATH unless one already.
Some functions, such as `call-process' requires there to be an
ending slash."
(if (f-dir-p path)
(file-name-as-directory path)
path))
(defun f-full (path)
"Return absolute path to PATH, with ending slash."
(f-slash (f-long path)))
(defun f--uniquify (paths)
"Helper for `f-uniquify' and `f-uniquify-alist'."
(let* ((files-length (length paths))
(uniq-filenames (--map (cons it (f-filename it)) paths))
(uniq-filenames-next (-group-by 'cdr uniq-filenames)))
(while (/= files-length (length uniq-filenames-next))
(setq uniq-filenames-next
(-group-by 'cdr
(--mapcat
(let ((conf-files (cdr it)))
(if (> (length conf-files) 1)
(--map (cons
(car it)
(concat
(f-filename (s-chop-suffix (cdr it)
(car it)))
(f-path-separator) (cdr it)))
conf-files)
conf-files))
uniq-filenames-next))))
uniq-filenames-next))
(defun f-uniquify (files)
"Return unique suffixes of FILES.
This function expects no duplicate paths."
(-map 'car (f--uniquify files)))
(defun f-uniquify-alist (files)
"Return alist mapping FILES to unique suffixes of FILES.
This function expects no duplicate paths."
(-map 'cadr (f--uniquify files)))
;;;; I/O
(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."
(with-temp-buffer
(set-buffer-multibyte nil)
(setq buffer-file-coding-system 'binary)
(insert-file-contents-literally path nil beg end)
(buffer-substring-no-properties (point-min) (point-max))))
(defalias 'f-read 'f-read-text)
(defun f-read-text (path &optional coding)
"Read text with PATH, using CODING.
CODING defaults to `utf-8'.
Return the decoded text as multibyte string."
(decode-coding-string (f-read-bytes path) (or coding 'utf-8)))
(defalias 'f-write 'f-write-text)
(defun f-write-text (text coding path)
"Write TEXT with CODING to PATH.
TEXT is a multibyte string. CODING is a coding system to encode
TEXT with. PATH is a file name to write to."
(f-write-bytes (encode-coding-string text coding) path))
(defun f-unibyte-string-p (s)
"Determine whether S is a unibyte string."
(not (multibyte-string-p s)))
(defun f-write-bytes (data path)
"Write binary DATA to PATH.
DATA is a unibyte string. PATH is a file name to write to."
(f--write-bytes data path nil))
(defalias 'f-append 'f-append-text)
(defun f-append-text (text coding path)
"Append TEXT with CODING to PATH.
If PATH does not exist, it is created."
(f-append-bytes (encode-coding-string text coding) path))
(defun f-append-bytes (data path)
"Append binary DATA to PATH.
If PATH does not exist, it is created."
(f--write-bytes data path :append))
(defun f--write-bytes (data filename append)
"Write binary DATA to FILENAME.
If APPEND is non-nil, append the DATA to the existing contents."
(f--destructive filename
(unless (f-unibyte-string-p data)
(signal 'wrong-type-argument (list 'f-unibyte-string-p data)))
(let ((coding-system-for-write 'binary)
(write-region-annotate-functions nil)
(write-region-post-annotation-function nil))
(write-region data nil filename append :silent)
nil)))
;;;; Destructive
(defun f-mkdir (&rest dirs)
"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
formed path is using `f-split' alongside it:
(apply #\\='f-mkdir (f-split \"path/to/file\"))
Although it works sometimes, it is not recommended to use fully
formed paths in the function. In this case, it is recommended to
use `f-mkdir-full-path' instead."
(let (path)
(-each
dirs
(lambda (dir)
(setq path (f-expand dir path))
(unless (f-directory-p path)
(f--destructive path (make-directory path)))))))
(defun f-mkdir-full-path (dir)
"Create DIR from a full path.
This function is similar to `f-mkdir' except it can accept a full
path instead of requiring several successive directory names."
(apply #'f-mkdir (f-split dir)))
(defun f-delete (path &optional force)
"Delete PATH, which can be file or directory.
If FORCE is t, a directory will be deleted recursively."
(f--destructive path
(if (or (f-file-p path) (f-symlink-p path))
(delete-file path)
(delete-directory path force))))
(defun f-symlink (source path)
"Create a symlink to SOURCE from PATH."
(f--destructive path (make-symbolic-link source path)))
(defun f-move (from to)
"Move or rename FROM to TO.
If TO is a directory name, move FROM into TO."
(f--destructive to (rename-file from to t)))
(defun f-copy (from to)
"Copy file or directory FROM to TO.
If FROM names a directory and TO is a directory name, copy FROM
into TO as a subdirectory."
(f--destructive to
(if (f-file-p from)
(copy-file from to)
;; The behavior of `copy-directory' differs between Emacs 23 and
;; 24 in that in Emacs 23, the contents of `from' is copied to
;; `to', while in Emacs 24 the directory `from' is copied to
;; `to'. We want the Emacs 24 behavior.
(if (> emacs-major-version 23)
(copy-directory from to)
(if (f-dir-p to)
(progn
(apply 'f-mkdir (f-split to))
(let ((new-to (f-expand (f-filename from) to)))
(copy-directory from new-to)))
(copy-directory from to))))))
(defun f-copy-contents (from to)
"Copy contents in directory FROM, to directory TO."
(unless (f-exists-p to)
(error "Cannot copy contents to non existing directory %s" to))
(unless (f-dir-p from)
(error "Cannot copy contents as %s is a file" from))
(--each (f-entries from)
(f-copy it (file-name-as-directory to))))
(defun f-touch (path)
"Update PATH last modification date or create if it does not exist."
(f--destructive path
(if (f-file-p path)
(set-file-times path)
(f-write-bytes "" path))))
;;;; Predicates
(defalias 'f-exists-p 'file-exists-p)
(defalias 'f-exists? 'file-exists-p)
(defalias 'f-directory-p 'file-directory-p)
(defalias 'f-directory? 'file-directory-p)
(defalias 'f-dir-p 'file-directory-p)
(defalias 'f-dir? 'file-directory-p)
(defalias 'f-file-p 'file-regular-p)
(defalias 'f-file? 'file-regular-p)
(defun f-symlink-p (path)
"Return t if PATH is symlink, false otherwise."
(not (not (file-symlink-p path))))
(defalias 'f-symlink? 'f-symlink-p)
(defalias 'f-readable-p 'file-readable-p)
(defalias 'f-readable? 'file-readable-p)
(defalias 'f-writable-p 'file-writable-p)
(defalias 'f-writable? 'file-writable-p)
(defalias 'f-executable-p 'file-executable-p)
(defalias 'f-executable? 'file-executable-p)
(defalias 'f-absolute-p 'file-name-absolute-p)
(defalias 'f-absolute? 'file-name-absolute-p)
(defun f-relative-p (path)
"Return t if PATH is relative, false otherwise."
(not (f-absolute-p path)))
(defalias 'f-relative? 'f-relative-p)
(defun f-root-p (path)
"Return t if PATH is root directory, false otherwise."
(not (f-parent path)))
(defalias 'f-root? 'f-root-p)
(defun f-ext-p (path &optional ext)
"Return t if extension of PATH is EXT, false otherwise.
If EXT is nil or omitted, return t if PATH has any extension,
false otherwise.
The extension, in a file name, is the part that follows the last
'.', excluding version numbers and backup suffixes."
(if ext
(string= (f-ext path) ext)
(not (eq (f-ext path) nil))))
(defalias 'f-ext? 'f-ext-p)
(defalias 'f-equal-p 'f-same-p)
(defalias 'f-equal? 'f-same-p)
(defun f-same-p (path-a path-b)
"Return t if PATH-A and PATH-B are references to same file."
(equal
(f-canonical (directory-file-name (f-expand path-a)))
(f-canonical (directory-file-name (f-expand path-b)))))
(defalias 'f-same? 'f-same-p)
(defun f-parent-of-p (path-a path-b)
"Return t if PATH-A is parent of PATH-B."
(--when-let (f-parent path-b)
(f-same-p path-a it)))
(defalias 'f-parent-of? 'f-parent-of-p)
(defun f-child-of-p (path-a path-b)
"Return t if PATH-A is child of PATH-B."
(--when-let (f-parent path-a)
(f-same-p it path-b)))
(defalias 'f-child-of? 'f-child-of-p)
(defun f-ancestor-of-p (path-a path-b)
"Return t if PATH-A is ancestor of PATH-B."
(unless (f-same-p path-a path-b)
(string-prefix-p (f-full path-a)
(f-full path-b))))
(defalias 'f-ancestor-of? 'f-ancestor-of-p)
(defun f-descendant-of-p (path-a path-b)
"Return t if PATH-A is desendant of PATH-B."
(unless (f-same-p path-a path-b)
(string-prefix-p (f-full path-b)
(f-full path-a))))
(defalias 'f-descendant-of? 'f-descendant-of-p)
(defun f-hidden-p (path)
"Return t if PATH is hidden, nil otherwise."
(unless (f-exists-p path)
(error "Path does not exist: %s" path))
(string= (substring path 0 1) "."))
(defalias 'f-hidden? 'f-hidden-p)
(defun f-empty-p (path)
"If PATH is a file, return t if the file in PATH is empty, nil otherwise.
If PATH is directory, return t if directory has no files, nil otherwise."
(if (f-directory-p path)
(equal (f-files path nil t) nil)
(= (f-size path) 0)))
(defalias 'f-empty? 'f-empty-p)
;;;; Stats
(defun f-size (path)
"Return size of PATH.
If PATH is a file, return size of that file. If PATH is
directory, return sum of all files in PATH."
(if (f-directory-p path)
(-sum (-map 'f-size (f-files path nil t)))
(nth 7 (file-attributes path))))
(defun f-depth (path)
"Return the depth of PATH.
At first, PATH is expanded with `f-expand'. Then the full path is used to
detect the depth.
'/' will be zero depth, '/usr' will be one depth. And so on."
(- (length (f-split (f-expand path))) 1))
(defun f-change-time (path)
"Return the last status change time of PATH.
The status change time (ctime) of PATH in the same format as
`current-time'. See `file-attributes' for technical details."
(nth 6 (file-attributes path)))
(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'. See `file-attributes' for technical details."
(nth 5 (file-attributes path)))
(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'. See `file-attributes' for technical details."
(nth 4 (file-attributes path)))
;;;; Misc
(defun f-this-file ()
"Return path to this file."
(cond
(load-in-progress load-file-name)
((and (boundp 'byte-compile-current-file) byte-compile-current-file)
byte-compile-current-file)
(:else (buffer-file-name))))
(defvar f--path-separator nil
"A variable to cache result of `f-path-separator'.")
(defun f-path-separator ()
"Return path separator."
(or f--path-separator
(setq f--path-separator (substring (f-join "x" "y") 1 2))))
(defun f-glob (pattern &optional path)
"Find PATTERN in PATH."
(file-expand-wildcards
(f-join (or path default-directory) pattern)))
(defun f--collect-entries (path recursive)
(let (result
(entries
(-reject
(lambda (file)
(member (f-filename file) '("." "..")))
(directory-files path t))))
(cond (recursive
(-map
(lambda (entry)
(if (f-file-p entry)
(setq result (cons entry result))
(when (f-directory-p entry)
(setq result (cons entry result))
(if (f-readable-p entry)
(setq result (append result (f--collect-entries entry recursive)))
result))))
entries))
(t (setq result entries)))
result))
(defmacro f--entries (path body &optional recursive)
"Anaphoric version of `f-entries'."
`(f-entries
,path
(lambda (path)
(let ((it path))
,body))
,recursive))
(defun f-entries (path &optional fn recursive)
"Find all files and directories in PATH.
FN - called for each found file and directory. If FN returns a thruthy
value, file or directory will be included.
RECURSIVE - Search for files and directories recursive."
(let ((entries (f--collect-entries path recursive)))
(if fn (-select fn entries) entries)))
(defmacro f--directories (path body &optional recursive)
"Anaphoric version of `f-directories'."
`(f-directories
,path
(lambda (path)
(let ((it path))
,body))
,recursive))
(defun f-directories (path &optional fn recursive)
"Find all directories in PATH. See `f-entries'."
(let ((directories (-select 'f-directory-p (f--collect-entries path recursive))))
(if fn (-select fn directories) directories)))
(defmacro f--files (path body &optional recursive)
"Anaphoric version of `f-files'."
`(f-files
,path
(lambda (path)
(let ((it path))
,body))
,recursive))
(defun f-files (path &optional fn recursive)
"Find all files in PATH. See `f-entries'."
(let ((files (-select 'f-file-p (f--collect-entries path recursive))))
(if fn (-select fn files) files)))
(defmacro f--traverse-upwards (body &optional path)
"Anaphoric version of `f-traverse-upwards'."
`(f-traverse-upwards
(lambda (dir)
(let ((it dir))
,body))
,path))
(defun f-traverse-upwards (fn &optional path)
"Traverse up as long as FN return nil, starting at PATH.
If FN returns a non-nil value, the path sent as argument to FN is
returned. If no function callback return a non-nil value, nil is
returned."
(unless path
(setq path default-directory))
(when (f-relative-p path)
(setq path (f-expand path)))
(if (funcall fn path)
path
(unless (f-root-p path)
(f-traverse-upwards fn (f-parent path)))))
(defun f-root ()
"Return absolute root."
(f-traverse-upwards 'f-root-p))
(defmacro f-with-sandbox (path-or-paths &rest body)
"Only allow PATH-OR-PATHS and descendants to be modified in BODY."
(declare (indent 1))
`(let ((paths (if (listp ,path-or-paths)
,path-or-paths
(list ,path-or-paths))))
(unwind-protect
(let ((f--guard-paths paths))
,@body)
(setq f--guard-paths nil))))
(provide 'f)
;;; f.el ends here

8
code/elpa/helm-20220822.659/.dir-locals.el Normal file
View File

@ -0,0 +1,8 @@
;;; Directory Local Variables
;;; For more information see (info "(emacs) Directory Variables")
((nil . ((bug-reference-bug-regexp . "\\(\\b\\(?:[Ii]ssue ?#?\\|[Bb]ug ?#?\\|[Pp]atch ?#\\|RFE ?#\\|PR [a-z+-]+/\\)\\([0-9]+\\(?:#[0-9]+\\)?\\)\\)")
(bug-reference-url-format . "https://github.com/emacs-helm/helm/issues/%s")
(byte-compile-warnings . (not obsolete docstrings docstrings-non-ascii-quotes))))
(emacs-lisp-mode . ((mode . bug-reference-prog)
(indent-tabs-mode . nil))))

261
code/elpa/helm-20220822.659/emacs-helm.sh Normal file
View 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
code/elpa/helm-20220822.659/helm-adaptive.el Normal file
View 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

1173
code/elpa/helm-20220822.659/helm-autoloads.el Normal file
View File

File diff suppressed because it is too large Load Diff

830
code/elpa/helm-20220822.659/helm-bookmark.el Normal file
View File

@ -0,0 +1,830 @@
;;; 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)))))
(defun helm-bookmark-toggle-filename ()
"Toggle bookmark location visibility."
(interactive)
(with-helm-alive-p
(helm-set-attr 'toggle-filename
'(helm-bookmark-toggle-filename-1 . never-split))
(helm-execute-persistent-action 'toggle-filename)))
(put 'helm-bookmark-toggle-filename 'helm-only t)
(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)))
(defun helm-bookmark-run-browse-project ()
"Run `helm-bookmark-browse-project' from keyboard."
(interactive)
(with-helm-alive-p
(helm-exit-and-execute-action 'helm-bookmark-browse-project)))
(put 'helm-bookmark-run-browse-project 'helm-only t)
(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))
(defun helm-bookmark-run-edit ()
"Run `helm-bookmark-edit-bookmark' from keyboard."
(interactive)
(with-helm-alive-p
(helm-exit-and-execute-action 'helm-bookmark-edit-bookmark)))
(put 'helm-bookmark-run-edit 'helm-only t)
(defun helm-bookmark-run-jump-other-frame ()
"Jump to bookmark other frame from keyboard."
(interactive)
(with-helm-alive-p
(helm-exit-and-execute-action 'helm-bookmark-jump-other-frame)))
(put 'helm-bookmark-run-jump-other-frame 'helm-only t)
(defun helm-bookmark-run-jump-other-window ()
"Jump to bookmark from keyboard."
(interactive)
(with-helm-alive-p
(helm-exit-and-execute-action 'helm-bookmark-jump-other-window)))
(put 'helm-bookmark-run-jump-other-window 'helm-only t)
(defun helm-bookmark-run-delete ()
"Delete bookmark from keyboard."
(interactive)
(with-helm-alive-p
(when (y-or-n-p "Delete bookmark(s)?")
(helm-exit-and-execute-action 'helm-delete-marked-bookmarks))))
(put 'helm-bookmark-run-delete 'helm-only t)
(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

1238
code/elpa/helm-20220822.659/helm-buffers.el Normal file
View File

File diff suppressed because it is too large Load Diff

167
code/elpa/helm-20220822.659/helm-color.el Normal file
View File

@ -0,0 +1,167 @@
;;; 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)))
(defun helm-color-run-insert-name ()
"Insert name of color from `helm-source-colors'."
(interactive)
(with-helm-alive-p (helm-exit-and-execute-action 'helm-color-insert-name)))
(put 'helm-color-run-insert-name 'helm-only t)
(defun helm-color-run-kill-name ()
"Kill name of color from `helm-source-colors'."
(interactive)
(with-helm-alive-p (helm-exit-and-execute-action 'helm-color-kill-name)))
(put 'helm-color-run-kill-name 'helm-only t)
(defun helm-color-run-insert-rgb ()
"Insert RGB of color from `helm-source-colors'."
(interactive)
(with-helm-alive-p (helm-exit-and-execute-action 'helm-color-insert-rgb)))
(put 'helm-color-run-insert-rgb 'helm-only t)
(defun helm-color-run-kill-rgb ()
"Kill RGB of color from `helm-source-colors'."
(interactive)
(with-helm-alive-p (helm-exit-and-execute-action 'helm-color-kill-rgb)))
(put 'helm-color-run-kill-rgb 'helm-only t)
(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

230
code/elpa/helm-20220822.659/helm-comint.el Normal file
View File

@ -0,0 +1,230 @@
;;; helm-comint.el --- Comint prompt navigation for helm. -*- lexical-binding: t -*-
;; Copyright (C) 2020 Pierre Neidhardt <mail@ambrevar.xyz>
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; You can bind this as follows in .emacs:
;;
;; (add-hook 'comint-mode-hook
;; (lambda ()
;; (define-key comint-mode-map (kbd "M-s f") 'helm-comint-prompts-all)))
;;; Code:
(require 'cl-lib)
(require 'helm)
(require 'helm-lib)
(require 'helm-help)
(require 'helm-elisp)
;;; Comint prompts
;;
(defface helm-comint-prompts-promptidx
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
(:foreground "cyan")))
"Face used to highlight comint prompt index."
:group 'helm-comint-faces)
(defface helm-comint-prompts-buffer-name
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
(:foreground "green")))
"Face used to highlight comint buffer name."
:group 'helm-comint-faces)
(defcustom helm-comint-prompts-promptidx-p t
"Show prompt number."
:group 'helm-comint
:type 'boolean)
(defcustom helm-comint-mode-list '(comint-mode slime-repl-mode sly-mrepl-mode sql-interactive-mode)
"Supported modes for prompt navigation.
Derived modes (e.g., Geiser's REPL) are automatically supported."
:group 'helm-comint
:type '(repeat (choice symbol)))
(defcustom helm-comint-next-prompt-function '((sly-mrepl-mode . (lambda ()
(sly-mrepl-next-prompt)
(point))))
"Alist of (MODE . NEXT-PROMPT-FUNCTION) to use.
If the current major mode is a key in this list, the associated
function will be used to navigate the prompts.
The function must return the point after the prompt.
Otherwise (comint-next-prompt 1) will be used."
:group 'helm-comint
:type '(alist :key-type symbol :value-type function))
(defcustom helm-comint-max-offset 400
"Max number of chars displayed per candidate in comint-input-ring browser.
When t, don't truncate candidate, show all.
By default it is approximatively the number of bits contained in
five lines of 80 chars each i.e 80*5.
Note that if you set this to nil multiline will be disabled, i.e
you will not have anymore separators between candidates."
:type '(choice (const :tag "Disabled" t)
(integer :tag "Max candidate offset"))
:group 'helm-misc)
(defvar helm-comint-prompts-keymap
(let ((map (make-sparse-keymap)))
(set-keymap-parent map helm-map)
(define-key map (kbd "C-c o") #'helm-comint-prompts-other-window)
(define-key map (kbd "C-c C-o") #'helm-comint-prompts-other-frame)
map)
"Keymap for `helm-comint-prompt-all'.")
(defun helm-comint-prompts-list (mode &optional buffer)
"List the prompts in BUFFER in mode MODE.
Return a list of (\"prompt\" (point) (buffer-name) prompt-index))
E.g. (\"ls\" 162 \"*shell*\" 3).
If BUFFER is nil, use current buffer."
(with-current-buffer (or buffer (current-buffer))
(when (derived-mode-p mode)
(save-excursion
(goto-char (point-min))
(let (result (count 1))
(save-mark-and-excursion
(helm-awhile (and (not (eobp))
(helm-aif (alist-get major-mode helm-comint-next-prompt-function)
(funcall it)
(comint-next-prompt 1)))
(push (list (buffer-substring-no-properties
it (point-at-eol))
it (buffer-name) count)
result)
(setq count (1+ count))))
(nreverse result))))))
(defun helm-comint-prompts-list-all (mode)
"List the prompts of all buffers in mode MODE.
See `helm-comint-prompts-list'."
(cl-loop for b in (buffer-list)
append (helm-comint-prompts-list mode b)))
(defun helm-comint-prompts-transformer (candidates &optional all)
;; ("ls" 162 "*shell*" 3) => ("*shell*:3:ls" . ("ls" 162 "*shell*" 3))
(cl-loop for (prt pos buf id) in candidates
collect `(,(concat
(when all
(concat (propertize
buf
'face 'helm-comint-prompts-buffer-name)
":"))
(when helm-comint-prompts-promptidx-p
(concat (propertize
(number-to-string id)
'face 'helm-comint-prompts-promptidx)
":"))
prt)
. ,(list prt pos buf id))))
(defun helm-comint-prompts-all-transformer (candidates)
(helm-comint-prompts-transformer candidates t))
(cl-defun helm-comint-prompts-goto (candidate &optional (action 'switch-to-buffer))
;; Candidate format: ("ls" 162 "*shell*" 3)
(let ((buf (nth 2 candidate)))
(unless (and (string= (buffer-name) buf)
(eq action 'switch-to-buffer))
(funcall action buf))
(goto-char (nth 1 candidate))
(recenter)))
(defun helm-comint-prompts-goto-other-window (candidate)
(helm-comint-prompts-goto candidate 'switch-to-buffer-other-window))
(defun helm-comint-prompts-goto-other-frame (candidate)
(helm-comint-prompts-goto candidate 'switch-to-buffer-other-frame))
(defun helm-comint-prompts-other-window ()
(interactive)
(with-helm-alive-p
(helm-exit-and-execute-action 'helm-comint-prompts-goto-other-window)))
(put 'helm-comint-prompts-other-window 'helm-only t)
(defun helm-comint-prompts-other-frame ()
(interactive)
(with-helm-alive-p
(helm-exit-and-execute-action 'helm-comint-prompts-goto-other-frame)))
(put 'helm-comint-prompts-other-frame 'helm-only t)
;;;###autoload
(defun helm-comint-prompts ()
"Pre-configured `helm' to browse the prompts of the current comint buffer."
(interactive)
(if (apply #'derived-mode-p helm-comint-mode-list)
(helm :sources
(helm-build-sync-source "Comint prompts"
:candidates (helm-comint-prompts-list major-mode)
:candidate-transformer #'helm-comint-prompts-transformer
:action '(("Go to prompt" . helm-comint-prompts-goto)))
:buffer "*helm comint prompts*")
(message "Current buffer is not a comint buffer")))
;;;###autoload
(defun helm-comint-prompts-all ()
"Pre-configured `helm' to browse the prompts of all comint sessions."
(interactive)
(if (apply #'derived-mode-p helm-comint-mode-list)
(helm :sources
(helm-build-sync-source "All comint prompts"
:candidates (helm-comint-prompts-list-all major-mode)
:candidate-transformer #'helm-comint-prompts-all-transformer
:action (quote (("Go to prompt" . helm-comint-prompts-goto)
("Go to prompt in other window `C-c o`" .
helm-comint-prompts-goto-other-window)
("Go to prompt in other frame `C-c C-o`" .
helm-comint-prompts-goto-other-frame)))
:keymap helm-comint-prompts-keymap)
:buffer "*helm comint all prompts*")
(message "Current buffer is not a comint buffer")))
;;; Comint history
;;
;;
(defun helm-comint-input-ring-action (candidate)
"Default action for comint history."
(with-helm-current-buffer
(delete-region (comint-line-beginning-position) (point-max))
(insert candidate)))
(defvar helm-source-comint-input-ring
(helm-build-sync-source "Comint history"
:candidates (lambda ()
(with-helm-current-buffer
(cl-loop for elm in (ring-elements comint-input-ring)
unless (string= elm "")
collect elm)))
:action 'helm-comint-input-ring-action
;; Multiline does not work for `shell' because of an Emacs bug.
;; It works in other REPLs like Geiser.
:multiline 'helm-comint-max-offset)
"Source that provides Helm completion against `comint-input-ring'.")
;;;###autoload
(defun helm-comint-input-ring ()
"Preconfigured `helm' that provide completion of `comint' history."
(interactive)
(when (or (derived-mode-p 'comint-mode)
(member major-mode helm-comint-mode-list))
(helm :sources 'helm-source-comint-input-ring
:input (buffer-substring-no-properties (comint-line-beginning-position)
(point-at-eol))
:buffer "*helm comint history*")))
(provide 'helm-comint)
;;; helm-comint.el ends here

413
code/elpa/helm-20220822.659/helm-command.el Normal file
View 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

32
code/elpa/helm-20220822.659/helm-config.el Normal file
View File

@ -0,0 +1,32 @@
;;; helm-config.el --- Applications library for `helm.el' -*- lexical-binding: t -*-
;; Copyright (C) 2012 ~ 2021 Thierry Volpiatto
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; Requiring this file is not needed when using a package manager to
;; install helm as this one will take care of creating and loading the
;; autoload file.
;;; Code:
;;; Load the autoload file generated by the make file.
(load "helm-autoloads" nil t)
(provide 'helm-config)
;;; helm-config.el ends here

388
code/elpa/helm-20220822.659/helm-dabbrev.el Normal file
View 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

84
code/elpa/helm-20220822.659/helm-easymenu.el Normal file
View File

@ -0,0 +1,84 @@
;;; helm-easymenu.el --- Helm easymenu definitions. -*- lexical-binding: t -*-
;; Copyright (C) 2015 ~ 2020 Thierry Volpiatto
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Code:
(require 'easymenu)
(easy-menu-add-item
nil '("Tools")
'("Helm"
["Find any Files/Buffers" helm-multi-files t]
["Helm Everywhere (Toggle)" helm-mode t]
["Helm resume" helm-resume t]
"----"
("Files"
["Find files" helm-find-files t]
["Recent Files" helm-recentf t]
["Locate" helm-locate t]
["Search Files with find" helm-find t]
["Bookmarks" helm-filtered-bookmarks t])
("Buffers"
["Find buffers" helm-buffers-list t])
("Projects"
["Browse project" helm-browse-project]
["Projects history" helm-projects-history])
("Commands"
["Emacs Commands" helm-M-x t]
["Externals Commands" helm-run-external-command t])
("Help"
["Helm Apropos" helm-apropos t])
("Info"
["Info at point" helm-info-at-point t]
["Emacs Manual index" helm-info-emacs t]
["Gnus Manual index" helm-info-gnus t]
["Helm documentation" helm-documentation t])
("Elpa"
["Elisp packages" helm-list-elisp-packages t]
["Elisp packages no fetch" helm-list-elisp-packages-no-fetch t])
("Tools"
["Occur" helm-occur t]
["Grep current directory with AG" helm-do-grep-ag t]
["Gid" helm-gid t]
["Etags" helm-etags-select t]
["Lisp complete at point" helm-lisp-completion-at-point t]
["Browse Kill ring" helm-show-kill-ring t]
["Browse register" helm-register t]
["Mark Ring" helm-all-mark-rings t]
["Regexp handler" helm-regexp t]
["Colors & Faces" helm-colors t]
["Show xfonts" helm-select-xfont t]
["Ucs Symbols" helm-ucs t]
["Imenu" helm-imenu t]
["Imenu all" helm-imenu-in-all-buffers t]
["Semantic or Imenu" helm-semantic-or-imenu t]
["Google Suggest" helm-google-suggest t]
["Eval expression" helm-eval-expression-with-eldoc t]
["Calcul expression" helm-calcul-expression t]
["Man pages" helm-man-woman t]
["Top externals process" helm-top t]
["Emacs internals process" helm-list-emacs-process t])
"----"
["Preferred Options" helm-configuration t])
"Spell Checking")
(easy-menu-add-item nil '("Tools") '("----") "Spell Checking")
(provide 'helm-easymenu)
;;; helm-easymenu.el ends here

495
code/elpa/helm-20220822.659/helm-elisp-package.el Normal file
View File

@ -0,0 +1,495 @@
;;; 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)))))
(defun helm-el-run-visit-homepage ()
(interactive)
(with-helm-alive-p
(helm-exit-and-execute-action 'helm-el-package-visit-homepage)))
(put 'helm-el-run-visit-homepage 'helm-only t)
(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)))
(defun helm-el-run-package-install ()
(interactive)
(with-helm-alive-p
(helm-exit-and-execute-action 'helm-el-package-install)))
(put 'helm-el-run-package-install 'helm-only t)
(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))
(defun helm-el-run-package-uninstall ()
(interactive)
(with-helm-alive-p
(helm-exit-and-execute-action 'helm-el-package-uninstall)))
(put 'helm-el-run-package-uninstall 'helm-only t)
(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)))
(defun helm-el-run-package-upgrade ()
(interactive)
(with-helm-alive-p
(helm-exit-and-execute-action 'helm-el-package-upgrade)))
(put 'helm-el-run-package-upgrade 'helm-only t)
(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))
(defun helm-el-run-package-upgrade-all ()
(interactive)
(with-helm-alive-p
(helm-exit-and-execute-action 'helm-el-package-upgrade-all-action)))
(put 'helm-el-run-package-upgrade-all 'helm-only t)
(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)))
(defun helm-el-run-package-reinstall ()
(interactive)
(with-helm-alive-p
(helm-exit-and-execute-action 'helm-el-package-reinstall)))
(put 'helm-el-run-package-reinstall 'helm-only t)
;;;###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

1047
code/elpa/helm-20220822.659/helm-elisp.el Normal file
View File

File diff suppressed because it is too large Load Diff

254
code/elpa/helm-20220822.659/helm-epa.el Normal file
View 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

498
code/elpa/helm-20220822.659/helm-eshell.el Normal file
View File

@ -0,0 +1,498 @@
;;; 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))
(defun helm-eshell-prompts-other-window ()
(interactive)
(with-helm-alive-p
(helm-exit-and-execute-action 'helm-eshell-prompts-goto-other-window)))
(put 'helm-eshell-prompts-other-window 'helm-only t)
(defun helm-eshell-prompts-other-frame ()
(interactive)
(with-helm-alive-p
(helm-exit-and-execute-action 'helm-eshell-prompts-goto-other-frame)))
(put 'helm-eshell-prompts-other-frame 'helm-only t)
;;;###autoload
(defun helm-eshell-prompts ()
"Pre-configured `helm' to browse the prompts of the current Eshell."
(interactive)
(if (eq major-mode 'eshell-mode)
(helm :sources
(helm-build-sync-source "Eshell prompts"
:candidates (helm-eshell-prompts-list)
:candidate-transformer 'helm-eshell-prompts-transformer
:action '(("Go to prompt" . helm-eshell-prompts-goto)))
:buffer "*helm Eshell prompts*")
(message "Current buffer is not an Eshell buffer")))
;;;###autoload
(defun helm-eshell-prompts-all ()
"Pre-configured `helm' to browse the prompts of all Eshell sessions."
(interactive)
(helm :sources
(helm-build-sync-source "All Eshell prompts"
:candidates (helm-eshell-prompts-list-all)
:candidate-transformer 'helm-eshell-prompts-all-transformer
:action '(("Go to prompt" . helm-eshell-prompts-goto)
("Go to prompt in other window `C-c o`" .
helm-eshell-prompts-goto-other-window)
("Go to prompt in other frame `C-c C-o`" .
helm-eshell-prompts-goto-other-frame))
:keymap helm-eshell-prompts-keymap)
:buffer "*helm Eshell all prompts*"))
(provide 'helm-eshell)
;;; helm-eshell ends here

215
code/elpa/helm-20220822.659/helm-eval.el Normal file
View 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

258
code/elpa/helm-20220822.659/helm-external.el Normal file
View File

@ -0,0 +1,258 @@
;;; helm-external.el --- Run Externals commands within Emacs with helm completion. -*- lexical-binding: t -*-
;; Copyright (C) 2012 ~ 2021 Thierry Volpiatto
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Code:
(require 'cl-lib)
(require 'helm)
(require 'helm-help)
(require 'helm-net)
(declare-function helm-comp-read "helm-mode")
(defgroup helm-external nil
"External related Applications and libraries for Helm."
:group 'helm)
(defcustom helm-raise-command nil
"A shell command to jump to a window running specific program.
Need external program wmctrl.
This will be use with `format', so use something like \"wmctrl -xa %s\"."
:type 'string
:group 'helm-external)
(defcustom helm-external-programs-associations nil
"Alist to store externals programs associated with file extension.
This variable overhide setting in .mailcap file.
E.g.: \\='((\"jpg\" . \"gqview\") (\"pdf\" . \"xpdf\")) "
:type '(alist :key-type string :value-type string)
:group 'helm-external)
(defcustom helm-default-external-file-browser "nautilus"
"Default external file browser for your system.
Directories will be opened externally with it when opening file
externally in `helm-find-files'.
Set to nil if you do not have an external file browser or do not
want to use it.
Windows users should set that to \"explorer.exe\"."
:group 'helm-external
:type 'string)
;;; Internals
(defvar helm-external-command-history nil)
(defvar helm-external-commands-list nil
"A list of all external commands the user can execute.
If this variable is not set by the user, it will be calculated
automatically.")
(defun helm-external-commands-list-1 (&optional sort)
"Returns a list of all external commands the user can execute.
If `helm-external-commands-list' is non-nil it will return its
contents. Else it calculates all external commands and sets
`helm-external-commands-list'."
(helm-aif helm-external-commands-list
it
(setq helm-external-commands-list
(cl-loop
for dir in (split-string (getenv "PATH") path-separator)
when (and (file-exists-p dir) (file-accessible-directory-p dir))
for lsdir = (cl-loop for i in (directory-files dir t)
for bn = (file-name-nondirectory i)
when (and (not (member bn completions))
(not (file-directory-p i))
(file-executable-p i))
collect bn)
append lsdir into completions
finally return
(if sort (sort completions 'string-lessp) completions)))))
(defun helm-run-or-raise (exe &optional files detached)
"Run asynchronously EXE or jump to the application window.
If EXE is already running just jump to his window if
`helm-raise-command' is non-nil.
When FILES argument is provided run EXE with FILES.
When argument DETACHED is non nil, detach process from Emacs."
(let* ((proc-name (replace-regexp-in-string
"(" "" (car (split-string exe))))
(fmt-file (lambda (file)
(shell-quote-argument
(if (eq system-type 'windows-nt)
(helm-w32-prepare-filename file)
(expand-file-name file)))))
(file-arg (and files (mapconcat fmt-file files " ")))
process-connection-type proc)
(when (and files detached (not (string-match "%s &)\\'" exe)))
(setq exe (format "(%s &)" exe)))
(when (member proc-name helm-external-commands-list)
;; Allow adding more files to the current process if it is
;; already running (i.e. Don't just raise it without sending
;; files) we assume program doesn't start a new
;; process (like firefox, transmission etc...).
(if files
(cond ((string-match "%s &)\\'" exe)
(message "Starting and detaching `%s' from Emacs" proc-name)
(call-process-shell-command (format exe file-arg)))
(t
(message "Starting %s..." proc-name)
(setq proc
(start-process-shell-command
proc-name nil (if (string-match "%s" exe)
(format exe file-arg)
(format "%s %s" exe file-arg))))))
;; Just jump to the already running program instance or start
;; a new process.
(if (get-process proc-name)
(if helm-raise-command
(run-at-time 0.1 nil #'shell-command
(format helm-raise-command proc-name))
(error "Error: %s is already running" proc-name))
(if (and detached (not (memq system-type '(windows-nt ms-dos))))
(progn
(message "Starting and detaching `%s' from Emacs" proc-name)
(call-process-shell-command (format "(%s &)" exe)))
(when detached
(user-error "Detaching programs not supported on `%s'" system-type))
(setq proc (start-process-shell-command proc-name nil exe)))))
(when proc
(set-process-sentinel
proc
(lambda (process event)
(when (and (string= event "finished\n")
helm-raise-command
(not (helm-get-pid-from-process-name proc-name)))
(shell-command (format helm-raise-command "emacs")))
(message "%s process...Finished." process))))
;; Move command on top list.
(setq helm-external-commands-list
(cons proc-name
(delete proc-name helm-external-commands-list))))))
(defun helm-get-mailcap-for-file (filename)
"Get the command to use for FILENAME from mailcap files."
(mailcap-parse-mailcaps)
(let* ((ext (file-name-extension filename))
(mime (when ext (mailcap-extension-to-mime ext)))
(result (when mime (mailcap-mime-info mime))))
;; If elisp file have no associations in .mailcap
;; `mailcap-maybe-eval' is returned, in this case just return nil.
(when (stringp result) (helm-basename result))))
(defun helm-get-default-program-for-file (filename)
"Try to find a default program to open FILENAME.
Try first in `helm-external-programs-associations' and then in
mailcap file. If nothing found return nil."
(let* ((ext (file-name-extension filename))
(def-prog (assoc-default ext helm-external-programs-associations)))
(cond ((and def-prog (not (string= def-prog ""))) def-prog)
((and helm-default-external-file-browser (file-directory-p filename))
helm-default-external-file-browser)
(t (helm-get-mailcap-for-file filename)))))
(defun helm-open-file-externally (_file)
"Open FILE with an external program.
Try to guess which program to use with
`helm-get-default-program-for-file'.
If not found or a prefix arg is given query the user which tool
to use."
(let* ((files (helm-marked-candidates :with-wildcard t))
(fname (expand-file-name (car files)))
(collection (helm-external-commands-list-1 'sort))
(def-prog (helm-get-default-program-for-file fname))
(program (if (or helm-current-prefix-arg (not def-prog))
;; Prefix arg or no default program.
(prog1
(helm-comp-read
"Program: " collection
:must-match t
:name "Open file Externally"
:history 'helm-external-command-history)
;; Always prompt to set this program as default.
(setq def-prog nil))
;; No prefix arg or default program exists.
def-prog)))
(unless (or def-prog ; Association exists, no need to record it.
;; Don't try to record non--filenames associations (e.g urls).
(not (file-exists-p fname)))
(when
(y-or-n-p
(format
"Do you want to make `%s' the default program for this kind of files? "
program))
(helm-aif (assoc (file-name-extension fname)
helm-external-programs-associations)
(setq helm-external-programs-associations
(delete it helm-external-programs-associations)))
(push (cons (file-name-extension fname)
(helm-read-string
"Program (Add args maybe and confirm): " program))
helm-external-programs-associations)
(customize-save-variable 'helm-external-programs-associations
helm-external-programs-associations)))
(helm-run-or-raise program files)
(setq helm-external-command-history
(cl-loop for i in helm-external-command-history
when (executable-find i) collect i))))
(defun helm-run-external-command-action (candidate &optional detached)
(helm-run-or-raise candidate nil detached)
(setq helm-external-command-history
(cons candidate
(delete candidate
helm-external-command-history))))
(defclass helm-external-commands (helm-source-in-buffer)
((filtered-candidate-transformer
:initform (lambda (candidates _source)
(cl-loop for c in candidates
if (get-process c)
collect (propertize c 'face 'font-lock-type-face)
else collect c)))
(must-match :initform t)
(nomark :initform t)
(action :initform
(helm-make-actions
"Run program" 'helm-run-external-command-action
(lambda ()
(unless (memq system-type '(windows-nt ms-dos))
"Run program detached"))
(lambda (candidate)
(helm-run-external-command-action candidate 'detached))))))
;;;###autoload
(defun helm-run-external-command ()
"Preconfigured `helm' to run External PROGRAM asyncronously from Emacs.
If program is already running try to run `helm-raise-command' if
defined otherwise exit with error. You can set your own list of
commands with `helm-external-commands-list'."
(interactive)
(helm :sources `(,(helm-make-source "External Commands history" 'helm-external-commands
:data helm-external-command-history)
,(helm-make-source "External Commands" 'helm-external-commands
:data (helm-external-commands-list-1 'sort)))
:buffer "*helm externals commands*"
:prompt "RunProgram: ")
;; Remove from history no more valid executables.
(setq helm-external-command-history
(cl-loop for i in helm-external-command-history
when (executable-find i) collect i)))
(provide 'helm-external)
;;; helm-external ends here

128
code/elpa/helm-20220822.659/helm-fd.el Normal file
View File

@ -0,0 +1,128 @@
;;; helm-fd.el --- helm interface for fd command line tool. -*- lexical-binding: t -*-
;; Copyright (C) 2012 ~ 2021 Thierry Volpiatto
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Code:
(require 'helm)
(require 'helm-types)
(declare-function ansi-color-apply "ansi-color.el")
(defvar helm-fd-executable "fd"
"The fd shell command executable.")
(defcustom helm-fd-switches '("--no-ignore" "--hidden" "--type" "f" "--type" "d" "--color" "always")
"A list of options to pass to fd shell command."
:type '(repeat string)
:group 'helm-files)
(defface helm-fd-finish
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:foreground "Green"))
"Face used in mode line when fd process ends."
:group 'helm-grep-faces)
(defvar helm-fd-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map helm-generic-files-map)
(define-key map (kbd "C-]") 'undefined)
(define-key map (kbd "DEL") 'helm-delete-backward-no-update)
(define-key map (kbd "M-<down>") 'helm-fd-next-directory)
(define-key map (kbd "M-<up>") 'helm-fd-previous-directory)
map))
(defun helm-fd-next-directory-1 (arg)
(with-helm-window
(let ((cur-dir (helm-basedir (helm-get-selection))))
(while (equal cur-dir (helm-basedir (helm-get-selection)))
(if (> arg 0)
(helm-next-line)
(helm-previous-line))))))
(defun helm-fd-next-directory ()
"Move to next directory in a helm-fd source."
(interactive)
(with-helm-alive-p
(helm-fd-next-directory-1 1)))
(defun helm-fd-previous-directory ()
"Move to previous directory in a helm-fd source."
(interactive)
(with-helm-alive-p
(helm-fd-next-directory-1 -1)))
(defclass helm-fd-class (helm-source-async)
((candidates-process :initform 'helm-fd-process)
(requires-pattern :initform 2)
(candidate-number-limit :initform 20000)
(nohighlight :initform t)
(help-message :initform 'helm-fd-help-message)
(filtered-candidate-transformer :initform 'helm-fd-fct)
(action :initform 'helm-type-file-actions)
(keymap :initform 'helm-fd-map)))
(defun helm-fd-process ()
"Initialize fd process in an helm async source."
(let* (process-connection-type
(cmd (append helm-fd-switches (split-string helm-pattern " ")))
(proc (apply #'start-process "fd" nil helm-fd-executable cmd))
(start-time (float-time))
(fd-version (replace-regexp-in-string
"\n" ""
(shell-command-to-string (concat helm-fd-executable " --version")))))
(helm-log "Fd command:\nfd %s" (mapconcat 'identity cmd " "))
(helm-log "VERSION: %s" fd-version)
(prog1
proc
(set-process-sentinel
proc (lambda (_process event)
(if (string= event "finished\n")
(with-helm-window
(setq mode-line-format
`(" " mode-line-buffer-identification " "
(:eval (format "L%s" (helm-candidate-number-at-point))) " "
(:eval (propertize
(format
"[%s process finished in %.2fs - (%s results)] "
,fd-version
,(- (float-time) start-time)
(helm-get-candidate-number))
'face 'helm-fd-finish))))
(force-mode-line-update))
(helm-log "Error: Fd %s"
(replace-regexp-in-string "\n" "" event))))))))
(defun helm-fd-fct (candidates _source)
"The filtered-candidate-transformer function for helm-fd."
(cl-loop for i in candidates
collect (ansi-color-apply i)))
(defun helm-fd-1 (directory)
"Run fd shell command on DIRECTORY with helm interface."
(cl-assert (executable-find helm-fd-executable) nil "Could not find fd executable")
(cl-assert (not (file-remote-p directory)) nil "Fd not supported on remote directories")
(let ((default-directory directory))
(helm :sources (helm-make-source
(format "fd (%s)"
(abbreviate-file-name default-directory))
'helm-fd-class)
:buffer "*helm fd*")))
(provide 'helm-fd)
;;; helm-fd.el ends here

6493
code/elpa/helm-20220822.659/helm-files.el Normal file
View File

File diff suppressed because it is too large Load Diff

170
code/elpa/helm-20220822.659/helm-find.el Normal file
View File

@ -0,0 +1,170 @@
;;; helm-find.el --- helm interface for find 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 'helm-files)
(require 'helm-external)
(defcustom helm-findutils-skip-boring-files t
"Ignore boring files in find command results."
:group 'helm-files
:type 'boolean)
(defcustom helm-findutils-search-full-path nil
"Search in full path with shell command find when non-nil.
I.e. use the -path/ipath arguments of find instead of
-name/iname."
:group 'helm-files
:type 'boolean)
(defcustom helm-find-noerrors nil
"Prevent showing error messages in helm buffer when non nil."
:group 'helm-files
:type 'boolean)
(defvar helm-find-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map helm-generic-files-map)
(define-key map (kbd "DEL") 'helm-delete-backward-no-update)
map))
(defvar helm-source-findutils
(helm-build-async-source "Find"
:header-name (lambda (name)
(concat name " in [" (helm-default-directory) "]"))
:candidates-process 'helm-find-shell-command-fn
:filtered-candidate-transformer 'helm-findutils-transformer
:action-transformer 'helm-transform-file-load-el
:persistent-action 'helm-ff-kill-or-find-buffer-fname
:action 'helm-type-file-actions
:help-message 'helm-generic-file-help-message
:keymap helm-find-map
:candidate-number-limit 9999
:requires-pattern 3))
(defun helm-findutils-transformer (candidates _source)
(let (non-essential
(default-directory (helm-default-directory)))
(cl-loop for i in candidates
for abs = (expand-file-name
(helm-aif (file-remote-p default-directory)
(concat it i) i))
for type = (car (file-attributes abs))
for disp = (if (and helm-ff-transformer-show-only-basename
(not (string-match "[.]\\{1,2\\}$" i)))
(helm-basename abs) abs)
collect (cond ((eq t type)
(cons (propertize disp 'face 'helm-ff-directory)
abs))
((stringp type)
(cons (propertize disp 'face 'helm-ff-symlink)
abs))
(t (cons (propertize disp 'face 'helm-ff-file)
abs))))))
(defun helm-find--build-cmd-line ()
(require 'find-cmd)
(let* ((default-directory (or (file-remote-p default-directory 'localname)
default-directory))
(patterns+options (split-string helm-pattern "\\(\\`\\| +\\)\\* +"))
(fold-case (helm-set-case-fold-search (car patterns+options)))
(patterns (split-string (car patterns+options)))
(additional-options (and (cdr patterns+options)
(list (concat (cadr patterns+options) " "))))
(ignored-dirs ())
(ignored-files (when helm-findutils-skip-boring-files
(cl-loop for f in completion-ignored-extensions
if (string-match "/$" f)
do (push (replace-match "" nil t f)
ignored-dirs)
else collect (concat "*" f))))
(path-or-name (if helm-findutils-search-full-path
'(ipath path) '(iname name)))
(name-or-iname (if fold-case
(car path-or-name) (cadr path-or-name))))
(find-cmd (and ignored-dirs
`(prune (name ,@ignored-dirs)))
(and ignored-files
`(not (name ,@ignored-files)))
`(and ,@(mapcar
(lambda (pattern)
`(,name-or-iname ,(concat "*" pattern "*")))
patterns)
,@additional-options))))
(defun helm-find-shell-command-fn ()
"Asynchronously fetch candidates for `helm-find'.
Additional find options can be specified after a \"*\"
separator."
(let* (process-connection-type
non-essential
(cmd (concat (helm-find--build-cmd-line)
(if helm-find-noerrors "2> /dev/null" "")))
(proc (start-file-process-shell-command "hfind" helm-buffer cmd)))
(helm-log "Find command:\n%s" cmd)
(prog1 proc
(set-process-sentinel
proc
(lambda (process event)
(helm-process-deferred-sentinel-hook
process event (helm-default-directory))
(if (string= event "finished\n")
(helm-locate-update-mode-line "Find")
(helm-log "Error: Find %s"
(replace-regexp-in-string "\n" "" event))))))))
(defun helm-find-1 (dir)
(let ((default-directory (file-name-as-directory dir)))
(helm :sources 'helm-source-findutils
:buffer "*helm find*"
:ff-transformer-show-only-basename nil
:case-fold-search helm-file-name-case-fold-search)))
;;; Preconfigured commands
;;
;;
;;;###autoload
(defun helm-find (arg)
"Preconfigured `helm' for the find shell command.
Recursively find files whose names are matched by all specified
globbing PATTERNs under the current directory using the external
program specified in `find-program' (usually \"find\"). Every
input PATTERN is silently wrapped into two stars: *PATTERN*.
With prefix argument, prompt for a directory to search.
When user option `helm-findutils-search-full-path' is non-nil,
match against complete paths, otherwise, against file names
without directory part.
The (possibly empty) list of globbing PATTERNs can be followed by
the separator \"*\" plus any number of additional arguments that
are passed to \"find\" literally."
(interactive "P")
(let ((directory
(if arg
(file-name-as-directory
(read-directory-name "DefaultDirectory: "))
default-directory)))
(helm-find-1 directory)))
(provide 'helm-find)
;;; helm-find.el ends here

344
code/elpa/helm-20220822.659/helm-font.el Normal file
View File

@ -0,0 +1,344 @@
;;; helm-font --- Font and ucs selection 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/>.
;;; Code:
(require 'cl-lib)
(require 'helm)
(require 'helm-help)
;; No warnings in Emacs built --without-x
(declare-function x-list-fonts "xfaces.c")
(declare-function helm-generic-sort-fn "helm-utils")
(defgroup helm-font nil
"Related applications to display fonts in Helm."
:group 'helm)
(defcustom helm-ucs-recent-size 10
"Number of recent chars to keep."
:type 'integer
:group 'helm-font)
(defcustom helm-ucs-actions
'(("Insert character" . helm-ucs-insert-char)
("Insert character name" . helm-ucs-insert-name)
("Insert character code in hex" . helm-ucs-insert-code)
("Kill marked characters" . helm-ucs-kill-char)
("Kill name" . helm-ucs-kill-name)
("Kill code" . helm-ucs-kill-code)
("Describe char" . helm-ucs-describe-char))
"Actions for `helm-source-ucs'."
:group 'helm-font
:type '(alist :key-type string :value-type function))
(defvar helm-ucs-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map helm-map)
(define-key map (kbd "<C-backspace>") 'helm-ucs-persistent-delete)
(define-key map (kbd "<C-left>") 'helm-ucs-persistent-backward)
(define-key map (kbd "<C-right>") 'helm-ucs-persistent-forward)
(define-key map (kbd "C-c SPC") 'helm-ucs-persistent-insert-space)
map)
"Keymap for `helm-ucs'.")
(defface helm-ucs-char
`((((class color) (background dark))
,@(and (>= emacs-major-version 27) '(:extend t))
:foreground "Gold"))
"Face used to display ucs characters."
:group 'helm-font)
;;; Xfont selection
;;
;;
(defvar helm-xfonts-cache nil)
(defvar helm-previous-font nil)
(defvar helm-source-xfonts
(helm-build-sync-source "X Fonts"
:init (lambda ()
(unless helm-xfonts-cache
(setq helm-xfonts-cache
(x-list-fonts "*")))
;; Save current font so it can be restored in cleanup
(setq helm-previous-font (cdr (assq 'font (frame-parameters)))))
:candidates 'helm-xfonts-cache
:action '(("Copy font to kill ring" . (lambda (elm)
(kill-new elm)))
("Set font" . (lambda (elm)
(kill-new elm)
(set-frame-font elm 'keep-size)
(message "Font copied to kill ring"))))
:cleanup (lambda ()
;; Restore previous font
(set-frame-font helm-previous-font 'keep-size))
:persistent-action (lambda (new-font)
(set-frame-font new-font 'keep-size)
(kill-new new-font))
:persistent-help "Preview font and copy to kill-ring"))
;;; 𝕌𝕔𝕤 𝕊𝕪𝕞𝕓𝕠𝕝 𝕔𝕠𝕞𝕡𝕝𝕖𝕥𝕚𝕠𝕟
;;
;;
(defvar helm-ucs--max-len nil)
(defvar helm-ucs--names nil)
(defvar helm-ucs-history nil)
(defvar helm-ucs-recent nil
"Ring of recent `helm-ucs' selections.")
(defun helm-calculate-ucs-alist-max-len (names)
"Calculate the length of the longest NAMES list candidate."
(cl-loop for (_n . v) in names
maximize (length (format "#x%x:" v)) into code
maximize (max 1 (string-width (format "%c" v))) into char
finally return (cons code char)))
(defun helm-calculate-ucs-hash-table-max-len (names)
"Calculate the length of the longest NAMES hash table candidate."
(cl-loop for _n being the hash-keys of names
using (hash-values v)
maximize (length (format "#x%x:" v)) into code
maximize (max 1 (string-width (format "%c" v))) into char
finally return (cons code char)))
(defun helm-calculate-ucs-max-len ()
"Calculate the length of the longest `ucs-names' candidate."
(let ((ucs-struct (ucs-names)))
(if (hash-table-p ucs-struct)
(helm-calculate-ucs-hash-table-max-len ucs-struct)
(helm-calculate-ucs-alist-max-len ucs-struct))))
(defun helm-ucs-collect-symbols-alist (names)
"Collect ucs symbols from the NAMES list."
(cl-loop with pr = (make-progress-reporter
"collecting ucs names"
0 (length names))
for (n . v) in names
for count from 1
for xcode = (format "#x%x:" v)
for len = (length xcode)
for diff = (- (car helm-ucs--max-len) len)
for code = (format "(#x%x): " v)
for char = (propertize (format "%c" v)
'face 'helm-ucs-char)
unless (or (string= "" n)
;; `char-displayable-p' return a font object or
;; t for some char that are displayable but have
;; no special font (e.g 10) so filter out char
;; with no font.
(not (fontp (char-displayable-p (read xcode)))))
collect
(concat code (make-string diff ? )
char " " n)
and do (progress-reporter-update pr count)))
(defun helm-ucs-collect-symbols-hash-table (names)
"Collect ucs symbols from the NAMES hash-table."
(cl-loop with pr = (make-progress-reporter
"collecting ucs names"
0 (hash-table-count names))
for n being the hash-keys of names
using (hash-values v)
for count from 1
for xcode = (format "#x%x:" v)
for len = (length xcode)
for diff = (- (car helm-ucs--max-len) len)
for code = (format "(#x%x): " v)
for char = (propertize (format "%c" v)
'face 'helm-ucs-char)
unless (or (string= "" n)
(not (fontp (char-displayable-p (read xcode)))))
collect
(concat code (make-string diff ? )
char " " n)
and do (progress-reporter-update pr count)))
(defun helm-ucs-collect-symbols (ucs-struct)
"Collect ucs symbols from UCS-STRUCT.
Depending on the Emacs version, the variable `ucs-names' can
either be an alist or a hash-table."
(if (hash-table-p ucs-struct)
(helm-ucs-collect-symbols-hash-table ucs-struct)
(helm-ucs-collect-symbols-alist ucs-struct)))
(defun helm-ucs-init ()
"Initialize a Helm buffer with ucs symbols.
Only math* symbols are collected."
(unless helm-ucs--max-len
(setq helm-ucs--max-len
(helm-calculate-ucs-max-len)))
(or helm-ucs--names
(setq helm-ucs--names
(helm-ucs-collect-symbols (ucs-names)))))
;; Actions (insertion)
(defun helm-ucs-match (candidate n)
"Return the N part of an ucs CANDIDATE.
Where N=1 is the ucs code, N=2 the ucs char and N=3 the ucs
name."
(when (string-match
"^(\\(#x[a-f0-9]+\\)): *\\(.\\) *\\([^:]+\\)+"
candidate)
(match-string n candidate)))
(defun helm-ucs-save-recentest (candidate)
(let ((lst (cons candidate (delete candidate helm-ucs-recent))))
(setq helm-ucs-recent
(if (> (length lst) helm-ucs-recent-size)
(nbutlast lst 1)
lst))))
(defun helm-ucs-insert (candidate n)
"Insert the N part of CANDIDATE."
(with-helm-current-buffer
(helm-ucs-save-recentest candidate)
(insert (helm-ucs-match candidate n))))
(defun helm-ucs-insert-char (candidate)
"Insert ucs char part of CANDIDATE at point."
(helm-ucs-insert candidate 2))
(defun helm-ucs-insert-code (candidate)
"Insert ucs code part of CANDIDATE at point."
(helm-ucs-insert candidate 1))
(defun helm-ucs-insert-name (candidate)
"Insert ucs name part of CANDIDATE at point."
(helm-ucs-insert candidate 3))
;; Kill actions
(defun helm-ucs-kill-char (_candidate)
"Action that concatenate ucs marked chars."
(let ((marked (helm-marked-candidates)))
(cl-loop for candidate in marked
do (helm-ucs-save-recentest candidate))
(kill-new (mapconcat (lambda (x)
(helm-ucs-match x 2))
marked ""))))
(defun helm-ucs-kill-code (candidate)
(helm-ucs-save-recentest candidate)
(kill-new (helm-ucs-match candidate 1)))
(defun helm-ucs-kill-name (candidate)
(helm-ucs-save-recentest candidate)
(kill-new (helm-ucs-match candidate 3)))
;; Describe char
(defun helm-ucs-describe-char (candidate)
"Describe char CANDIDATE."
(with-temp-buffer
(insert (helm-ucs-match candidate 2))
(describe-char (point-min))))
;; Navigation in current-buffer (persistent)
(defun helm-ucs-forward-char (_candidate)
(with-helm-current-buffer
(forward-char 1)))
(defun helm-ucs-backward-char (_candidate)
(with-helm-current-buffer
(forward-char -1)))
(defun helm-ucs-delete-backward (_candidate)
(with-helm-current-buffer
(delete-char -1)))
(defun helm-ucs-insert-space (_candidate)
(with-helm-current-buffer
(insert " ")))
(defun helm-ucs-persistent-forward ()
(interactive)
(with-helm-alive-p
(helm-set-attr 'action-forward 'helm-ucs-forward-char)
(helm-execute-persistent-action 'action-forward)))
(put 'helm-ucs-persistent-forward 'helm-only t)
(defun helm-ucs-persistent-backward ()
(interactive)
(with-helm-alive-p
(helm-set-attr 'action-back 'helm-ucs-backward-char)
(helm-execute-persistent-action 'action-back)))
(put 'helm-ucs-persistent-backward 'helm-only t)
(defun helm-ucs-persistent-delete ()
(interactive)
(with-helm-alive-p
(helm-set-attr 'action-delete 'helm-ucs-delete-backward)
(helm-execute-persistent-action 'action-delete)))
(put 'helm-ucs-persistent-delete 'helm-only t)
(defun helm-ucs-persistent-insert-space ()
(interactive)
(with-helm-alive-p
(helm-set-attr 'action-insert-space 'helm-ucs-insert-space)
(helm-execute-persistent-action 'action-insert-space)))
(defvar helm-source-ucs-recent
(helm-build-sync-source "Recent UCS"
:action 'helm-ucs-actions
:candidates (lambda () helm-ucs-recent)
:help-message helm-ucs-help-message
:keymap helm-ucs-map
:volatile t))
(defvar helm-source-ucs
(helm-build-in-buffer-source "UCS names"
:data #'helm-ucs-init
:get-line #'buffer-substring
:help-message 'helm-ucs-help-message
:filtered-candidate-transformer
(lambda (candidates _source) (sort candidates #'helm-generic-sort-fn))
:action 'helm-ucs-actions
:persistent-action (lambda (candidate)
(helm-ucs-insert-char candidate)
(helm-force-update))
:keymap helm-ucs-map)
"Source for collecting `ucs-names' math symbols.")
;;;###autoload
(defun helm-select-xfont ()
"Preconfigured `helm' to select Xfont."
(interactive)
(helm :sources 'helm-source-xfonts
:buffer "*helm select xfont*"))
;;;###autoload
(defun helm-ucs (arg)
"Preconfigured `helm' for `ucs-names'.
Called with a prefix arg force reloading cache."
(interactive "P")
(when arg
(setq helm-ucs--names nil
helm-ucs--max-len nil
ucs-names nil))
(let ((char (helm-aif (char-after) (string it))))
(helm :sources (list helm-source-ucs-recent helm-source-ucs)
:history 'helm-ucs-history
:input (and char (multibyte-string-p char) char)
:buffer "*helm ucs*")))
(provide 'helm-font)
;;; helm-font.el ends here

310
code/elpa/helm-20220822.659/helm-for-files.el Normal file
View File

@ -0,0 +1,310 @@
;;; helm-for-files.el --- helm-for-files and related. -*- 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-files)
(require 'helm-external)
(require 'helm-bookmark)
(defcustom helm-multi-files-toggle-locate-binding "C-c p"
"Default binding to switch back and forth locate in `helm-multi-files'."
:group 'helm-files
:type 'string)
(defcustom helm-for-files-preferred-list
'(helm-source-buffers-list
helm-source-recentf
helm-source-bookmarks
helm-source-file-cache
helm-source-files-in-current-dir
helm-source-locate)
"Your preferred sources for `helm-for-files' and `helm-multi-files'.
When adding a source here it is up to you to ensure the library
of this source is accessible and properly loaded."
:type '(repeat (choice symbol))
:group 'helm-files)
(defcustom helm-for-files-tramp-not-fancy t
"Colorize remote files when non nil.
Be aware that a nil value will make tramp display very slow."
:group 'helm-files
:type 'boolean)
;;; File Cache
;;
;;
(defvar file-cache-alist)
(defclass helm-file-cache (helm-source-in-buffer helm-type-file)
((init :initform (lambda () (require 'filecache)))))
(defun helm-file-cache-get-candidates ()
(cl-loop for item in file-cache-alist append
(cl-destructuring-bind (base &rest dirs) item
(cl-loop for dir in dirs collect
(concat dir base)))))
(defvar helm-source-file-cache nil)
(defcustom helm-file-cache-fuzzy-match nil
"Enable fuzzy matching in `helm-source-file-cache' when non--nil."
:group 'helm-files
:type 'boolean
:set (lambda (var val)
(set var val)
(setq helm-source-file-cache
(helm-make-source "File Cache" 'helm-file-cache
:fuzzy-match helm-file-cache-fuzzy-match
:data 'helm-file-cache-get-candidates))))
(cl-defun helm-file-cache-add-directory-recursively
(dir &optional match (ignore-dirs t))
(require 'filecache)
(cl-loop for f in (helm-walk-directory
dir
:path 'full
:directories nil
:match match
:skip-subdirs ignore-dirs)
do (file-cache-add-file f)))
(defun helm-transform-file-cache (actions _candidate)
(let ((source (helm-get-current-source)))
(if (string= (assoc-default 'name source) "File Cache")
(append actions
'(("Remove marked files from file-cache"
. helm-ff-file-cache-remove-file)))
actions)))
;;; Recentf files
;;
;;
(defvar helm-recentf--basename-flag nil)
(defun helm-recentf-pattern-transformer (pattern)
(let ((pattern-no-flag (replace-regexp-in-string " -b" "" pattern)))
(cond ((and (string-match " " pattern-no-flag)
(string-match " -b\\'" pattern))
(setq helm-recentf--basename-flag t)
pattern-no-flag)
((string-match "\\([^ ]*\\) -b\\'" pattern)
(prog1 (match-string 1 pattern)
(setq helm-recentf--basename-flag t)))
(t (setq helm-recentf--basename-flag nil)
pattern))))
(defcustom helm-turn-on-recentf t
"Automatically turn on `recentf-mode' when non-nil."
:group 'helm-files
:type 'boolean)
(defclass helm-recentf-source (helm-source-sync helm-type-file)
((init :initform (lambda ()
(require 'recentf)
(when helm-turn-on-recentf (recentf-mode 1))))
(candidates :initform (lambda () recentf-list))
(pattern-transformer :initform 'helm-recentf-pattern-transformer)
(match-part :initform (lambda (candidate)
(if (or helm-ff-transformer-show-only-basename
helm-recentf--basename-flag)
(helm-basename candidate) candidate)))
(migemo :initform t)
(persistent-action :initform 'helm-ff-kill-or-find-buffer-fname)))
(cl-defmethod helm--setup-source :after ((source helm-recentf-source))
(setf (slot-value source 'action)
(append (symbol-value (helm-actions-from-type-file))
'(("Delete file(s) from recentf" .
(lambda (_candidate)
(cl-loop for file in (helm-marked-candidates)
do (setq recentf-list (delete file recentf-list)))))))))
(defvar helm-source-recentf nil
"See (info \"(emacs)File Conveniences\").
Set `recentf-max-saved-items' to a bigger value if default is too
small.")
(defcustom helm-recentf-fuzzy-match nil
"Enable fuzzy matching in `helm-source-recentf' when non-nil."
:group 'helm-files
:type 'boolean
:set (lambda (var val)
(set var val)
(let ((helm-fuzzy-sort-fn 'helm-fuzzy-matching-sort-fn-preserve-ties-order))
(setq helm-source-recentf
(helm-make-source "Recentf" 'helm-recentf-source
:fuzzy-match val)))))
;;; Files in current dir
;;
;;
(defun helm-highlight-files (files _source)
"A basic transformer for helm files sources.
Colorize only symlinks, directories and files."
(cl-loop with mp-fn = (or (assoc-default
'match-part (helm-get-current-source))
'identity)
for i in files
for disp = (if (and helm-ff-transformer-show-only-basename
(not (helm-dir-is-dot i))
(not (and helm--url-regexp
(string-match helm--url-regexp i)))
(not (string-match helm-ff-url-regexp i)))
(helm-basename i) (abbreviate-file-name i))
for isremote = (or (file-remote-p i)
(helm-file-on-mounted-network-p i))
;; Call file-attributes only if:
;; - file is not remote
;; - helm-for-files--tramp-not-fancy is nil and file is remote AND
;; connected. (Bug#1679)
for type = (and (or (null isremote)
(and (null helm-for-files-tramp-not-fancy)
(file-remote-p i nil t)))
(car (file-attributes i)))
collect
(cond ((and (null type) isremote) (cons disp i))
((stringp type)
(cons (propertize disp
'face 'helm-ff-symlink
'match-part (funcall mp-fn disp)
'help-echo (expand-file-name i))
i))
((eq type t)
(cons (propertize disp
'face 'helm-ff-directory
'match-part (funcall mp-fn disp)
'help-echo (expand-file-name i))
i))
(t (let* ((ext (helm-file-name-extension disp))
(disp (propertize disp
'face 'helm-ff-file
'match-part (funcall mp-fn disp)
'help-echo (expand-file-name i))))
(when (condition-case _err
(string-match (format "\\.\\(%s\\)$" ext) disp)
(invalid-regexp nil))
(add-face-text-property
(match-beginning 1) (match-end 1)
'helm-ff-file-extension nil disp))
(cons disp i))))))
(defclass helm-files-in-current-dir-source (helm-source-sync helm-type-file)
((candidates :initform (lambda ()
(with-helm-current-buffer
(let ((dir (helm-current-directory)))
(when (file-accessible-directory-p dir)
(directory-files dir t))))))
(pattern-transformer :initform 'helm-recentf-pattern-transformer)
(match-part :initform (lambda (candidate)
(if (or helm-ff-transformer-show-only-basename
helm-recentf--basename-flag)
(helm-basename candidate) candidate)))
(fuzzy-match :initform t)
(migemo :initform t)))
(defvar helm-source-files-in-current-dir
(helm-make-source "Files from Current Directory"
'helm-files-in-current-dir-source))
;;;###autoload
(defun helm-for-files ()
"Preconfigured `helm' for opening files.
Run all sources defined in `helm-for-files-preferred-list'."
(interactive)
(require 'helm-x-files)
(unless helm-source-buffers-list
(setq helm-source-buffers-list
(helm-make-source "Buffers" 'helm-source-buffers)))
(helm :sources helm-for-files-preferred-list
:ff-transformer-show-only-basename nil
:buffer "*helm for files*"
:truncate-lines helm-buffers-truncate-lines))
(defun helm-multi-files-toggle-to-locate ()
(interactive)
(with-helm-alive-p
(with-helm-buffer
(if (setq helm-multi-files--toggle-locate
(not helm-multi-files--toggle-locate))
(progn
(helm-set-sources (unless (memq 'helm-source-locate
helm-sources)
(cons 'helm-source-locate helm-sources)))
(helm-set-source-filter '(helm-source-locate)))
(helm-kill-async-processes)
(helm-set-sources (remove 'helm-source-locate
helm-for-files-preferred-list))
(helm-set-source-filter nil)))))
(put 'helm-multi-files-toggle-to-locate 'helm-only t)
;;;###autoload
(defun helm-multi-files ()
"Preconfigured helm like `helm-for-files' but running locate only on demand.
Allow toggling back and forth from locate to others sources with
`helm-multi-files-toggle-locate-binding' key.
This avoids launching locate needlessly when what you are
searching for is already found."
(interactive)
(require 'helm-x-files)
(unless helm-source-buffers-list
(setq helm-source-buffers-list
(helm-make-source "Buffers" 'helm-source-buffers)))
(setq helm-multi-files--toggle-locate nil)
(helm-locate-set-command)
(helm-set-local-variable 'helm-async-outer-limit-hook
(list (lambda ()
(when (and helm-locate-fuzzy-match
(not (string-match-p
"\\s-" helm-pattern)))
(helm-redisplay-buffer)))))
(let ((sources (remove 'helm-source-locate helm-for-files-preferred-list))
(helm-locate-command
(if helm-locate-fuzzy-match
(unless (string-match-p "\\`locate -b" helm-locate-command)
(replace-regexp-in-string
"\\`locate" "locate -b" helm-locate-command))
helm-locate-command))
(old-key (lookup-key
helm-map
(read-kbd-macro helm-multi-files-toggle-locate-binding))))
(with-helm-temp-hook 'helm-after-initialize-hook
(define-key helm-map (kbd helm-multi-files-toggle-locate-binding)
'helm-multi-files-toggle-to-locate))
(unwind-protect
(helm :sources sources
:ff-transformer-show-only-basename nil
:buffer "*helm multi files*"
:truncate-lines helm-buffers-truncate-lines)
(define-key helm-map (kbd helm-multi-files-toggle-locate-binding)
old-key))))
;;;###autoload
(defun helm-recentf ()
"Preconfigured `helm' for `recentf'."
(interactive)
(helm :sources 'helm-source-recentf
:ff-transformer-show-only-basename nil
:buffer "*helm recentf*"))
(provide 'helm-for-files)
;;; helm-for-files.el ends here

100
code/elpa/helm-20220822.659/helm-global-bindings.el Normal file
View File

@ -0,0 +1,100 @@
;;; helm-global-bindings.el --- Bind global helm commands -*- 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-lib) ; For helm-aif (bug #2520).
;;; Command Keymap
;;
;;
(defcustom helm-command-prefix-key
(helm-aif (car (where-is-internal 'Control-X-prefix (list global-map)))
(concat it [?c]))
"The key `helm-command-prefix' is bound to in the global map."
:type '(choice (string :tag "Key") (const :tag "no binding"))
:group 'helm-config
:set
(lambda (var key)
(when (and (boundp var) (symbol-value var))
(define-key (current-global-map)
(read-kbd-macro (symbol-value var)) nil))
(when key
(define-key (current-global-map)
(read-kbd-macro key) 'helm-command-prefix))
(set var key)))
(defvar helm-command-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "a") 'helm-apropos)
(define-key map (kbd "e") 'helm-etags-select)
(define-key map (kbd "l") 'helm-locate)
(define-key map (kbd "s") 'helm-surfraw)
(define-key map (kbd "r") 'helm-regexp)
(define-key map (kbd "m") 'helm-man-woman)
(define-key map (kbd "t") 'helm-top)
(define-key map (kbd "/") 'helm-find)
(define-key map (kbd "i") 'helm-imenu)
(define-key map (kbd "I") 'helm-imenu-in-all-buffers)
(define-key map (kbd "<tab>") 'helm-lisp-completion-at-point)
(define-key map (kbd "p") 'helm-list-emacs-process)
(define-key map (kbd "C-x r b") 'helm-filtered-bookmarks)
(define-key map (kbd "M-y") 'helm-show-kill-ring)
(define-key map (kbd "C-c <SPC>") 'helm-all-mark-rings)
(define-key map (kbd "C-x C-f") 'helm-find-files)
(define-key map (kbd "f") 'helm-multi-files)
(define-key map (kbd "C-:") 'helm-eval-expression-with-eldoc)
(define-key map (kbd "C-,") 'helm-calcul-expression)
(define-key map (kbd "M-x") 'helm-M-x)
(define-key map (kbd "M-s o") 'helm-occur)
(define-key map (kbd "M-g a") 'helm-do-grep-ag)
(define-key map (kbd "c") 'helm-colors)
(define-key map (kbd "F") 'helm-select-xfont)
(define-key map (kbd "8") 'helm-ucs)
(define-key map (kbd "C-c f") 'helm-recentf)
(define-key map (kbd "C-c g") 'helm-google-suggest)
(define-key map (kbd "h i") 'helm-info-at-point)
(define-key map (kbd "h r") 'helm-info-emacs)
(define-key map (kbd "h g") 'helm-info-gnus)
(define-key map (kbd "h h") 'helm-documentation)
(define-key map (kbd "C-x C-b") 'helm-buffers-list)
(define-key map (kbd "C-x r i") 'helm-register)
(define-key map (kbd "C-c C-x") 'helm-run-external-command)
(define-key map (kbd "b") 'helm-resume)
(define-key map (kbd "M-g i") 'helm-gid)
(define-key map (kbd "@") 'helm-list-elisp-packages)
map))
;; Don't override the keymap we just defined with an empty
;; keymap. This also protect bindings changed by the user.
(defvar helm-command-prefix)
(define-prefix-command 'helm-command-prefix)
(fset 'helm-command-prefix helm-command-map)
(setq helm-command-prefix helm-command-map)
;;; Menu
(require 'helm-easymenu)
;;; Provide
(provide 'helm-global-bindings)
;;; helm-global-bindings.el ends here

1801
code/elpa/helm-20220822.659/helm-grep.el Normal file
View File

File diff suppressed because it is too large Load Diff

2504
code/elpa/helm-20220822.659/helm-help.el Normal file
View File

File diff suppressed because it is too large Load Diff

125
code/elpa/helm-20220822.659/helm-id-utils.el Normal file
View File

@ -0,0 +1,125 @@
;;; helm-id-utils.el --- Helm interface for id-utils. -*- lexical-binding: t -*-
;; Copyright (C) 2015 ~ 2020 Thierry Volpiatto
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Code:
(require 'helm-grep)
(require 'helm-help)
(defgroup helm-id-utils nil
"ID-Utils related Applications and libraries for Helm."
:group 'helm)
(defcustom helm-gid-program "gid"
"Name of gid command (usually `gid').
For Mac OS X users, if you install GNU coreutils, the name `gid'
might be occupied by `id' from GNU coreutils, and you should set
it to correct name (or absolute path). For example, if using
MacPorts to install id-utils, it should be `gid32'."
:group 'helm-id-utils
:type 'file)
(defcustom helm-gid-db-file-name "ID"
"Name of a database file created by `mkid' command from `ID-utils'."
:group 'helm-id-utils
:type 'string)
(defun helm-gid-candidates-process ()
(let* ((patterns (helm-mm-split-pattern helm-pattern))
(default-com (format "%s -r %s" helm-gid-program
(shell-quote-argument (car patterns))))
(cmd (helm-aif (cdr patterns)
(concat default-com
(cl-loop for p in it
concat (format " | grep --color=always %s"
(shell-quote-argument p))))
default-com))
(proc (start-process-shell-command
"gid" helm-buffer cmd)))
(set (make-local-variable 'helm-grep-last-cmd-line) cmd)
(prog1 proc
(set-process-sentinel
proc (lambda (_process event)
(when (string= event "finished\n")
(helm-maybe-show-help-echo)
(with-helm-window
(setq mode-line-format
'(" " mode-line-buffer-identification " "
(:eval (format "L%s" (helm-candidate-number-at-point))) " "
(:eval (propertize
(format "[Helm Gid process finished - (%s results)]"
(max (1- (count-lines
(point-min) (point-max)))
0))
'face 'helm-locate-finish))))
(force-mode-line-update))
(helm-log "Error: Gid %s"
(replace-regexp-in-string "\n" "" event))))))))
(defun helm-gid-filtered-candidate-transformer (candidates _source)
;; "gid -r" may add dups in some rare cases.
(cl-loop for c in (helm-fast-remove-dups candidates :test 'equal)
collect (helm-grep--filter-candidate-1 c)))
(defclass helm-gid-source (helm-source-async)
((header-name
:initform
(lambda (name)
(concat name " [" (helm-get-attr 'db-dir) "]")))
(db-dir :initarg :db-dir
:initform nil
:custom string
:documentation " Location of ID file.")
(candidates-process :initform #'helm-gid-candidates-process)
(filtered-candidate-transformer
:initform #'helm-gid-filtered-candidate-transformer)
(candidate-number-limit :initform 99999)
(action :initform (helm-make-actions
"Find File" 'helm-grep-action
"Find file other frame" 'helm-grep-other-frame
"Save results in grep buffer" 'helm-grep-save-results
"Find file other window" 'helm-grep-other-window))
(persistent-action :initform 'helm-grep-persistent-action)
(history :initform 'helm-grep-history)
(nohighlight :initform t)
(help-message :initform 'helm-grep-help-message)
(requires-pattern :initform 2)))
;;;###autoload
(defun helm-gid ()
"Preconfigured `helm' for `gid' command line of `ID-Utils'.
Need A database created with the command `mkid' above
`default-directory'.
Need id-utils as dependency which provide `mkid', `gid' etc..
See <https://www.gnu.org/software/idutils/>."
(interactive)
(let* ((db (locate-dominating-file
default-directory
helm-gid-db-file-name))
(helm-grep-default-directory-fn
(lambda () default-directory))
(helm-maybe-use-default-as-input t))
(cl-assert db nil "No DataBase found, create one with `mkid'")
(helm :sources (helm-make-source "Gid" 'helm-gid-source
:db-dir db)
:buffer "*helm gid*"
:keymap helm-grep-map
:truncate-lines helm-grep-truncate-lines)))
(provide 'helm-id-utils)
;;; helm-id-utils ends here

534
code/elpa/helm-20220822.659/helm-imenu.el Normal file
View File

@ -0,0 +1,534 @@
;;; helm-imenu.el --- Helm interface for Imenu -*- 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-lib)
(require 'imenu)
(require 'helm-utils)
(require 'helm-help)
(defvar all-the-icons-default-adjust)
(defvar all-the-icons-scale-factor)
(declare-function which-function "which-func")
(declare-function all-the-icons-material "ext:all-the-icons.el")
(declare-function all-the-icons-octicon "ext:all-the-icons.el")
(declare-function all-the-icons-faicon "ext:all-the-icons.el")
(declare-function all-the-icons-wicon "ext:all-the-icons.el")
(defgroup helm-imenu nil
"Imenu related libraries and applications for Helm."
:group 'helm)
(defcustom helm-imenu-delimiter " / "
"Delimit types of candidates and their value in `helm-buffer'."
:group 'helm-imenu
:type 'string)
(defcustom helm-imenu-execute-action-at-once-if-one
#'helm-imenu--execute-action-at-once-p
"Goto the candidate when only one is remaining."
:group 'helm-imenu
:type 'function)
(defcustom helm-imenu-all-buffer-assoc nil
"Major mode association alist for `helm-imenu-in-all-buffers'.
Allow `helm-imenu-in-all-buffers' searching in these associated
buffers even if they are not derived from each other. The alist
is bidirectional, i.e. no need to add \\='((foo . bar) (bar . foo)),
only \\='((foo . bar)) is needed."
:type '(alist :key-type symbol :value-type symbol)
:group 'helm-imenu)
(defcustom helm-imenu-in-all-buffers-separate-sources t
"Display imenu index of each buffer in its own source when non-nil.
When nil all candidates are displayed in a single source.
NOTE: Each source will have as name \"Imenu <buffer-name>\".
`helm-source-imenu-all' will not be set, however it will continue
to be used as a flag for using default as input. If you do not
want this behavior, remove it from
`helm-sources-using-default-as-input' even if not using a single
source to display imenu in all buffers."
:type 'boolean
:group 'helm-imenu)
(defcustom helm-imenu-type-faces
'(("^Variables$" . font-lock-variable-name-face)
("^\\(Function\\|Functions\\|Defuns\\)$" . font-lock-function-name-face)
("^\\(Types\\|Provides\\|Requires\\|Classes\\|Class\\|Includes\\|Imports\\|Misc\\|Code\\)$" . font-lock-type-face))
"Faces for showing type in helm-imenu.
This is a list of cons cells. The cdr of each cell is a face to
be used, and it can also just be like \\='(:foreground
\"yellow\"). Each car is a regexp match pattern of the imenu type
string."
:group 'helm-faces
:type '(repeat
(cons
(regexp :tag "Imenu type regexp pattern")
(sexp :tag "Face"))))
(defcustom helm-imenu-extra-modes nil
"Extra modes where `helm-imenu-in-all-buffers' should look into."
:group 'helm-imenu
:type '(repeat symbol))
(defcustom helm-imenu-hide-item-type-name nil
"Hide display name of imenu item type along with the icon when non nil.
This value can be toggled with \\<helm-imenu-map>\\[helm-imenu-toggle-type-view]."
:group 'helm-imenu
:type 'boolean)
(defcustom helm-imenu-use-icon nil
"Display an icon from all-the-icons package when non nil."
:group 'helm-imenu
:type 'boolean)
(defcustom helm-imenu-icon-type-alist
'(("Array" . (all-the-icons-material "crop" :face font-lock-builtin-face))
("Array" . (all-the-icons-material "crop" :face font-lock-builtin-face))
("Boolean" . (all-the-icons-material "crop" :face font-lock-builtin-face))
("Boolean" . (all-the-icons-material "crop" :face font-lock-builtin-face))
("Class" . (all-the-icons-octicon "package" :face font-lock-type-face))
("Class" . (all-the-icons-octicon "package" :face font-lock-type-face))
("Color" . (all-the-icons-material "color_lens" :face font-lock-builtin-face))
("Colors" . (all-the-icons-material "color_lens" :face font-lock-builtin-face))
("Constant" . (all-the-icons-material "crop" :face font-lock-builtin-face))
("Constants" . (all-the-icons-material "crop" :face font-lock-builtin-face))
("Constructor" . (all-the-icons-faicon "cube" :face font-lock-function-name-face))
("Constructors" . (all-the-icons-faicon "cube" :face font-lock-function-name-face))
("Enum Member" . (all-the-icons-octicon "three-bars" :face font-lock-type-face))
("Enum Members" . (all-the-icons-octicon "three-bars" :face font-lock-type-face))
("Enum" . (all-the-icons-faicon "cog" :face font-lock-type-face))
("Enums" . (all-the-icons-faicon "cog" :face font-lock-type-face))
("Event" . (all-the-icons-wicon "lightning" :face font-lock-builtin-face))
("Events" . (all-the-icons-wicon "lightning" :face font-lock-builtin-face))
("Field" . (all-the-icons-octicon "three-bars" :face font-lock-type-face))
("Fields" . (all-the-icons-octicon "three-bars" :face font-lock-type-face))
("File" . (all-the-icons-faicon "file" :face font-lock-variable-name-face))
("Files" . (all-the-icons-faicon "file" :face font-lock-variable-name-face))
("Folder" . (all-the-icons-faicon "folder" :face font-lock-variable-name-face))
("Folders" . (all-the-icons-faicon "folder" :face font-lock-variable-name-face))
("Interface" . (all-the-icons-octicon "package" :face font-lock-builtin-face))
("Interfaces" . (all-the-icons-octicon "package" :face font-lock-builtin-face))
("Keyword" . (all-the-icons-octicon "key" :face font-lock-builtin-face))
("Keywords" . (all-the-icons-octicon "key" :face font-lock-builtin-face))
("Method" . (all-the-icons-faicon "cube" :face font-lock-function-name-face))
("Methods" . (all-the-icons-faicon "cube" :face font-lock-function-name-face))
("Defun" . (all-the-icons-faicon "cube" :face font-lock-function-name-face))
("Defuns" . (all-the-icons-faicon "cube" :face font-lock-function-name-face))
("Fn" . (all-the-icons-faicon "cube" :face font-lock-function-name-face))
("Fns" . (all-the-icons-faicon "cube" :face font-lock-function-name-face))
("Function" . (all-the-icons-faicon "cube" :face font-lock-function-name-face))
("Functions" . (all-the-icons-faicon "cube" :face font-lock-function-name-face))
("Misc" . (all-the-icons-faicon "globe" :face font-lock-function-name-face))
("Miscs" . (all-the-icons-faicon "globe" :face font-lock-function-name-face))
("Module" . (all-the-icons-faicon "angle-double-right" :face font-lock-builtin-face))
("Modules" . (all-the-icons-faicon "angle-double-right" :face font-lock-builtin-face))
("Numeric" . (all-the-icons-material "crop" :face font-lock-builtin-face))
("Numeric" . (all-the-icons-material "crop" :face font-lock-builtin-face))
("Object" . (all-the-icons-faicon "angle-double-right" :face font-lock-builtin-face))
("Objects" . (all-the-icons-faicon "angle-double-right" :face font-lock-builtin-face))
("Operator" . (all-the-icons-faicon "calculator" :face font-lock-builtin-face))
("Operators" . (all-the-icons-faicon "calculator" :face font-lock-builtin-face))
("Property" . (all-the-icons-octicon "book" :face font-lock-variable-name-face))
("Properties" . (all-the-icons-octicon "book" :face font-lock-variable-name-face))
("Reference" . (all-the-icons-octicon "book" :face font-lock-variable-name-face))
("References" . (all-the-icons-octicon "book" :face font-lock-variable-name-face))
("Snippet" . (all-the-icons-material "border_style" :face font-lock-variable-name-face))
("Snippet" . (all-the-icons-material "border_style" :face font-lock-variable-name-face))
("String" . (all-the-icons-material "text_fields" :face font-lock-variable-name-face))
("Strings" . (all-the-icons-material "text_fields" :face font-lock-variable-name-face))
("Struct" . (all-the-icons-faicon "cog" :face font-lock-type-face))
("Structs" . (all-the-icons-faicon "cog" :face font-lock-type-face))
("Text" . (all-the-icons-material "text_fields" :face font-lock-variable-name-face))
("Texts" . (all-the-icons-material "text_fields" :face font-lock-variable-name-face))
("Top level" . (all-the-icons-faicon "globe" :face font-lock-function-name-face))
("Trait" . (all-the-icons-octicon "package" :face font-lock-builtin-face))
("Traits" . (all-the-icons-octicon "package" :face font-lock-builtin-face))
("Type" . (all-the-icons-faicon "cog" :face font-lock-type-face))
("Types" . (all-the-icons-faicon "cog" :face font-lock-type-face))
("Type Parameter" . (all-the-icons-material "code" :face font-lock-type-face))
("Type Parameters" . (all-the-icons-material "code" :face font-lock-type-face))
("Unit" . (all-the-icons-faicon "bar-chart" :face font-lock-builtin-face))
("Units" . (all-the-icons-faicon "bar-chart" :face font-lock-builtin-face))
("Value" . (all-the-icons-faicon "cog" :face font-lock-type-face))
("Values" . (all-the-icons-faicon "cog" :face font-lock-type-face))
("Variable" . (all-the-icons-octicon "book" :face font-lock-variable-name-face))
("Variables" . (all-the-icons-octicon "book":face font-lock-variable-name-face)))
"An alist of types associated with a sexp returning an icon.
The sexp should be an `all-the-icons' function with its args."
:type '(alist :key-type string :value-type sexp)
:group 'helm-imenu)
(defcustom helm-imenu-default-type-sexp
'(all-the-icons-faicon "globe" :face font-lock-function-name-face)
"Default sexp to use when no type for an object is found."
:type 'sexp
:group 'helm-imenu)
;;; keymap
(defvar helm-imenu-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map helm-map)
(define-key map (kbd "M-<down>") 'helm-imenu-next-section)
(define-key map (kbd "M-<up>") 'helm-imenu-previous-section)
(define-key map (kbd "C-]") 'helm-imenu-toggle-type-view)
map))
(defun helm-imenu-toggle-type-view ()
"Toggle candidate type view."
(interactive)
(with-helm-window
(setq helm-imenu-hide-item-type-name (not helm-imenu-hide-item-type-name))
(let* ((sel (substring (helm-get-selection nil 'withprop)
(if helm-imenu-use-icon 2 0)))
(type (get-text-property 1 'type-name sel)))
(setq sel (substring-no-properties sel))
(helm-force-update (if helm-imenu-hide-item-type-name
(format "^[ ]*%s$"
(car (last (split-string
sel helm-imenu-delimiter t))))
(format "^[ ]*%s / %s$"
type sel))))))
(put 'helm-imenu-toggle-type-view 'no-helm-mx t)
(defcustom helm-imenu-lynx-style-map nil
"Use Arrow keys to jump to occurences."
:group 'helm-imenu
:type 'boolean
:set (lambda (var val)
(set var val)
(if val
(progn
(define-key helm-imenu-map (kbd "<right>") 'helm-execute-persistent-action)
(define-key helm-imenu-map (kbd "<left>") 'helm-maybe-exit-minibuffer))
(define-key helm-imenu-map (kbd "<right>") nil)
(define-key helm-imenu-map (kbd "<left>") nil))))
(defun helm-imenu-next-or-previous-section (n)
(with-helm-window
(let* ((fn (lambda ()
(let ((str (buffer-substring
(point-at-bol) (point-at-eol))))
(if helm-imenu-hide-item-type-name
(get-text-property 1 'type-name str)
(car (split-string str helm-imenu-delimiter))))))
(curtype (funcall fn))
(stop-fn (if (> n 0)
#'helm-end-of-source-p
#'helm-beginning-of-source-p)))
(while (and (not (funcall stop-fn))
(string= curtype (funcall fn)))
(forward-line n))
(helm-mark-current-line)
(helm-follow-execute-persistent-action-maybe))))
(defun helm-imenu-next-section ()
(interactive)
(helm-imenu-next-or-previous-section 1))
(defun helm-imenu-previous-section ()
(interactive)
(helm-imenu-next-or-previous-section -1))
;;; Internals
(defvar helm-cached-imenu-alist nil)
(make-variable-buffer-local 'helm-cached-imenu-alist)
(defvar helm-cached-imenu-candidates nil)
(make-variable-buffer-local 'helm-cached-imenu-candidates)
(defvar helm-cached-imenu-tick nil)
(make-variable-buffer-local 'helm-cached-imenu-tick)
(defvar helm-imenu--in-all-buffers-cache nil)
(defvar helm-source-imenu nil "See (info \"(emacs)Imenu\")")
(defvar helm-source-imenu-all nil)
(defclass helm-imenu-source (helm-source-sync)
((candidates :initform 'helm-imenu-candidates)
(candidate-transformer :initform 'helm-imenu-transformer)
(persistent-action :initform 'helm-imenu-persistent-action)
(persistent-help :initform "Show this entry")
(nomark :initform t)
(keymap :initform 'helm-imenu-map)
(help-message :initform 'helm-imenu-help-message)
(action :initform 'helm-imenu-action)
(find-file-target :initform #'helm-imenu-quit-and-find-file-fn)
(group :initform 'helm-imenu)))
(defcustom helm-imenu-fuzzy-match nil
"Enable fuzzy matching in `helm-source-imenu'."
:group 'helm-imenu
:type 'boolean
:set (lambda (var val)
(set var val)
(setq helm-source-imenu
(helm-make-source "Imenu" 'helm-imenu-source
:fuzzy-match helm-imenu-fuzzy-match))))
(defun helm-imenu--maybe-switch-to-buffer (candidate)
(let ((cand (cdr candidate)))
(helm-aif (and (markerp cand) (marker-buffer cand))
(switch-to-buffer it))))
(defun helm-imenu--execute-action-at-once-p ()
(let ((cur (helm-get-selection))
(mb (with-helm-current-buffer
(save-excursion
(goto-char (point-at-bol))
(point-marker)))))
;; Happen when cursor is on the line where a definition is. This
;; prevent jumping to the definition where we are already, instead
;; display helm with all definitions and preselection to the place
;; we already are.
(if (equal (cdr cur) mb)
(prog1 nil
(helm-set-pattern "")
(helm-force-update))
t)))
(defun helm-imenu-quit-and-find-file-fn (source)
(let ((sel (helm-get-selection nil nil source)))
(when (and (consp sel) (markerp (cdr sel)))
(buffer-file-name (marker-buffer (cdr sel))))))
(defun helm-imenu-action (candidate)
"Default action for `helm-source-imenu'."
(helm-log-run-hook 'helm-goto-line-before-hook)
(helm-imenu--maybe-switch-to-buffer candidate)
(imenu candidate)
;; If semantic is supported in this buffer
;; imenu used `semantic-imenu-goto-function'
;; and position have been highlighted,
;; no need to highlight again.
(unless (eq imenu-default-goto-function
'semantic-imenu-goto-function)
(helm-highlight-current-line)))
(defun helm-imenu-persistent-action (candidate)
"Default persistent action for `helm-source-imenu'."
(helm-imenu--maybe-switch-to-buffer candidate)
(imenu candidate)
(helm-highlight-current-line))
(defun helm-imenu-candidates (&optional buffer)
(with-current-buffer (or buffer helm-current-buffer)
(let ((tick (buffer-modified-tick)))
(if (eq helm-cached-imenu-tick tick)
helm-cached-imenu-candidates
(setq imenu--index-alist nil)
(prog1 (setq helm-cached-imenu-candidates
(let ((index (imenu--make-index-alist t)))
(helm-imenu--candidates-1
(delete (assoc "*Rescan*" index) index))))
(setq helm-cached-imenu-tick tick))))))
(defun helm-imenu-candidates-in-all-buffers (&optional build-sources)
(let* ((lst (buffer-list))
(progress-reporter (make-progress-reporter
"Imenu indexing buffers..." 1 (length lst))))
(prog1
(cl-loop with cur-buf = (if build-sources
(current-buffer) helm-current-buffer)
for b in lst
for count from 1
when (with-current-buffer b
(and (or (member major-mode helm-imenu-extra-modes)
(derived-mode-p 'prog-mode))
(helm-same-major-mode-p
cur-buf helm-imenu-all-buffer-assoc)))
if build-sources
collect (helm-make-source
(format "Imenu in %s" (buffer-name b))
'helm-imenu-source
:candidates (with-current-buffer b
(helm-imenu-candidates b))
:fuzzy-match helm-imenu-fuzzy-match)
else
append (with-current-buffer b
(helm-imenu-candidates b))
do (progress-reporter-update progress-reporter count))
(progress-reporter-done progress-reporter))))
(defun helm-imenu--candidates-1 (alist)
(cl-loop for elm in alist
nconc (cond
((imenu--subalist-p elm)
(helm-imenu--candidates-1
(cl-loop for (e . v) in (cdr elm) collect
(cons (propertize
e 'helm-imenu-type (car elm))
;; If value is an integer, convert it
;; to a marker, otherwise it is a cons cell
;; and it will be converted on next recursions.
;; (Bug#1060) [1].
(if (integerp v) (copy-marker v) v)))))
((listp (cdr elm))
(and elm (list elm)))
(t
;; bug in imenu, should not be needed.
(and (cdr elm)
;; Semantic uses overlays whereas imenu uses
;; markers (Bug#1706).
(setcdr elm (pcase (cdr elm) ; Same as [1].
((and ov (pred overlayp))
(copy-overlay ov))
((and mk (or (pred markerp)
(pred integerp)))
(copy-marker mk))))
(list elm))))))
(defun helm-imenu--get-prop (item)
;; property value of ITEM can have itself
;; a property value which have itself a property value
;; ...and so on; Return a list of all these
;; properties values starting at ITEM.
(let* ((prop (get-text-property 0 'helm-imenu-type item))
(lst (list prop item)))
(when prop
(while prop
(setq prop (get-text-property 0 'helm-imenu-type prop))
(and prop (push prop lst)))
lst)))
(defun helm-imenu-icon-for-type (type)
"Return an icon for type TYPE.
The icon is found in `helm-imenu-icon-type-alist', if not
`helm-imenu-default-type-sexp' is evaled to provide a default icon."
(require 'all-the-icons)
(let ((all-the-icons-scale-factor 1.0)
(all-the-icons-default-adjust 0.0))
(or (helm-aand (assoc-default
type helm-imenu-icon-type-alist)
(apply (car it) (cdr it)))
(apply (car helm-imenu-default-type-sexp)
(cdr helm-imenu-default-type-sexp)))))
(defun helm-imenu-transformer (candidates)
(cl-loop for (k . v) in candidates
;; (k . v) == (symbol-name . marker)
for bufname = (buffer-name
(pcase v
((pred overlayp) (overlay-buffer v))
((or (pred markerp) (pred integerp))
(marker-buffer v))))
for types = (or (helm-imenu--get-prop k)
(list (if (with-current-buffer bufname
(derived-mode-p 'prog-mode))
"Function"
"Top level")
k))
for type-icon = (and helm-imenu-use-icon
(helm-imenu-icon-for-type (car types)))
for type-name = (propertize
(car types) 'face
(cl-loop for (p . f) in helm-imenu-type-faces
when (string-match p (car types))
return f
finally return 'default))
for disp1 = (mapconcat 'identity
(cdr types)
(propertize helm-imenu-delimiter
'face 'shadow))
for disp = (concat (if helm-imenu-use-icon
(concat (propertize " " 'display type-icon) " ")
"")
(if helm-imenu-hide-item-type-name
""
(concat type-name
(propertize helm-imenu-delimiter
'face 'shadow)))
(propertize disp1 'help-echo bufname 'types types))
collect
(cons (propertize disp 'type-name type-name) (cons k v))))
;;;###autoload
(defun helm-imenu ()
"Preconfigured `helm' for `imenu'."
(interactive)
(require 'which-func)
(unless helm-source-imenu
(setq helm-source-imenu
(helm-make-source "Imenu" 'helm-imenu-source
:fuzzy-match helm-imenu-fuzzy-match)))
(let* ((imenu-auto-rescan t)
(helm-highlight-matches-around-point-max-lines 'never)
(str (thing-at-point 'symbol))
(init-reg (and str (concat "\\_<" (regexp-quote str) "\\_>")))
(helm-execute-action-at-once-if-one
helm-imenu-execute-action-at-once-if-one))
(helm :sources 'helm-source-imenu
:default (and str (list init-reg str))
:preselect (helm-aif (which-function)
(concat "\\_<" (regexp-quote it) "\\_>")
init-reg)
:buffer "*helm imenu*")))
;;;###autoload
(defun helm-imenu-in-all-buffers ()
"Fetch Imenu entries in all buffers with similar mode as current.
A mode is similar as current if it is the same, it is derived
i.e. `derived-mode-p' or it have an association in
`helm-imenu-all-buffer-assoc'."
(interactive)
(require 'which-func)
(unless helm-imenu-in-all-buffers-separate-sources
(unless helm-source-imenu-all
(setq helm-source-imenu-all
(helm-make-source "Imenu in all buffers" 'helm-imenu-source
:init (lambda ()
;; Use a cache to avoid repeatedly sending
;; progress-reporter message when updating
;; (Bug#1704).
(setq helm-imenu--in-all-buffers-cache
(helm-imenu-candidates-in-all-buffers)))
:candidates 'helm-imenu--in-all-buffers-cache
:fuzzy-match helm-imenu-fuzzy-match))))
(let* ((imenu-auto-rescan t)
(helm-highlight-matches-around-point-max-lines 'never)
(str (thing-at-point 'symbol))
(init-reg (and str (concat "\\_<" (regexp-quote str) "\\_>")))
(helm-execute-action-at-once-if-one
helm-imenu-execute-action-at-once-if-one)
(helm-maybe-use-default-as-input
(not (null (memq 'helm-source-imenu-all
helm-sources-using-default-as-input))))
(sources (if helm-imenu-in-all-buffers-separate-sources
(helm-imenu-candidates-in-all-buffers 'build-sources)
'(helm-source-imenu-all))))
(helm :sources sources
:default (and str (list init-reg str))
:preselect (helm-aif (which-function)
(concat "\\_<" (regexp-quote it) "\\_>")
init-reg)
:buffer "*helm imenu all*")))
(provide 'helm-imenu)
;;; helm-imenu.el ends here

300
code/elpa/helm-20220822.659/helm-info.el Normal file
View File

@ -0,0 +1,300 @@
;;; helm-info.el --- Browse info index with 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-lib)
(require 'helm-utils)
(require 'info)
(declare-function Info-index-nodes "info" (&optional file))
(declare-function Info-goto-node "info" (&optional fork))
(declare-function Info-find-node "info" (filename nodename &optional no-going-back))
(declare-function ring-insert "ring")
(declare-function ring-empty-p "ring")
(declare-function ring-ref "ring")
(defvar Info-history)
(defvar Info-directory-list)
;;; Customize
(defgroup helm-info nil
"Info-related applications and libraries for Helm."
:group 'helm)
(defcustom helm-info-default-sources
'(helm-source-info-elisp
helm-source-info-cl
helm-source-info-eieio
helm-source-info-pages)
"Default sources to use for looking up symbols at point in Info
files with `helm-info-at-point'."
:group 'helm-info
:type '(repeat (choice symbol)))
;;; Build info-index sources with `helm-info-source' class.
(cl-defun helm-info-init (&optional (file (helm-get-attr 'info-file)))
"Initialize candidates for info FILE.
If FILE have nodes, loop through all nodes and accumulate candidates
found in each node, otherwise scan only the current info buffer."
;; Allow reinit candidate buffer when using edebug.
(helm-aif (and debug-on-error
(helm-candidate-buffer))
(kill-buffer it))
(unless (helm-candidate-buffer)
(save-selected-window
(info file " *helm info temp buffer*")
(let ((tobuf (helm-candidate-buffer 'global))
Info-history)
(helm-aif (Info-index-nodes)
(cl-dolist (node it)
(Info-goto-node node)
(helm-info-scan-current-buffer tobuf))
(helm-info-scan-current-buffer tobuf))
(bury-buffer)))))
(defun helm-info-scan-current-buffer (tobuf)
"Scan current info buffer and print lines to TOBUF.
Argument TOBUF is the `helm-candidate-buffer'."
(let (start end line)
(goto-char (point-min))
(while (search-forward "\n* " nil t)
(unless (search-forward "Menu:\n" (1+ (point-at-eol)) t)
(setq start (point-at-bol)
;; Fix Bug#1503 by getting the invisible
;; info displayed on next line in long strings.
;; e.g "* Foo.\n (line 12)" instead of
;; "* Foo.(line 12)"
end (or (save-excursion
(goto-char (point-at-bol))
(re-search-forward "(line +[0-9]+)" nil t))
(point-at-eol))
;; Long string have a new line inserted before the
;; invisible spec, remove it.
line (replace-regexp-in-string
"\n" "" (buffer-substring start end)))
(with-current-buffer tobuf
(insert line)
(insert "\n"))))))
(defun helm-info-goto (node-line)
"The helm-info action to jump to NODE-LINE."
(Info-goto-node (car node-line))
(helm-goto-line (cdr node-line)))
(defvar helm-info--node-regexp
"^\\* +\\(.+\\):[ \\t]+\\(.*\\)\\(?:[ \\t]*\\)(line +\\([0-9]+\\))"
"A regexp that should match file name, node name and line number in
a line like this:
\* bind: Bash Builtins. (line 21).")
(defun helm-info-display-to-real (line)
"Transform LINE to an acceptable argument for `info'.
If line have a node use the node, otherwise use directly first name found."
(let (nodename linum)
(when (string-match helm-info--node-regexp line)
(setq nodename (match-string 2 line)
linum (match-string 3 line)))
(if nodename
(cons (format "(%s)%s"
(helm-get-attr 'info-file)
(replace-regexp-in-string ":\\'" "" nodename))
(string-to-number (or linum "1")))
(cons (format "(%s)%s"
(helm-get-attr 'info-file)
(helm-aand (replace-regexp-in-string "^* " "" line)
(replace-regexp-in-string "::?.*\\'" "" it)))
1))))
(defclass helm-info-source (helm-source-in-buffer)
((info-file :initarg :info-file
:initform nil
:custom 'string)
(init :initform #'helm-info-init)
(display-to-real :initform #'helm-info-display-to-real)
(get-line :initform #'buffer-substring)
(action :initform '(("Goto node" . helm-info-goto)))))
(defmacro helm-build-info-source (fname &rest args)
`(helm-make-source (concat "Info Index: " ,fname) 'helm-info-source
:info-file ,fname ,@args))
(defun helm-build-info-index-command (name doc source buffer)
"Define a Helm command NAME with documentation DOC.
Arg SOURCE will be an existing helm source named
`helm-source-info-<NAME>' and BUFFER a string buffer name."
(defalias (intern (concat "helm-info-" name))
(lambda ()
(interactive)
(helm :sources source
:buffer buffer
:candidate-number-limit 1000))
doc))
(defun helm-define-info-index-sources (var-value &optional commands)
"Define Helm sources named helm-source-info-<NAME>.
Sources are generated for all entries of
`helm-default-info-index-list'.
If COMMANDS arg is non-nil, also build commands named
`helm-info-<NAME>'.
Where NAME is an element of `helm-default-info-index-list'."
(cl-loop for str in var-value
for sym = (intern (concat "helm-source-info-" str))
do (set sym (helm-build-info-source str))
when commands
do (helm-build-info-index-command
str (format "Predefined helm for %s info." str)
sym (format "*helm info %s*" str))))
(defun helm-info-index-set (var value)
(set var value)
(helm-define-info-index-sources value t))
;;; Search Info files
;; `helm-info' is the main entry point here. It prompts the user for an Info
;; file, then a term in the file's index to jump to.
(defvar helm-info-searched (make-ring 32)
"Ring of previously searched Info files.")
(defun helm-get-info-files ()
"Return list of Info files to use for `helm-info'.
Elements of the list are strings of Info file names without
extensions (e.g., \"emacs\" for file \"emacs.info.gz\"). Info
files are found by searching directories in
`Info-directory-list'."
(info-initialize) ; Build Info-directory-list from INFOPATH (Bug#2118)
(let ((files (cl-loop for d in (or Info-directory-list
Info-default-directory-list)
when (file-directory-p d)
append (directory-files d nil "\\.info"))))
(helm-fast-remove-dups
(cl-loop for f in files collect
(helm-file-name-sans-extension f))
:test 'equal)))
(defcustom helm-default-info-index-list
(helm-get-info-files)
"Info files to search in with `helm-info'."
:group 'helm-info
:type '(repeat (choice string))
:set 'helm-info-index-set)
(defun helm-info-search-index (candidate)
"Search the index of CANDIDATE's Info file using the function
helm-info-<CANDIDATE>."
(let ((helm-info-function
(intern-soft (concat "helm-info-" candidate))))
(when (fboundp helm-info-function)
(funcall helm-info-function)
(ring-insert helm-info-searched candidate))))
(defun helm-def-source--info-files ()
"Return a Helm source for Info files."
(helm-build-sync-source "Helm Info"
:candidates
(lambda () (copy-sequence helm-default-info-index-list))
:candidate-number-limit 999
:candidate-transformer
(lambda (candidates)
(sort candidates #'string-lessp))
:nomark t
:action '(("Search index" . helm-info-search-index))))
;;;###autoload
(defun helm-info (&optional refresh)
"Preconfigured `helm' for searching Info files' indices.
With a prefix argument \\[universal-argument], set REFRESH to
non-nil.
Optional parameter REFRESH, when non-nil, re-evaluates
`helm-default-info-index-list'. If the variable has been
customized, set it to its saved value. If not, set it to its
standard value. See `custom-reevaluate-setting' for more.
REFRESH is useful when new Info files are installed. If
`helm-default-info-index-list' has not been customized, the new
Info files are made available."
(interactive "P")
(let ((default (unless (ring-empty-p helm-info-searched)
(ring-ref helm-info-searched 0))))
(when refresh
(custom-reevaluate-setting 'helm-default-info-index-list))
(helm :sources (helm-def-source--info-files)
:buffer "*helm Info*"
:preselect (and default
(concat "\\_<" (regexp-quote default) "\\_>")))))
;;;; Info at point
;; `helm-info-at-point' is the main entry point here. It searches for the
;; symbol at point through the Info sources defined in
;; `helm-info-default-sources' and jumps to it.
(defvar helm-info--pages-cache nil
"Cache for all Info pages on the system.")
(defvar helm-source-info-pages
(helm-build-sync-source "Info Pages"
:init #'helm-info-pages-init
:candidates (lambda () helm-info--pages-cache)
:action '(("Show with Info" .
(lambda (node-str)
(info (replace-regexp-in-string
"^[^:]+: " "" node-str)))))
:requires-pattern 2)
"Helm source for Info pages.")
(defun helm-info-pages-init ()
"Collect candidates for initial Info node Top."
(or helm-info--pages-cache
(let ((info-topic-regexp "\\* +\\([^:]+: ([^)]+)[^.]*\\)\\."))
(save-selected-window
(info "dir" " *helm info temp buffer*")
(Info-find-node "dir" "top")
(goto-char (point-min))
(while (re-search-forward info-topic-regexp nil t)
(push (match-string-no-properties 1)
helm-info--pages-cache))
(kill-buffer)))))
;;;###autoload
(defun helm-info-at-point ()
"Preconfigured `helm' for searching info at point."
(interactive)
;; Symbol at point is used as default as long as one of the sources
;; in `helm-info-default-sources' is member of
;; `helm-sources-using-default-as-input'.
(cl-loop for src in helm-info-default-sources
for name = (if (symbolp src)
(assoc 'name (symbol-value src))
(assoc 'name src))
unless name
do (warn "Couldn't build source `%S' without its info file" src))
(helm :sources helm-info-default-sources
:buffer "*helm info*"))
(provide 'helm-info)
;;; helm-info.el ends here

482
code/elpa/helm-20220822.659/helm-locate.el Normal file
View File

@ -0,0 +1,482 @@
;;; helm-locate.el --- helm interface for locate. -*- 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/>.
;; NOTE for WINDOZE users:
;; You have to install Everything with his command line interface here:
;; http://www.voidtools.com/download.php
;;; Code:
(require 'cl-lib)
(require 'helm)
(require 'helm-types)
(require 'helm-help)
(defvar helm-ff-default-directory)
(declare-function helm-read-file-name "helm-mode")
(defgroup helm-locate nil
"Locate related Applications and libraries for Helm."
:group 'helm)
(defcustom helm-locate-db-file-regexp "m?locate\\.db$"
"Default regexp to match locate database.
If nil Search in all files."
:type 'string)
(defcustom helm-ff-locate-db-filename "locate.db"
"The basename of the locatedb file you use locally in your directories.
When this is set and Helm finds such a file in the directory from
where you launch locate, it will use this file and will not
prompt you for a db file.
Note that this happen only when locate is launched with a prefix
arg."
:type 'string)
(defcustom helm-locate-command nil
"A list of arguments for locate program.
Helm will calculate a default value for your system on startup
unless `helm-locate-command' is non-nil.
Here are the default values it will use according to your system:
Gnu/linux: \"locate %s -e -A --regex %s\"
berkeley-unix: \"locate %s %s\"
windows-nt: \"es %s %s\"
Others: \"locate %s %s\"
This string will be passed to format so it should end with `%s'.
The first format spec is used for the \"-i\" value of locate/es,
so don't set it directly but use `helm-locate-case-fold-search'
for this.
The last option must be the one preceding pattern i.e \"-r\" or
\"--regex\".
You will be able to pass other options such as \"-b\" or \"l\"
during Helm invocation after entering pattern only when multi
matching, not when fuzzy matching.
Note that the \"-b\" option is added automatically by Helm when
var `helm-locate-fuzzy-match' is non-nil and switching back from
multimatch to fuzzy matching (this is done automatically when a
space is detected in pattern)."
:type 'string)
(defcustom helm-locate-create-db-command
"updatedb -l 0 -o '%s' -U '%s'"
"Command used to create a locale locate db file."
:type 'string)
(defcustom helm-locate-case-fold-search helm-case-fold-search
"It have the same meaning as `helm-case-fold-search'.
The -i option of locate will be used depending of value of
`helm-pattern' when this is set to \\='smart.
When nil \"-i\" will not be used at all and when non-nil it will
always be used.
NOTE: the -i option of the \"es\" command used on windows does
the opposite of \"locate\" command."
:type 'symbol)
(defcustom helm-locate-fuzzy-match nil
"Enable fuzzy matching in `helm-locate'.
Note that when this is enabled searching is done on basename."
:type 'boolean)
(defcustom helm-locate-fuzzy-sort-fn
#'helm-locate-default-fuzzy-sort-fn
"Default fuzzy matching sort function for locate."
:type 'boolean)
(defcustom helm-locate-project-list nil
"A list of directories, your projects.
When set, allow browsing recursively files in all directories of
this list with `helm-projects-find-files'."
:type '(repeat string))
(defcustom helm-locate-recursive-dirs-command "locate -i -e -A --regex '^%s' '%s.*$'"
"Command used for recursive directories completion in `helm-find-files'.
For Windows and `es' use something like \"es -r ^%s.*%s.*$\"
The two format specs are mandatory.
If for some reasons you can't use locate because your filesystem
doesn't have a database, you can use find command from findutils
but be aware that it will be much slower. See `helm-find-files'
embedded help for more infos."
:type 'string
:group 'helm-files)
(defvar helm-locate-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map helm-generic-files-map)
(define-key map (kbd "DEL") 'helm-delete-backward-no-update)
map))
(defface helm-locate-finish
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:foreground "Green"))
"Face used in mode line when locate process is finish."
:group 'helm-locate)
(defun helm-ff-find-locatedb (&optional from-ff)
"Try to find if a local locatedb file is available.
The search is done in `helm-ff-default-directory' or falls back to
`default-directory' if FROM-FF is nil."
(helm-aif (and helm-ff-locate-db-filename
(locate-dominating-file
(or (and from-ff
helm-ff-default-directory)
default-directory)
helm-ff-locate-db-filename))
(expand-file-name helm-ff-locate-db-filename it)))
(defun helm-locate-create-db-default-function (db-name directory)
"Default function used to create a locale locate db file.
Argument DB-NAME name of the db file.
Argument DIRECTORY root of file system subtree to scan."
(format helm-locate-create-db-command
db-name (expand-file-name directory)))
(defvar helm-locate-create-db-function
#'helm-locate-create-db-default-function
"Function used to create a locale locate db file.
It should receive the same arguments as
`helm-locate-create-db-default-function'.")
(defun helm-locate-1 (&optional localdb init from-ff default)
"Generic function to run Locate.
Prefix arg LOCALDB when (4) search and use a local locate db file
when it exists or create it, when (16) force update of existing
db file even if exists.
It has no effect when locate command is \\='es'. INIT is a string
to use as initial input in prompt.
See `helm-locate-with-db' and `helm-locate'."
(require 'helm-mode)
(helm-locate-set-command)
(let ((pfn (lambda (candidate)
(if (file-directory-p candidate)
(message "Error: The locate Db should be a file")
(if (= (shell-command
(funcall helm-locate-create-db-function
candidate
helm-ff-default-directory))
0)
(message "New locatedb file `%s' created" candidate)
(error "Failed to create locatedb file `%s'" candidate)))))
(locdb (and localdb
(not (string-match "^es" helm-locate-command))
(or (and (equal '(4) localdb)
(helm-ff-find-locatedb from-ff))
(helm-read-file-name
"Create Locate Db file: "
:initial-input (expand-file-name "locate.db"
(or helm-ff-default-directory
default-directory))
:preselect helm-locate-db-file-regexp
:test (lambda (x)
(if helm-locate-db-file-regexp
;; Select only locate db files and directories
;; to allow navigation.
(or (string-match
helm-locate-db-file-regexp x)
(file-directory-p x))
x)))))))
(when (and locdb (or (equal localdb '(16))
(not (file-exists-p locdb))))
(funcall pfn locdb))
(helm-locate-with-db (and localdb locdb) init default)))
(defun helm-locate-set-command ()
"Setup `helm-locate-command' if not already defined."
(unless helm-locate-command
(setq helm-locate-command
(cl-case system-type
(gnu/linux "locate %s -e -A --regex %s")
(berkeley-unix "locate %s %s")
(windows-nt "es %s %s")
(t "locate %s %s")))))
(defun helm-locate-initial-setup ()
(require 'helm-for-files)
(helm-locate-set-command))
(defvar helm-file-name-history nil)
(defun helm-locate-with-db (&optional db initial-input default)
"Run locate -d DB.
If DB is not given or nil use locate without -d option.
Argument DB can be given as a string or list of db files.
Argument INITIAL-INPUT is a string to use as initial-input.
See also `helm-locate'."
(require 'helm-files)
(when (and db (stringp db)) (setq db (list db)))
(helm-locate-set-command)
(let ((helm-locate-command
(if db
(replace-regexp-in-string
"locate"
(format (if helm-locate-fuzzy-match
"locate -b -d '%s'" "locate -d '%s'")
(mapconcat 'identity
;; Remove eventually
;; marked directories by error.
(cl-loop for i in db
unless (file-directory-p i)
;; expand-file-name to resolve
;; abbreviated fnames not
;; expanding inside single
;; quotes i.e. '%s'.
collect (expand-file-name i))
":"))
helm-locate-command)
(if (and helm-locate-fuzzy-match
(not (string-match-p "\\`locate -b" helm-locate-command)))
(replace-regexp-in-string
"\\`locate" "locate -b" helm-locate-command)
helm-locate-command))))
(setq helm-file-name-history (mapcar 'helm-basename file-name-history))
(helm :sources 'helm-source-locate
:buffer "*helm locate*"
:ff-transformer-show-only-basename nil
:input initial-input
:default default
:history 'helm-file-name-history)))
(defun helm-locate-update-mode-line (process-name)
"Update mode-line with PROCESS-NAME status information."
(with-helm-window
(setq mode-line-format
`(" " mode-line-buffer-identification " "
(:eval (format "L%s" (helm-candidate-number-at-point))) " "
(:eval (propertize
(format "[%s process finished - (%s results)]"
(max (1- (count-lines
(point-min) (point-max)))
0)
,process-name)
'face 'helm-locate-finish))))
(force-mode-line-update)))
(defun helm-locate--default-process-coding-system ()
"Fix `default-process-coding-system' in locate for Windows systems."
;; This is an attempt to fix issue #1322.
(if (and (eq system-type 'windows-nt)
(boundp 'w32-ansi-code-page))
(let ((code-page-eol
(intern (format "cp%s-%s" w32-ansi-code-page "dos"))))
(if (ignore-errors (check-coding-system code-page-eol))
(cons code-page-eol code-page-eol)
default-process-coding-system))
default-process-coding-system))
(defun helm-locate-init ()
"Initialize async locate process for `helm-source-locate'."
(let* ((default-process-coding-system
(helm-locate--default-process-coding-system))
(locate-is-es (string-match "\\`es" helm-locate-command))
(real-locate (string-match "\\`locate" helm-locate-command))
(case-sensitive-flag (if locate-is-es "-i" ""))
(ignore-case-flag (if (or locate-is-es
(not real-locate)) "" "-i"))
(args (helm-mm-split-pattern helm-pattern))
(cmd (format helm-locate-command
(cl-case helm-locate-case-fold-search
(smart (let ((case-fold-search nil))
(if (string-match "[[:upper:]]" helm-pattern)
case-sensitive-flag
ignore-case-flag)))
(t (if helm-locate-case-fold-search
ignore-case-flag
case-sensitive-flag)))
(helm-aif (cdr args)
(concat
;; The pattern itself.
(shell-quote-argument (car args)) " "
;; Possible locate args added
;; after pattern, don't quote them.
(mapconcat 'identity it " "))
(shell-quote-argument (car args)))))
(default-directory (if (file-directory-p default-directory)
default-directory "/")))
(helm-log "Starting helm-locate process")
(helm-log "Command line used was:\n\n%s"
(concat ">>> " (propertize cmd 'face 'font-lock-comment-face) "\n\n"))
(prog1
(start-process-shell-command
"locate-process" helm-buffer
cmd)
(set-process-sentinel
(get-buffer-process helm-buffer)
(lambda (process event)
(let* ((err (process-exit-status process))
(noresult (= err 1)))
(cond (noresult
(with-helm-buffer
(unless (cdr helm-sources)
(insert (concat "* Exit with code 1, no result found,"
" command line was:\n\n "
cmd)))))
((string= event "finished\n")
(when (and helm-locate-fuzzy-match
(not (string-match-p "\\s-" helm-pattern)))
(helm-redisplay-buffer))
(helm-locate-update-mode-line "Locate"))
(t
(helm-log "Error: Locate %s"
(replace-regexp-in-string "\n" "" event))))))))))
(defun helm-locate-default-fuzzy-sort-fn (candidates)
"Default sort function for files in fuzzy matching.
Sort is done on basename of CANDIDATES."
(helm-fuzzy-matching-default-sort-fn-1 candidates nil t))
(defclass helm-locate-override-inheritor (helm-type-file) ())
(defclass helm-locate-source (helm-source-async helm-locate-override-inheritor)
((init :initform 'helm-locate-initial-setup)
(candidates-process :initform 'helm-locate-init)
(requires-pattern :initform 3)
(history :initform 'helm-file-name-history)
(persistent-action :initform 'helm-ff-kill-or-find-buffer-fname)
(candidate-number-limit :initform 9999)
(redisplay :initform (progn helm-locate-fuzzy-sort-fn))))
;; Override helm-type-file class keymap.
(cl-defmethod helm--setup-source :after ((source helm-locate-override-inheritor))
(setf (slot-value source 'keymap) helm-locate-map)
(setf (slot-value source 'group) 'helm-locate))
(defvar helm-source-locate
(helm-make-source "Locate" 'helm-locate-source
:pattern-transformer 'helm-locate-pattern-transformer
;; :match-part is only used here to tell helm which part
;; of candidate to highlight.
:match-part (lambda (candidate)
(if (or (string-match-p " -b\\'" helm-pattern)
(and helm-locate-fuzzy-match
(not (string-match "\\s-" helm-pattern))))
(helm-basename candidate)
candidate))))
(defun helm-locate-pattern-transformer (pattern)
(if helm-locate-fuzzy-match
;; When fuzzy is enabled helm add "-b" option on startup.
(cond ((string-match-p " " pattern)
(when (string-match "\\`locate -b" helm-locate-command)
(setq helm-locate-command
(replace-match "locate" t t helm-locate-command)))
pattern)
(t
(unless (string-match-p "\\`locate -b" helm-locate-command)
(setq helm-locate-command
(replace-regexp-in-string
"\\`locate" "locate -b" helm-locate-command)))
(helm--mapconcat-pattern pattern)))
pattern))
(defun helm-locate-find-dbs-in-projects (&optional update)
(let* ((pfn (lambda (candidate directory)
(unless (= (shell-command
(funcall helm-locate-create-db-function
candidate
directory))
0)
(error "Failed to create locatedb file `%s'" candidate)))))
(cl-loop for p in helm-locate-project-list
for db = (expand-file-name
helm-ff-locate-db-filename
(file-name-as-directory p))
if (and (null update) (file-exists-p db))
collect db
else do (funcall pfn db p)
and collect db)))
;;; Directory completion for hff.
;;
(defclass helm-locate-subdirs-source (helm-source-in-buffer)
((basedir :initarg :basedir
:initform nil
:custom string)
(subdir :initarg :subdir
:initform nil
:custom 'string)
(data :initform #'helm-locate-init-subdirs)
(group :initform 'helm-locate)))
(defun helm-locate-init-subdirs ()
(with-temp-buffer
(call-process-shell-command
(if (string-match-p "\\`fd" helm-locate-recursive-dirs-command)
(format helm-locate-recursive-dirs-command
;; fd pass path at end.
(helm-get-attr 'subdir) (helm-get-attr 'basedir))
(format helm-locate-recursive-dirs-command
(if (string-match-p "\\`es" helm-locate-recursive-dirs-command)
;; Fix W32 paths.
(replace-regexp-in-string
"/" "\\\\\\\\" (helm-get-attr 'basedir))
(helm-get-attr 'basedir))
(helm-get-attr 'subdir)))
nil t nil)
(buffer-string)))
;;;###autoload
(defun helm-projects-find-files (update)
"Find files with locate in `helm-locate-project-list'.
With a prefix arg refresh the database in each project."
(interactive "P")
(helm-locate-set-command)
(cl-assert (and (string-match-p "\\`locate" helm-locate-command)
(executable-find "updatedb"))
nil "Unsupported locate version")
(let ((dbs (helm-locate-find-dbs-in-projects update)))
(if dbs
(helm-locate-with-db dbs)
(user-error "No projects found, please setup `helm-locate-project-list'"))))
;;;###autoload
(defun helm-locate (arg)
"Preconfigured `helm' for Locate.
Note: you can add locate options after entering pattern.
See \\='man locate' for valid options and also `helm-locate-command'.
You can specify a local database with prefix argument ARG.
With two prefix arg, refresh the current local db or create it if
it doesn't exists.
To create a user specific db, use
\"updatedb -l 0 -o db_path -U directory\".
Where db_path is a filename matched by
`helm-locate-db-file-regexp'."
(interactive "P")
(helm-set-local-variable 'helm-async-outer-limit-hook
(list (lambda ()
(when (and helm-locate-fuzzy-match
(not (string-match-p
"\\s-" helm-pattern)))
(helm-redisplay-buffer)))))
(setq helm-ff-default-directory default-directory)
(helm-locate-1 arg nil nil (thing-at-point 'filename)))
(provide 'helm-locate)
;;; helm-locate.el ends here

114
code/elpa/helm-20220822.659/helm-man.el Normal file
View File

@ -0,0 +1,114 @@
;;; helm-man.el --- Man and woman UI -*- 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)
(defvar woman-topic-all-completions)
(defvar woman-manpath)
(defvar woman-path)
(defvar woman-expanded-directory-path)
(declare-function woman-file-name "woman.el" (topic &optional re-cache))
(declare-function woman-file-name-all-completions "woman.el" (topic))
(declare-function Man-getpage-in-background "man.el" (topic))
(declare-function woman-expand-directory-path "woman.el" (path-dirs path-regexps))
(declare-function woman-topic-all-completions "woman.el" (path))
(declare-function helm-generic-sort-fn "helm-utils.el" (S1 S2))
(declare-function helm-comp-read "helm-mode")
(defgroup helm-man nil
"Man and Woman applications for Helm."
:group 'helm)
(defcustom helm-man-or-woman-function 'Man-getpage-in-background
"Default command to display a man page."
:group 'helm-man
:type '(radio :tag "Preferred command to display a man page"
(const :tag "Man" Man-getpage-in-background)
(const :tag "Woman" woman)))
(defcustom helm-man-format-switches (cl-case system-type
((darwin macos) "%s")
(t "-l %s"))
"Arguments to pass to the `manual-entry' function.
Arguments are passed to `manual-entry' with `format.'"
:group 'helm-man
:type 'string)
;; Internal
(defvar helm-man--pages nil
"All man pages on system.
Will be calculated the first time you invoke Helm with this
source.")
(defun helm-man-default-action (candidate)
"Default action for jumping to a woman or man page from Helm."
(let ((wfiles (mapcar #'car (woman-file-name-all-completions candidate))))
(condition-case nil
(let ((file (if (cdr wfiles)
(helm-comp-read "ManFile: " wfiles :must-match t)
(car wfiles))))
(if (eq helm-man-or-woman-function 'Man-getpage-in-background)
(manual-entry (format helm-man-format-switches file))
(condition-case nil
(woman-find-file file)
;; If woman is unable to format correctly
;; try Man instead.
(error (kill-buffer)
(manual-entry (format helm-man-format-switches file))))))
;; If even Man failed with file as argument, try again with Man
;; but using Topic candidate instead of the file calculated by
;; woman.
(error (kill-buffer)
(Man-getpage-in-background candidate)))))
(defun helm-man--init ()
(require 'woman)
(require 'helm-utils)
(unless helm-man--pages
(setq woman-expanded-directory-path
(woman-expand-directory-path woman-manpath woman-path))
(setq woman-topic-all-completions
(woman-topic-all-completions woman-expanded-directory-path))
(setq helm-man--pages (mapcar 'car woman-topic-all-completions)))
(helm-init-candidates-in-buffer 'global helm-man--pages))
(defvar helm-source-man-pages
(helm-build-in-buffer-source "Manual Pages"
:init #'helm-man--init
:persistent-action #'ignore
:filtered-candidate-transformer
(lambda (candidates _source)
(sort candidates #'helm-generic-sort-fn))
:action '(("Display Man page" . helm-man-default-action))
:group 'helm-man))
;;;###autoload
(defun helm-man-woman (arg)
"Preconfigured `helm' for Man and Woman pages.
With a prefix arg reinitialize the cache."
(interactive "P")
(when arg (setq helm-man--pages nil))
(helm :sources 'helm-source-man-pages
:buffer "*helm man woman*"))
(provide 'helm-man)
;;; helm-man.el ends here

393
code/elpa/helm-20220822.659/helm-misc.el Normal file
View File

@ -0,0 +1,393 @@
;;; helm-misc.el --- Various functions 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/>.
;;; Code:
(require 'cl-lib)
(require 'helm)
(require 'helm-help)
(require 'helm-types)
(declare-function display-time-world-display "time.el")
(defvar display-time-world-list)
(declare-function LaTeX-math-mode "ext:latex.el")
(declare-function jabber-chat-with "ext:jabber.el")
(declare-function jabber-read-account "ext:jabber.el")
(declare-function helm-comp-read "helm-mode")
(defgroup helm-misc nil
"Various Applications and libraries for Helm."
:group 'helm)
(defcustom helm-time-zone-home-location "Paris"
"The time zone of your home."
:group 'helm-misc
:type 'string)
(defcustom helm-timezone-actions
'(("Set timezone env (TZ)" . (lambda (candidate)
(setenv "TZ" candidate))))
"Actions for helm-timezone."
:group 'helm-misc
:type '(alist :key-type string :value-type function))
(defface helm-time-zone-current
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:foreground "green"))
"Face used to colorize current time in `helm-world-time'."
:group 'helm-misc)
(defface helm-time-zone-home
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:foreground "red"))
"Face used to colorize home time in `helm-world-time'."
:group 'helm-misc)
;;; Latex completion
;;
;; Test
;; (setq LaTeX-math-menu '("Math"
;; ["foo" val0 t]
;; ("bar"
;; ["baz" val1 t])
;; ("aze"
;; ["zer" val2 t])
;; ("AMS"
;; ("rec"
;; ["fer" val3 t])
;; ("rty"
;; ["der" val4 t]))
;; ("ABC"
;; ("xcv"
;; ["sdf" val5 t])
;; ("dfg"
;; ["fgh" val6 t]))))
;; (helm-latex-math-candidates)
;; =>
;; (("foo" . val0)
;; ("baz" . val1)
;; ("zer" . val2)
;; ("fer" . val3)
;; ("der" . val4)
;; ("sdf" . val5)
;; ("fgh" . val6))
(defvar LaTeX-math-menu)
(defun helm-latex-math-candidates ()
(cl-labels ((helm-latex--math-collect (L)
(cond ((vectorp L)
(list (cons (aref L 0) (aref L 1))))
((listp L)
(cl-loop for a in L nconc
(helm-latex--math-collect a))))))
(helm-latex--math-collect LaTeX-math-menu)))
(defvar helm-source-latex-math
(helm-build-sync-source "Latex Math Menu"
:init (lambda ()
(with-helm-current-buffer
(LaTeX-math-mode 1)))
:candidate-number-limit 9999
:candidates 'helm-latex-math-candidates
:action (lambda (candidate)
(call-interactively candidate))))
;;; Jabber Contacts (jabber.el)
(defun helm-jabber-online-contacts ()
"List online Jabber contacts."
(with-no-warnings
(cl-loop for item in (jabber-concat-rosters)
when (get item 'connected)
collect
(if (get item 'name)
(cons (get item 'name) item)
(cons (symbol-name item) item)))))
(defvar helm-source-jabber-contacts
(helm-build-sync-source "Jabber Contacts"
:init (lambda () (require 'jabber))
:candidates (lambda () (mapcar 'car (helm-jabber-online-contacts)))
:action (lambda (x)
(jabber-chat-with
(jabber-read-account)
(symbol-name
(cdr (assoc x (helm-jabber-online-contacts))))))))
;;; World time
;;
(defvar zoneinfo-style-world-list)
(defvar legacy-style-world-list)
(defun helm-time-zone-transformer (candidates _source)
(cl-loop for i in candidates
for (z . p) in display-time-world-list
collect
(cons
(cond ((string-match (format-time-string "%H:%M" (current-time)) i)
(propertize i 'face 'helm-time-zone-current))
((string-match helm-time-zone-home-location i)
(propertize i 'face 'helm-time-zone-home))
(t i))
z)))
(defvar helm-source-time-world
(helm-build-in-buffer-source "Time World List"
:init (lambda ()
(require 'time)
(unless (and display-time-world-list
(listp display-time-world-list))
;; adapted from `time--display-world-list' from
;; emacs-27 for compatibility as
;; `display-time-world-list' is set by default to t.
(setq display-time-world-list
;; Determine if zoneinfo style timezones are
;; supported by testing that America/New York and
;; Europe/London return different timezones.
(let ((nyt (format-time-string "%z" nil "America/New_York"))
(gmt (format-time-string "%z" nil "Europe/London")))
(if (string-equal nyt gmt)
legacy-style-world-list
zoneinfo-style-world-list)))))
:data (lambda ()
(with-temp-buffer
(display-time-world-display display-time-world-list)
(buffer-string)))
:action 'helm-timezone-actions
:filtered-candidate-transformer 'helm-time-zone-transformer))
;;; Commands
;;
(defun helm-call-interactively (cmd-or-name)
"Execute CMD-OR-NAME as Emacs command.
It is added to `extended-command-history'.
`helm-current-prefix-arg' is used as the command's prefix argument."
(setq extended-command-history
(cons (helm-stringify cmd-or-name)
(delete (helm-stringify cmd-or-name) extended-command-history)))
(let ((current-prefix-arg helm-current-prefix-arg)
(cmd (helm-symbolify cmd-or-name)))
(if (stringp (symbol-function cmd))
(execute-kbd-macro (symbol-function cmd))
(setq this-command cmd)
(call-interactively cmd))))
;;; Minibuffer History
;;
;;
(defvar helm-minibuffer-history-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map helm-map)
(define-key map [remap helm-minibuffer-history] 'undefined)
map))
(defcustom helm-minibuffer-history-must-match t
"Allow inserting non matching elements when nil or \\='confirm."
:group 'helm-misc
:type '(choice
(const :tag "Must match" t)
(const :tag "Confirm" confirm)
(const :tag "Always allow" nil)))
(defcustom helm-minibuffer-history-key "C-r"
"The key `helm-minibuffer-history' is bound to in minibuffer local maps."
:type '(choice (string :tag "Key") (const :tag "no binding"))
:group 'helm-mode)
(defconst helm-minibuffer-history-old-key
(cl-loop for map in '(minibuffer-local-completion-map
minibuffer-local-filename-completion-map
minibuffer-local-filename-must-match-map ; Emacs 23.1.+
minibuffer-local-isearch-map
minibuffer-local-map
minibuffer-local-must-match-filename-map ; Older Emacsen
minibuffer-local-must-match-map
minibuffer-local-ns-map)
when (and (boundp map) (symbol-value map))
collect (cons map (lookup-key (symbol-value map) "\C-r"))))
;;;###autoload
(define-minor-mode helm-minibuffer-history-mode
"Bind `helm-minibuffer-history-key' in al minibuffer maps.
This mode is enabled by `helm-mode', so there is no need to enable it directly."
:group 'helm-misc
:global t
(if helm-minibuffer-history-mode
(let ((key helm-minibuffer-history-key))
(cl-dolist (map '(minibuffer-local-completion-map
minibuffer-local-filename-completion-map
minibuffer-local-filename-must-match-map ; Emacs 23.1.+
minibuffer-local-isearch-map
minibuffer-local-map
minibuffer-local-must-match-filename-map ; Older Emacsen
minibuffer-local-must-match-map
minibuffer-local-ns-map))
(let ((vmap (and (boundp map) (symbol-value map))))
(when (keymapp vmap)
(let ((val (and (boundp 'helm-minibuffer-history-key)
(symbol-value 'helm-minibuffer-history-key))))
(when val
(define-key vmap
(if (stringp val) (read-kbd-macro val) val)
nil)))
(when key
(define-key (symbol-value map)
(if (stringp key) (read-kbd-macro key) key)
'helm-minibuffer-history))))))
(cl-dolist (map '(minibuffer-local-completion-map
minibuffer-local-filename-completion-map
minibuffer-local-filename-must-match-map
minibuffer-local-isearch-map
minibuffer-local-map
minibuffer-local-must-match-filename-map
minibuffer-local-must-match-map
minibuffer-local-ns-map))
(let ((vmap (and (boundp map) (symbol-value map))))
(when (keymapp vmap)
(let ((val (and (boundp 'helm-minibuffer-history-key)
(symbol-value 'helm-minibuffer-history-key))))
(when val
(define-key vmap
(if (stringp val) (read-kbd-macro val) val)
(assoc-default map helm-minibuffer-history-old-key)))))))))
;;; Helm ratpoison UI
;;
;;
(defvar helm-source-ratpoison-commands
(helm-build-in-buffer-source "Ratpoison Commands"
:init 'helm-ratpoison-commands-init
:action (helm-make-actions
"Execute the command" 'helm-ratpoison-commands-execute)
:display-to-real 'helm-ratpoison-commands-display-to-real
:candidate-number-limit 999999))
(defun helm-ratpoison-commands-init ()
(unless (helm-candidate-buffer)
(with-current-buffer (helm-candidate-buffer 'global)
;; with ratpoison prefix key
(save-excursion
(call-process "ratpoison" nil (current-buffer) nil "-c" "help"))
(while (re-search-forward "^\\([^ ]+\\) \\(.+\\)$" nil t)
(replace-match "<ratpoison> \\1: \\2"))
(goto-char (point-max))
;; direct binding
(save-excursion
(call-process "ratpoison" nil (current-buffer) nil "-c" "help top"))
(while (re-search-forward "^\\([^ ]+\\) \\(.+\\)$" nil t)
(replace-match "\\1: \\2")))))
(defun helm-ratpoison-commands-display-to-real (display)
(and (string-match ": " display)
(substring display (match-end 0))))
(defun helm-ratpoison-commands-execute (candidate)
(call-process "ratpoison" nil nil nil "-ic" candidate))
;;; Helm stumpwm UI
;;
;;
(defvar helm-source-stumpwm-commands
(helm-build-in-buffer-source "Stumpwm Commands"
:init 'helm-stumpwm-commands-init
:action (helm-make-actions
"Execute the command" 'helm-stumpwm-commands-execute)
:candidate-number-limit 999999))
(defun helm-stumpwm-commands-init ()
(with-current-buffer (helm-candidate-buffer 'global)
(save-excursion
(call-process "stumpish" nil (current-buffer) nil "commands"))
(while (re-search-forward "[ ]*\\([^ ]+\\)[ ]*\n?" nil t)
(replace-match "\n\\1\n"))
(delete-blank-lines)
(sort-lines nil (point-min) (point-max))
(goto-char (point-max))))
(defun helm-stumpwm-commands-execute (candidate)
(call-process "stumpish" nil nil nil candidate))
;;;###autoload
(defun helm-world-time ()
"Preconfigured `helm' to show world time.
Default action change TZ environment variable locally to emacs."
(interactive)
(helm-other-buffer 'helm-source-time-world "*helm world time*"))
;;;###autoload
(defun helm-insert-latex-math ()
"Preconfigured helm for latex math symbols completion."
(interactive)
(helm-other-buffer 'helm-source-latex-math "*helm latex*"))
;;;###autoload
(defun helm-ratpoison-commands ()
"Preconfigured `helm' to execute ratpoison commands."
(interactive)
(helm-other-buffer 'helm-source-ratpoison-commands
"*helm ratpoison commands*"))
;;;###autoload
(defun helm-stumpwm-commands()
"Preconfigured helm for stumpwm commands."
(interactive)
(helm-other-buffer 'helm-source-stumpwm-commands
"*helm stumpwm commands*"))
;;;###autoload
(defun helm-minibuffer-history ()
"Preconfigured `helm' for `minibuffer-history'."
(interactive)
(cl-assert (minibuffer-window-active-p (selected-window)) nil
"Error: Attempt to use minibuffer history outside a minibuffer")
(let* ((enable-recursive-minibuffers t)
(query-replace-p (or (eq last-command 'query-replace)
(eq last-command 'query-replace-regexp)))
(elm (helm-comp-read "Next element matching (regexp): "
(cl-loop for i in
(symbol-value minibuffer-history-variable)
unless (equal "" i) collect i into history
finally return
(if (consp (car history))
(mapcar 'prin1-to-string history)
history))
:header-name
(lambda (name)
(format "%s (%s)" name minibuffer-history-variable))
:buffer "*helm minibuffer-history*"
:must-match helm-minibuffer-history-must-match
:multiline t
:keymap helm-minibuffer-history-map
:allow-nest t)))
;; Fix Bug#1667 with emacs-25+ `query-replace-from-to-separator'.
(when (and (boundp 'query-replace-from-to-separator) query-replace-p)
(let ((pos (string-match "\0" elm)))
(and pos
(add-text-properties
pos (1+ pos)
`(display ,query-replace-from-to-separator separator t)
elm))))
(delete-minibuffer-contents)
(insert elm)))
(provide 'helm-misc)
;;; helm-misc.el ends here

2249
code/elpa/helm-20220822.659/helm-mode.el Normal file
View File

File diff suppressed because it is too large Load Diff

436
code/elpa/helm-20220822.659/helm-net.el Normal file
View File

@ -0,0 +1,436 @@
;;; helm-net.el --- helm browse url and search web. -*- 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 'url)
(require 'xml)
(require 'browse-url)
(declare-function helm-comp-read "helm-mode")
(defgroup helm-net nil
"Net related applications and libraries for Helm."
:group 'helm)
(defcustom helm-google-suggest-default-browser-function nil
"The browse url function you prefer to use with Google suggest.
When nil, use the first browser function available
See `helm-browse-url-default-browser-alist'."
:group 'helm-net
:type 'symbol)
(defcustom helm-home-url "https://www.google.com"
"Default url to use as home url."
:group 'helm-net
:type 'string)
(defcustom helm-surfraw-default-browser-function nil
"The browse url function you prefer to use with surfraw.
When nil, fallback to `browse-url-browser-function'."
:group 'helm-net
:type 'symbol)
(defcustom helm-google-suggest-url
"https://encrypted.google.com/complete/search?output=toolbar&q=%s"
"URL used for looking up Google suggestions.
This is a format string, don't forget the `%s'."
:type 'string
:group 'helm-net)
(defcustom helm-google-suggest-search-url
"https://encrypted.google.com/search?ie=utf-8&oe=utf-8&q=%s"
"URL used for Google searching.
This is a format string, don't forget the `%s'."
:type 'string
:group 'helm-net)
(defvaralias 'helm-google-suggest-use-curl-p 'helm-net-prefer-curl)
(make-obsolete-variable 'helm-google-suggest-use-curl-p 'helm-net-prefer-curl "1.7.7")
(defcustom helm-net-prefer-curl nil
"When non--nil use CURL external program to fetch data.
Otherwise `url-retrieve-synchronously' is used."
:type 'boolean
:group 'helm-net)
(defcustom helm-surfraw-duckduckgo-url
"https://duckduckgo.com/lite/?q=%s&kp=1"
"The Duckduckgo url.
This is a format string, don't forget the `%s'.
If you have personal settings saved on duckduckgo you should have
a personal url, see your settings on duckduckgo."
:type 'string
:group 'helm-net)
(defcustom helm-search-suggest-action-wikipedia-url
"https://en.wikipedia.org/wiki/Special:Search?search=%s"
"The Wikipedia search url.
This is a format string, don't forget the `%s'."
:type 'string
:group 'helm-net)
(defcustom helm-search-suggest-action-youtube-url
"https://www.youtube.com/results?aq=f&search_query=%s"
"The Youtube search url.
This is a format string, don't forget the `%s'."
:type 'string
:group 'helm-net)
(defcustom helm-search-suggest-action-imdb-url
"http://www.imdb.com/find?s=all&q=%s"
"The IMDb search url.
This is a format string, don't forget the `%s'."
:type 'string
:group 'helm-net)
(defcustom helm-search-suggest-action-google-maps-url
"https://maps.google.com/maps?f=q&source=s_q&q=%s"
"The Google Maps search url.
This is a format string, don't forget the `%s'."
:type 'string
:group 'helm-net)
(defcustom helm-search-suggest-action-google-news-url
"https://www.google.com/search?safe=off&prmd=nvlifd&source=lnms&tbs=nws:1&q=%s"
"The Google News search url.
This is a format string, don't forget the `%s'."
:type 'string
:group 'helm-net)
(defcustom helm-google-suggest-actions
'(("Google Search" . helm-google-suggest-action)
("Wikipedia" . (lambda (candidate)
(helm-search-suggest-perform-additional-action
helm-search-suggest-action-wikipedia-url
candidate)))
("Youtube" . (lambda (candidate)
(helm-search-suggest-perform-additional-action
helm-search-suggest-action-youtube-url
candidate)))
("IMDb" . (lambda (candidate)
(helm-search-suggest-perform-additional-action
helm-search-suggest-action-imdb-url
candidate)))
("Google Maps" . (lambda (candidate)
(helm-search-suggest-perform-additional-action
helm-search-suggest-action-google-maps-url
candidate)))
("Google News" . (lambda (candidate)
(helm-search-suggest-perform-additional-action
helm-search-suggest-action-google-news-url
candidate))))
"List of actions for google suggest sources."
:group 'helm-net
:type '(alist :key-type string :value-type function))
(defcustom helm-browse-url-firefox-new-window "--new-tab"
"Allow choosing to browse url in new window or new tab.
Can be \"--new-tab\" (default), \"--new-window\" or \"--private-window\"."
:group 'helm-net
:type '(radio
(const :tag "New tab" "--new-tab")
(const :tag "New window" "--new-window")
(const :tag "New private window" "--private-window")))
(defcustom helm-net-curl-switches '("-s" "-L")
"Arguments list passed to curl when using `helm-net-prefer-curl'."
:group 'helm-net
:type '(repeat string))
;;; Additional actions for search suggestions
;;
;;
;; Internal
(defvar helm-net-curl-log-file (expand-file-name "helm-curl.log" user-emacs-directory))
(defun helm-search-suggest-perform-additional-action (url query)
"Perform the search via URL using QUERY as input."
(browse-url (format url (url-hexify-string query))))
(defun helm-net--url-retrieve-sync (request parser)
(if helm-net-prefer-curl
(with-temp-buffer
(apply #'call-process "curl"
nil `(t ,helm-net-curl-log-file) nil request helm-net-curl-switches)
(funcall parser))
(with-current-buffer (url-retrieve-synchronously request)
(funcall parser))))
;;; Google Suggestions
;;
;;
(defun helm-google-suggest-parser ()
(cl-loop
with result-alist = (xml-get-children
(car (xml-parse-region
(point-min) (point-max)))
'CompleteSuggestion)
for i in result-alist collect
(cdr (cl-caadr (assq 'suggestion i)))))
(defun helm-google-suggest-fetch (input)
"Fetch suggestions for INPUT from XML buffer."
(let ((request (format helm-google-suggest-url
(url-hexify-string input))))
(helm-net--url-retrieve-sync
request #'helm-google-suggest-parser)))
(defun helm-google-suggest-set-candidates (&optional request-prefix)
"Set candidates with result and number of Google results found."
(let ((suggestions (helm-google-suggest-fetch
(or (and request-prefix
(concat request-prefix
" " helm-pattern))
helm-pattern))))
(if (member helm-pattern suggestions)
suggestions
;; if there is no suggestion exactly matching the input then
;; prepend a Search on Google item to the list
(append
suggestions
(list (cons (format "Search for '%s' on Google" helm-input)
helm-input))))))
(defun helm-ggs-set-number-result (num)
(if num
(progn
(and (numberp num) (setq num (number-to-string num)))
(cl-loop for i in (reverse (split-string num "" t))
for count from 1
append (list i) into C
when (= count 3)
append (list ",") into C
and do (setq count 0)
finally return
(replace-regexp-in-string
"^," "" (mapconcat 'identity (reverse C) ""))))
"?"))
(defun helm-google-suggest-action (candidate)
"Default action to jump to a Google suggested candidate."
(let ((arg (format helm-google-suggest-search-url
(url-hexify-string candidate))))
(helm-aif helm-google-suggest-default-browser-function
(funcall it arg)
(helm-browse-url arg))))
(defvar helm-google-suggest-default-function
'helm-google-suggest-set-candidates
"Default function to use in `helm-google-suggest'.")
(defvar helm-source-google-suggest
(helm-build-sync-source "Google Suggest"
:candidates (lambda ()
(funcall helm-google-suggest-default-function))
:action 'helm-google-suggest-actions
:match-dynamic t
:keymap helm-map
:requires-pattern 3))
(defun helm-google-suggest-emacs-lisp ()
"Try to emacs lisp complete with Google suggestions."
(helm-google-suggest-set-candidates "emacs lisp"))
;;; Web browser functions.
;;
;;
;; If default setting of `w3m-command' is not
;; what you want and you modify it, you will have to reeval
;; also `helm-browse-url-default-browser-alist'.
(defvar helm-browse-url-chromium-program "chromium-browser")
(defvar helm-browse-url-uzbl-program "uzbl-browser")
(defvar helm-browse-url-nyxt-program "nyxt")
(defvar helm-browse-url-conkeror-program "conkeror")
(defvar helm-browse-url-opera-program "opera")
(defvar helm-browse-url-w3m-program (or (and (boundp 'w3m-command) w3m-command)
(executable-find "w3m")))
(defvar helm-browse-url-default-browser-alist
'((helm-browse-url-w3m-program . w3m-browse-url)
(browse-url-firefox-program . browse-url-firefox)
(helm-browse-url-chromium-program . helm-browse-url-chromium)
(helm-browse-url-conkeror-program . helm-browse-url-conkeror)
(helm-browse-url-opera-program . helm-browse-url-opera)
(helm-browse-url-uzbl-program . helm-browse-url-uzbl)
(helm-browse-url-nyxt-program . helm-browse-url-nyxt)
(browse-url-kde-program . browse-url-kde)
(browse-url-gnome-moz-program . browse-url-gnome-moz)
(browse-url-mozilla-program . browse-url-mozilla)
(browse-url-galeon-program . browse-url-galeon)
(browse-url-netscape-program . browse-url-netscape)
(browse-url-xterm-program . browse-url-text-xterm)
("emacs" . eww-browse-url))
"Alist of (browse_url_variable . function) to try to find a suitable url browser.")
(cl-defun helm-generic-browser (url cmd-name &rest args)
"Browse URL with NAME browser."
(let ((proc (concat cmd-name " " url)))
(message "Starting %s..." cmd-name)
(apply 'start-process proc nil cmd-name
(append args (list url)))
(set-process-sentinel
(get-process proc)
(lambda (process event)
(when (string= event "finished\n")
(message "%s process %s" process event))))))
;;;###autoload
(defun helm-browse-url-firefox (url &optional _ignore)
"Same as `browse-url-firefox' but detach from Emacs.
So when you quit Emacs you can keep your Firefox session open and
not be prompted to kill the Firefox process.
NOTE: Probably not supported on some systems (e.g., Windows)."
(interactive (list (read-string "URL: " (browse-url-url-at-point))
nil))
(setq url (browse-url-encode-url url))
(let ((process-environment (browse-url-process-environment)))
(call-process-shell-command
(format "(%s %s %s &)"
browse-url-firefox-program
helm-browse-url-firefox-new-window
(shell-quote-argument url)))))
;;;###autoload
(defun helm-browse-url-opera (url &optional _ignore)
"Browse URL with Opera browser and detach from Emacs.
So when you quit Emacs you can keep your Opera session open and
not be prompted to kill the Opera process.
NOTE: Probably not supported on some systems (e.g., Windows)."
(interactive (list (read-string "URL: " (browse-url-url-at-point))
nil))
(setq url (browse-url-encode-url url))
(let ((process-environment (browse-url-process-environment)))
(call-process-shell-command
(format "(%s %s &)"
helm-browse-url-opera-program (shell-quote-argument url)))))
;;;###autoload
(defun helm-browse-url-chromium (url &optional _ignore)
"Browse URL with Google Chrome browser."
(interactive "sURL: ")
(helm-generic-browser
url helm-browse-url-chromium-program))
;;;###autoload
(defun helm-browse-url-uzbl (url &optional _ignore)
"Browse URL with uzbl browser."
(interactive "sURL: ")
(helm-generic-browser url helm-browse-url-uzbl-program "-u"))
;;;###autoload
(defun helm-browse-url-conkeror (url &optional _ignore)
"Browse URL with conkeror browser."
(interactive "sURL: ")
(helm-generic-browser url helm-browse-url-conkeror-program))
;;;###autoload
(defun helm-browse-url-nyxt (url &optional _ignore)
"Browse URL with nyxt browser."
(interactive "sURL: ")
(helm-generic-browser url helm-browse-url-nyxt-program))
(defun helm-browse-url-default-browser (url &rest args)
"Find the first available browser and ask it to load URL."
(let ((default-browser-fn
(cl-loop for (var . fn) in helm-browse-url-default-browser-alist
for exe = (if (stringp var)
var
(and (boundp var) (symbol-value var)))
thereis (and exe (executable-find exe) (fboundp fn) fn))))
(if default-browser-fn
(apply default-browser-fn url args)
(error "No usable browser found"))))
(defun helm-browse-url (url &rest args)
"Default command to browse URL."
(if browse-url-browser-function
(browse-url url args)
(helm-browse-url-default-browser url args)))
;;; Surfraw
;;
;; Need external program surfraw.
;; <http://surfraw.alioth.debian.org/>
;; Internal
(defvar helm-surfraw-engines-history nil)
(defvar helm-surfraw-input-history nil)
(defvar helm-surfraw--elvi-cache nil)
(defun helm-build-elvi-list ()
"Return list of all engines and descriptions handled by surfraw."
(or helm-surfraw--elvi-cache
(setq helm-surfraw--elvi-cache
(cdr (with-temp-buffer
(call-process "surfraw" nil t nil "-elvi")
(split-string (buffer-string) "\n"))))))
;;;###autoload
(defun helm-surfraw (pattern engine)
"Preconfigured `helm' to search PATTERN with search ENGINE."
(interactive
(list
(let* ((default (if (use-region-p)
(buffer-substring-no-properties
(region-beginning) (region-end))
(thing-at-point 'symbol)))
(prompt (if default
(format "SearchFor (default %s): " default)
"SearchFor: ")))
(read-string prompt nil 'helm-surfraw-input-history default))
(helm-comp-read
"Engine: "
(helm-build-elvi-list)
:must-match t
:name "Surfraw Search Engines"
:history 'helm-surfraw-engines-history)))
(let* ((engine-nodesc (car (split-string engine)))
(url (if (string= engine-nodesc "duckduckgo")
;; "sr duckduckgo -p foo" is broken, workaround.
(format helm-surfraw-duckduckgo-url
(url-hexify-string pattern))
(with-temp-buffer
(apply 'call-process "surfraw" nil t nil
(append (list engine-nodesc "-p") (split-string pattern)))
(replace-regexp-in-string
"\n" "" (buffer-string)))))
(browse-url-browser-function (or helm-surfraw-default-browser-function
browse-url-browser-function)))
(if (string= engine-nodesc "W")
(helm-browse-url helm-home-url)
(helm-browse-url url))))
;;;###autoload
(defun helm-google-suggest ()
"Preconfigured `helm' for Google search with Google suggest."
(interactive)
(helm-other-buffer 'helm-source-google-suggest "*helm google*"))
(provide 'helm-net)
;;; helm-net.el ends here

833
code/elpa/helm-20220822.659/helm-occur.el Normal file
View File

@ -0,0 +1,833 @@
;;; helm-occur.el --- Incremental Occur 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/>.
;;; Code:
(require 'cl-lib)
(require 'helm)
(require 'helm-help)
(require 'helm-utils)
(declare-function helm-buffers-get-visible-buffers "helm-buffers")
(declare-function helm-buffer-list "helm-buffers")
(declare-function helm-grep-split-line "helm-grep")
(declare-function helm-grep-highlight-match "helm-grep")
(declare-function helm-comp-read "helm-mode")
(defvar helm-current-error)
;;; Internals
;;
(defvar helm-source-occur nil
"This will be the name of the source related to `current-buffer'.
Don't use it as it value changes always.")
(defvar helm-source-moccur nil
"This is just a flag to add to `helm-sources-using-default-as-input'.
Don't set it to any value, it will have no effect.")
(defvar helm-occur--buffer-list nil)
(defvar helm-occur--buffer-tick nil)
(defvar helm-occur-history nil)
(defvar helm-occur--search-buffer-regexp "\\`\\([0-9]*\\)\\s-\\{1\\}\\(.*\\)\\'"
"The regexp matching candidates in helm-occur candidate buffer.")
(defvar helm-occur-mode--last-pattern nil)
(defvar helm-occur--initial-pos 0)
(defvar helm-occur-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map helm-map)
(define-key map (kbd "C-c o") 'helm-occur-run-goto-line-ow)
(define-key map (kbd "C-c C-o") 'helm-occur-run-goto-line-of)
(define-key map (kbd "C-x C-s") 'helm-occur-run-save-buffer)
map)
"Keymap used in occur source.")
(defgroup helm-occur nil
"Regexp related Applications and libraries for Helm."
:group 'helm)
(defcustom helm-occur-actions
'(("Go to Line" . helm-occur-goto-line)
("Goto line other window (C-u vertically)" . helm-occur-goto-line-ow)
("Goto line new frame" . helm-occur-goto-line-of)
("Save buffer" . helm-occur-save-results)
)
"Actions for helm-occur."
:type '(alist :key-type string :value-type function))
(defcustom helm-occur-use-ioccur-style-keys nil
"Similar to `helm-grep-use-ioccur-style-keys' but for multi occur.
Note that if you define this variable with `setq' your change will
have no effect, use customize instead."
:type 'boolean
:set (lambda (var val)
(set var val)
(if val
(progn
(define-key helm-occur-map (kbd "<right>") 'helm-occur-right)
(define-key helm-occur-map (kbd "<left>") 'helm-occur-run-default-action))
(define-key helm-occur-map (kbd "<right>") nil)
(define-key helm-occur-map (kbd "<left>") nil))))
(defcustom helm-occur-always-search-in-current nil
"Helm multi occur always search in current buffer when non--nil."
:type 'boolean)
(defcustom helm-occur-truncate-lines t
"Truncate lines in occur buffer when non nil."
:type 'boolean)
(defcustom helm-occur-auto-update-on-resume nil
"Allow auto updating helm-occur buffer when outdated.
noask => Always update without asking
nil => Don't update but signal buffer needs update
never => Never update and do not signal buffer needs update
Any other non--nil value update after confirmation."
:type '(radio :tag "Allow auto updating helm-occur buffer when outdated."
(const :tag "Always update without asking" noask)
(const :tag "Never update and do not signal buffer needs update" never)
(const :tag "Don't update but signal buffer needs update" nil)
(const :tag "Update after confirmation" t)))
(defcustom helm-occur-candidate-number-limit 99999
"Value of `helm-candidate-number-limit' for helm-occur."
:type 'integer)
(defcustom helm-occur-buffer-substring-fn-for-modes
'((mu4e-headers-mode . buffer-substring))
"Function to use to display buffer contents for major-mode.
Can be one of `buffer-substring' or `buffer-substring-no-properties'.
Note that when using `buffer-substring' initialization will be slower."
:type '(alist :key-type (symbol :tag "Mode")
:value-type (radio (const :tag "With text properties" buffer-substring)
(const :tag "Without text properties" buffer-substring-no-properties))))
(defcustom helm-occur-keep-closest-position t
"When non nil select closest candidate from point after update.
This happen only in `helm-source-occur' which is always related to
`current-buffer'."
:type 'boolean)
(defcustom helm-occur-ignore-diacritics nil
"When non nil helm-occur will ignore diacritics in patterns."
:type 'boolean)
(defface helm-moccur-buffer
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:foreground "DarkTurquoise" :underline t))
"Face used to highlight occur buffer names.")
(defface helm-resume-need-update
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:background "red"))
"Face used to flash occur buffer when it needs update.")
(defun helm-occur--select-closest-candidate ()
;; Prevent error with `with-helm-window' when switching to help.
(unless (or (not (get-buffer-window helm-buffer 'visible))
(string-equal helm-pattern ""))
(with-helm-window
(let ((lst '())
(name (helm-get-attr 'name helm-source-occur))
closest beg end)
(while-no-input
(goto-char (point-min))
(if (string= name "Helm occur")
(setq beg (point)
end (point-max))
(helm-awhile (helm-get-next-header-pos)
(when (string= name (buffer-substring-no-properties
(point-at-bol) (point-at-eol)))
(forward-line 1)
(setq beg (point)
end (or (helm-get-next-header-pos) (point-max)))
(cl-return))))
(save-excursion
(when (and beg end)
(goto-char beg)
(while (re-search-forward "^[0-9]+" end t)
(push (string-to-number (match-string 0)) lst))
(setq closest (helm-closest-number-in-list
helm-occur--initial-pos lst))))
(when (and closest (re-search-forward (format "^%s" closest) end t))
(helm-mark-current-line)
(goto-char (overlay-start
helm-selection-overlay))))))))
;;;###autoload
(defun helm-occur ()
"Preconfigured helm for searching lines matching pattern in `current-buffer'.
When `helm-source-occur' is member of
`helm-sources-using-default-as-input' which is the default,
symbol at point is searched at startup.
When a region is marked search only in this region by narrowing.
To search in multiples buffers start from one of the commands listing
buffers (i.e. a helm command using `helm-source-buffers-list' like
`helm-mini') and use the multi occur buffers action.
This is the helm implementation that collect lines matching pattern
like vanilla Emacs `occur' but have nothing to do with it, the search
engine beeing completely different and also much faster."
(interactive)
(setq helm-source-occur
(car (helm-occur-build-sources (list (current-buffer)) "Helm occur")))
(helm-set-local-variable 'helm-occur--buffer-list (list (current-buffer))
'helm-occur--buffer-tick
(list (buffer-chars-modified-tick (current-buffer))))
(helm-set-attr 'header-name (lambda (_name)
(format "HO [%s]"
(buffer-name helm-current-buffer)))
helm-source-occur)
(when helm-occur-keep-closest-position
(setq helm-occur--initial-pos (line-number-at-pos))
(add-hook 'helm-after-update-hook 'helm-occur--select-closest-candidate))
(save-restriction
(let ((helm-sources-using-default-as-input
(unless (> (buffer-size) 2000000)
helm-sources-using-default-as-input))
def pos)
(when (use-region-p)
;; When user mark defun with `mark-defun' with intention of
;; using helm-occur on this region, it is relevant to use the
;; thing-at-point located at previous position which have been
;; pushed to `mark-ring', if it's within the active region.
(let ((beg (region-beginning))
(end (region-end))
(prev-pos (car mark-ring)))
(when (and prev-pos (>= prev-pos beg) (< prev-pos end))
(setq def (save-excursion
(goto-char (setq pos prev-pos))
(helm-aif (thing-at-point 'symbol) (regexp-quote it)))))
(narrow-to-region beg end)))
(unwind-protect
(helm :sources 'helm-source-occur
:buffer "*helm occur*"
:history 'helm-occur-history
:default (or def (helm-aif (thing-at-point 'symbol)
(regexp-quote it)))
:preselect (and (memq 'helm-source-occur
helm-sources-using-default-as-input)
(format "^%d:" (line-number-at-pos
(or pos (point)))))
:truncate-lines helm-occur-truncate-lines)
(deactivate-mark t)
(remove-hook 'helm-after-update-hook 'helm-occur--select-closest-candidate)))))
;;;###autoload
(defun helm-occur-visible-buffers ()
"Run helm-occur on all visible buffers in frame."
(interactive)
(require 'helm-buffers)
(if (or (one-window-p) (region-active-p))
(call-interactively #'helm-occur)
(let ((buffers (helm-buffers-get-visible-buffers)))
(helm-multi-occur-1 (mapcar 'get-buffer buffers)))))
(defun helm-occur-transformer (candidates source)
"Return CANDIDATES prefixed with line number."
(cl-loop with buf = (helm-get-attr 'buffer-name source)
for c in candidates
for disp-linum = (when (string-match helm-occur--search-buffer-regexp c)
(let ((linum (match-string 1 c))
(disp (match-string 2 c)))
(list
linum
(format "%s:%s"
(propertize
linum 'face 'helm-grep-lineno
'help-echo (buffer-file-name
(get-buffer buf)))
disp))))
for linum = (car disp-linum)
for disp = (cadr disp-linum)
when (and disp (not (string= disp "")))
collect (cons disp (string-to-number linum))))
(defclass helm-moccur-class (helm-source-in-buffer)
((buffer-name :initarg :buffer-name
:initform nil)
(moccur-buffers :initarg :moccur-buffers
:initform nil)
(find-file-target :initform #'helm-occur-quit-an-find-file-fn)))
(defun helm-occur-build-sources (buffers &optional source-name)
"Build sources for `helm-occur' for each buffer in BUFFERS list."
(cl-loop for buf in buffers
for bname = (buffer-name buf)
collect
(helm-make-source (or source-name bname)
'helm-moccur-class
:header-name (lambda (name)
(format "HO [%s]" (if (string= name "Helm occur")
bname name)))
:buffer-name bname
:match-part
(lambda (candidate)
;; The regexp should match what is in candidate buffer,
;; not what is displayed in helm-buffer e.g. "12 foo"
;; and not "12:foo".
(when (string-match helm-occur--search-buffer-regexp
candidate)
(match-string 2 candidate)))
:diacritics helm-occur-ignore-diacritics
:search (lambda (pattern)
(when (string-match "\\`\\^\\([^ ]*\\)" pattern)
(setq pattern (concat "^[0-9]* \\{1\\}" (match-string 1 pattern))))
(condition-case _err
(re-search-forward pattern nil t)
(invalid-regexp nil)))
:init `(lambda ()
(with-current-buffer ,buf
(let* ((bsfn (or (cdr (assq
major-mode
helm-occur-buffer-substring-fn-for-modes))
#'buffer-substring-no-properties))
(contents (funcall bsfn (point-min) (point-max))))
(helm-set-attr 'get-line bsfn)
(with-current-buffer (helm-candidate-buffer 'global)
(insert contents)
(goto-char (point-min))
(let ((linum 1))
(insert (format "%s " linum))
(while (re-search-forward "\n" nil t)
(cl-incf linum)
(insert (format "%s " linum))))))))
:filtered-candidate-transformer 'helm-occur-transformer
:help-message 'helm-moccur-help-message
:nomark t
:migemo t
;; Needed for resume.
:history 'helm-occur-history
:candidate-number-limit helm-occur-candidate-number-limit
:action 'helm-occur-actions
:requires-pattern 2
:follow 1
:group 'helm-occur
:keymap helm-occur-map
:resume 'helm-occur-resume-fn
:moccur-buffers buffers)))
(defun helm-multi-occur-1 (buffers &optional input)
"Run `helm-occur' on a list of buffers.
Each buffer's result is displayed in a separated source."
(let* ((curbuf (current-buffer))
(bufs (if helm-occur-always-search-in-current
(cons curbuf (remove curbuf buffers))
buffers))
(helm-sources-using-default-as-input
(unless (cl-loop with total_size = 0
for b in bufs
do (setq total_size (buffer-size b))
finally return (> total_size 2000000))
helm-sources-using-default-as-input))
(sources (helm-occur-build-sources bufs (and (eql curbuf (car bufs))
(not (cdr bufs))
"Helm occur")))
(helm-maybe-use-default-as-input
(not (null (memq 'helm-source-moccur
helm-sources-using-default-as-input)))))
(helm-set-local-variable 'helm-occur--buffer-list bufs
'helm-occur--buffer-tick
(cl-loop for b in bufs collect
(buffer-chars-modified-tick
(get-buffer b))))
(when (and helm-occur-always-search-in-current
helm-occur-keep-closest-position)
(setq helm-source-occur
(cl-loop for s in sources
when (eql helm-current-buffer
(get-buffer (helm-get-attr 'buffer-name s)))
return s))
(setq helm-occur--initial-pos (line-number-at-pos))
(add-hook 'helm-after-update-hook 'helm-occur--select-closest-candidate))
(unwind-protect
(helm :sources sources
:buffer "*helm moccur*"
:history 'helm-occur-history
:default (helm-aif (thing-at-point 'symbol) (regexp-quote it))
:input input
:truncate-lines helm-occur-truncate-lines)
(remove-hook 'helm-after-update-hook 'helm-occur--select-closest-candidate))))
;;; Actions
;;
(cl-defun helm-occur-action (lineno
&optional (method (quote buffer)))
"Jump to line number LINENO with METHOD.
METHOD can be one of buffer, buffer-other-window, buffer-other-frame."
(require 'helm-grep)
(let ((buf (if (eq major-mode 'helm-occur-mode)
(get-text-property (point) 'buffer-name)
(helm-get-attr 'buffer-name)))
(split-pat (helm-mm-split-pattern helm-input)))
(cl-case method
(buffer (switch-to-buffer buf))
(buffer-other-window (helm-window-show-buffers (list buf) t))
(buffer-other-frame (switch-to-buffer-other-frame buf)))
(with-current-buffer buf
(helm-goto-line lineno)
;; Move point to the nearest matching regexp from bol.
(cl-loop for reg in split-pat
when (save-excursion
(condition-case _err
(if helm-migemo-mode
(helm-mm-migemo-forward reg (point-at-eol) t)
(re-search-forward reg (point-at-eol) t))
(invalid-regexp nil)))
collect (match-beginning 0) into pos-ls
finally (when pos-ls (goto-char (apply #'min pos-ls)))))))
(defun helm-occur-goto-line (candidate)
"From multi occur, switch to buffer and CANDIDATE line."
(helm-occur-action
candidate 'buffer))
(defun helm-occur-goto-line-ow (candidate)
"Go to CANDIDATE line in other window.
Same as `helm-occur-goto-line' but go in other window."
(helm-occur-action
candidate 'buffer-other-window))
(defun helm-occur-goto-line-of (candidate)
"Go to CANDIDATE line in new frame.
Same as `helm-occur-goto-line' but go in new frame."
(helm-occur-action
candidate 'buffer-other-frame))
(defun helm-occur-run-goto-line-ow ()
"Run goto line other window action from `helm-occur'."
(interactive)
(with-helm-alive-p
(helm-exit-and-execute-action 'helm-occur-goto-line-ow)))
(put 'helm-occur-run-goto-line-ow 'helm-only t)
(defun helm-occur-run-goto-line-of ()
"Run goto line new frame action from `helm-occur'."
(interactive)
(with-helm-alive-p
(helm-exit-and-execute-action 'helm-occur-goto-line-of)))
(put 'helm-occur-run-goto-line-of 'helm-only t)
(defun helm-occur-run-default-action ()
(interactive)
(with-helm-alive-p
(helm-exit-and-execute-action 'helm-occur-goto-line)))
(put 'helm-occur-run-default-action 'helm-only t)
(defun helm-occur-run-save-buffer ()
"Run moccur save results action from `helm-moccur'."
(interactive)
(with-helm-alive-p
(helm-exit-and-execute-action 'helm-occur-save-results)))
(put 'helm-moccur-run-save-buffer 'helm-only t)
(defun helm-occur-right ()
"`helm-occur' action for right arrow.
This is used when `helm-occur-use-ioccur-style-keys' is enabled.
If follow is enabled (default) go to next source, otherwise execute
persistent action."
(interactive)
(if (helm-aand (helm-get-attr 'follow) (> it 0))
(helm-next-source)
(helm-execute-persistent-action)))
(put 'helm-occur-right 'helm-only t)
(defun helm-occur-quit-an-find-file-fn (source)
(let* ((sel (helm-get-selection nil nil source))
(occur-fname (helm-aand (numberp sel)
(helm-get-attr 'buffer-name)
(buffer-file-name (get-buffer it)))))
(when (and occur-fname (file-exists-p occur-fname))
(expand-file-name occur-fname))))
;;; helm-occur-mode
;;
;;
(defvar helm-occur-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "RET") 'helm-occur-mode-goto-line)
(define-key map (kbd "C-o") 'helm-occur-mode-goto-line-ow)
(define-key map (kbd "<C-down>") 'helm-occur-mode-goto-line-ow-forward)
(define-key map (kbd "<C-up>") 'helm-occur-mode-goto-line-ow-backward)
(define-key map (kbd "<M-down>") 'helm-gm-next-file)
(define-key map (kbd "<M-up>") 'helm-gm-precedent-file)
(define-key map (kbd "M-n") 'helm-occur-mode-goto-line-ow-forward)
(define-key map (kbd "M-p") 'helm-occur-mode-goto-line-ow-backward)
(define-key map (kbd "M-N") 'helm-gm-next-file)
(define-key map (kbd "M-P") 'helm-gm-precedent-file)
(define-key map (kbd "C-c b") 'helm-occur-mode-resume-session)
map))
(defun helm-occur-mode-goto-line ()
(interactive)
(setq next-error-last-buffer (current-buffer))
(setq-local helm-current-error (point-marker))
(helm-aif (get-text-property (point) 'helm-realvalue)
(progn (helm-occur-goto-line it) (helm-match-line-cleanup-pulse))))
(defun helm-occur-mode-goto-line-ow ()
(interactive)
(setq next-error-last-buffer (current-buffer))
(setq-local helm-current-error (point-marker))
(helm-aif (get-text-property (point) 'helm-realvalue)
(progn (helm-occur-goto-line-ow it) (helm-match-line-cleanup-pulse))))
(defun helm-occur-mode-goto-line-ow-forward-1 (arg)
(condition-case nil
(progn
(when (or (eq last-command 'helm-occur-mode-goto-line-ow-forward)
(eq last-command 'helm-occur-mode-goto-line-ow-backward))
(forward-line arg))
(save-selected-window
(helm-occur-mode-goto-line-ow)
(recenter)))
(error nil)))
(defun helm-occur-mode-goto-line-ow-forward (arg)
(interactive "p")
(helm-occur-mode-goto-line-ow-forward-1 arg))
(defun helm-occur-mode-goto-line-ow-backward (arg)
(interactive "p")
(helm-occur-mode-goto-line-ow-forward-1 (- arg)))
(defun helm-occur-save-results (_candidate)
"Save helm moccur results in a `helm-moccur-mode' buffer."
(let ((buf "*hmoccur*")
new-buf)
(when (get-buffer buf)
(setq new-buf (helm-read-string "OccurBufferName: " buf))
(cl-loop for b in (helm-buffer-list)
when (and (string= new-buf b)
(not (y-or-n-p
(format "Buffer `%s' already exists overwrite? "
new-buf))))
do (setq new-buf (helm-read-string
"OccurBufferName: " "*hmoccur ")))
(setq buf new-buf))
(with-current-buffer (get-buffer-create buf)
(kill-all-local-variables)
(setq buffer-read-only t)
(buffer-disable-undo)
(let ((inhibit-read-only t)
(map (make-sparse-keymap))
buf-name)
(erase-buffer)
(insert "-*- mode: helm-occur -*-\n\n"
(format "Occur Results for `%s':\n\n" helm-input))
(save-excursion
(insert (with-current-buffer helm-buffer
(goto-char (point-min))
(forward-line 1)
(buffer-substring (point) (point-max)))))
(save-excursion
(forward-line -2)
(while (not (eobp))
(if (helm-pos-header-line-p)
(let ((beg (point-at-bol))
(end (point-at-eol)))
(set-text-properties beg (1+ end) nil)
(delete-region (1- beg) end))
(helm-aif (setq buf-name (assoc-default
'buffer-name
(get-text-property (point) 'helm-cur-source)))
(progn
(insert (propertize (concat it ":")
'face 'helm-moccur-buffer
'helm-realvalue (get-text-property (point) 'helm-realvalue)))
(add-text-properties
(point-at-bol) (point-at-eol)
`(buffer-name ,buf-name))
(add-text-properties
(point-at-bol) (point-at-eol)
`(keymap ,map
help-echo ,(concat
(buffer-file-name
(get-buffer buf-name))
"\nmouse-1: set point\nmouse-2: jump to selection")
mouse-face highlight
invisible nil))
(define-key map [mouse-1] 'mouse-set-point)
(define-key map [mouse-2] 'helm-occur-mode-mouse-goto-line)
(define-key map [mouse-3] 'ignore))))
(forward-line 1))))
(buffer-enable-undo)
(helm-occur-mode))
(pop-to-buffer buf)
(setq next-error-last-buffer (get-buffer buf))
(message "Helm occur Results saved in `%s' buffer" buf)))
(defun helm-occur-mode-mouse-goto-line (event)
(interactive "e")
(let* ((window (posn-window (event-end event)))
(pos (posn-point (event-end event))))
(with-selected-window window
(when (eq major-mode 'helm-occur-mode)
(goto-char pos)
(helm-occur-mode-goto-line)))))
(put 'helm-moccur-mode-mouse-goto-line 'helm-only t)
(defun helm-occur-mode-resume-session ()
(interactive)
(cl-assert (eq major-mode 'helm-occur-mode) nil "Helm command called in wrong context")
(helm-multi-occur-1 helm-occur--buffer-list helm-occur-mode--last-pattern))
(defun helm-occur-buffer-substring-with-linums ()
"Return current-buffer contents as a string with all lines
numbered. The property \\='buffer-name is added to the whole string."
(let ((bufstr (buffer-substring-no-properties (point-min) (point-max)))
(bufname (buffer-name)))
(with-temp-buffer
(save-excursion
(insert bufstr))
(let ((linum 1))
(insert (format "%s " linum))
(while (re-search-forward "\n" nil t)
(cl-incf linum)
(insert (format "%s " linum)))
(add-text-properties (point-min) (point-max) `(buffer-name ,bufname)))
(buffer-string))))
(defun helm-occur-mode--revert-buffer-function (&optional _ignore-auto _noconfirm)
"The `revert-buffer-function' for `helm-occur-mode'."
(goto-char (point-min))
(let (pattern)
(when (re-search-forward "^Occur Results for `\\(.*\\)'" nil t)
(setq pattern (match-string 1))
(forward-line 0)
(when (re-search-forward "^$" nil t)
(forward-line 1))
(let ((inhibit-read-only t)
(buffer (current-buffer))
(buflst helm-occur--buffer-list))
(delete-region (point) (point-max))
(message "Reverting buffer...")
(save-excursion
(with-temp-buffer
(insert
"\n"
(cl-loop for buf in buflst
for bufstr = (or (and (buffer-live-p (get-buffer buf))
(with-current-buffer buf
(helm-occur-buffer-substring-with-linums)))
"")
concat bufstr)
"\n")
(goto-char (point-min))
(cl-loop with linum
with mpart
;; Bind helm-pattern used by `helm-grep-split-line'.
with helm-pattern = pattern
while (helm-mm-search pattern) ; point is at eol.
;; Calculate line number (linum) and extract real
;; part of line (mpart).
do (when (save-excursion
;; `helm-mm-search' puts point at eol.
(forward-line 0)
(re-search-forward "^\\([0-9]*\\)\\s-\\{1\\}\\(.*\\)$"
(point-at-eol) t))
(setq linum (string-to-number (match-string 1))
mpart (match-string 2)))
;; Match part after line number.
when (and mpart (helm-mm-match mpart pattern))
for line = (format "%s:%d:%s"
(get-text-property (point) 'buffer-name)
linum
mpart)
when line
do (with-current-buffer buffer
(insert
(propertize
(car (helm-occur-filter-one-by-one line))
'helm-realvalue linum)
"\n"))))
(when (fboundp 'wgrep-cleanup-overlays)
(wgrep-cleanup-overlays (point-min) (point-max)))
(message "Reverting buffer done")
(when executing-kbd-macro (sit-for 1)))))))
(defun helm-occur-filter-one-by-one (candidate)
"`filter-one-by-one' function for `helm-source-moccur'."
(require 'helm-grep)
(let* ((split (helm-grep-split-line candidate))
(buf (car split))
(lineno (nth 1 split))
(str (nth 2 split)))
(cons (concat (propertize
buf
'face 'helm-moccur-buffer
'help-echo (buffer-file-name
(get-buffer buf))
'buffer-name buf)
":"
(propertize lineno 'face 'helm-grep-lineno)
":"
(helm-grep-highlight-match str))
candidate)))
(define-derived-mode helm-occur-mode
special-mode "helm-moccur"
"Major mode to provide actions in helm moccur saved buffer.
Special commands:
\\{helm-occur-mode-map}"
(set (make-local-variable 'helm-occur--buffer-list)
(with-helm-buffer helm-occur--buffer-list))
(set (make-local-variable 'revert-buffer-function)
#'helm-occur-mode--revert-buffer-function)
(set (make-local-variable 'helm-occur-mode--last-pattern)
helm-input)
(set (make-local-variable 'next-error-function)
#'helm-occur-next-error)
(set (make-local-variable 'helm-current-error) nil))
(put 'helm-moccur-mode 'helm-only t)
(defun helm-occur-next-error (&optional argp reset)
"Goto ARGP position from a `helm-occur-mode' buffer.
RESET non-nil means rewind to the first match.
This is the `next-error-function' for `helm-occur-mode'."
(interactive "p")
(goto-char (cond (reset (point-min))
((and (< argp 0) helm-current-error)
(line-beginning-position))
((and (> argp 0) helm-current-error)
(line-end-position))
((point))))
(let ((fun (if (> argp 0)
#'next-single-property-change
#'previous-single-property-change)))
(helm-aif (funcall fun (point) 'buffer-name)
(progn
(goto-char it)
(forward-line 0)
;; `helm-current-error' is set in
;; `helm-occur-mode-goto-line'.
(helm-occur-mode-goto-line))
(user-error "No more matches"))))
;;; Resume
;;
(defun helm-occur-resume-fn ()
(with-helm-buffer
(let (new-tick-ls buffer-is-modified)
(set (make-local-variable 'helm-occur--buffer-list)
(cl-loop for b in helm-occur--buffer-list
when (buffer-live-p (get-buffer b))
collect b))
(setq buffer-is-modified (/= (length helm-occur--buffer-list)
(length (helm-get-attr 'moccur-buffers))))
(helm-set-attr 'moccur-buffers helm-occur--buffer-list)
(setq new-tick-ls (cl-loop for b in helm-occur--buffer-list
collect (buffer-chars-modified-tick
(get-buffer b))))
(when buffer-is-modified
(setq helm-occur--buffer-tick new-tick-ls))
(cl-assert (> (length helm-occur--buffer-list) 0) nil
"helm-resume error: helm-(m)occur buffer list is empty")
(unless (eq helm-occur-auto-update-on-resume 'never)
(when (or buffer-is-modified
(cl-loop for b in helm-occur--buffer-list
for new-tick = (buffer-chars-modified-tick
(get-buffer b))
for tick in helm-occur--buffer-tick
thereis (/= tick new-tick)))
(helm-aif helm-occur-auto-update-on-resume
(when (or (eq it 'noask)
(y-or-n-p "Helm (m)occur Buffer outdated, update? "))
(run-with-idle-timer
0.1 nil (lambda ()
(with-helm-buffer
(helm-force-update)
(message "Helm (m)occur Buffer have been udated")
(sit-for 1) (message nil))))
(unless buffer-is-modified (setq helm-occur--buffer-tick
new-tick-ls)))
(run-with-idle-timer
0.1 nil
(lambda ()
(with-helm-buffer
(let ((ov (make-overlay (save-excursion
(goto-char (point-min))
(forward-line 1)
(point))
(point-max))))
(overlay-put ov 'face 'helm-resume-need-update)
(sit-for 0)
(delete-overlay ov)
(message "[Helm occur Buffer outdated (C-c C-u to update)]")))))
(unless buffer-is-modified
(with-helm-after-update-hook
(setq helm-occur--buffer-tick new-tick-ls)
(message "Helm (m)occur Buffer have been udated")))))))))
;;; Helm occur from isearch
;;
;;;###autoload
(defun helm-occur-from-isearch ()
"Invoke `helm-occur' from isearch.
To use this bind it to a key in `isearch-mode-map'."
(interactive)
(let ((input (if isearch-regexp
isearch-string
(regexp-quote isearch-string)))
(bufs (list (current-buffer)))
;; Use `helm-occur-always-search-in-current' as a flag for
;; `helm-occur--select-closest-candidate'.
(helm-occur-always-search-in-current t))
(isearch-exit)
(helm-multi-occur-1 bufs input)))
;;;###autoload
(defun helm-multi-occur-from-isearch ()
"Invoke `helm-multi-occur' from isearch.
With a prefix arg, reverse the behavior of
`helm-moccur-always-search-in-current'.
The prefix arg can be set before calling
`helm-multi-occur-from-isearch' or during the buffer selection.
To use this bind it to a key in `isearch-mode-map'."
(interactive)
(let (buf-list
helm-moccur-always-search-in-current
(input (if isearch-regexp
isearch-string
(regexp-quote isearch-string))))
(isearch-exit)
(setq buf-list (mapcar 'get-buffer
(helm-comp-read "Buffers: "
(helm-buffer-list)
:name "Occur in buffer(s)"
:marked-candidates t)))
(setq helm-moccur-always-search-in-current
(if (or current-prefix-arg
helm-current-prefix-arg)
(not helm-moccur-always-search-in-current)
helm-moccur-always-search-in-current))
(helm-multi-occur-1 buf-list input)))
(provide 'helm-occur)
;;; helm-occur.el ends here

11
code/elpa/helm-20220822.659/helm-pkg.el Normal file
View File

@ -0,0 +1,11 @@
(define-package "helm" "20220822.659" "Helm is an Emacs incremental and narrowing framework"
'((helm-core "3.8.7")
(popup "0.5.3"))
:commit "4e99cc8ef66aac2d824c456f58abe833be26c99d" :authors
'(("Thierry Volpiatto" . "thievol@posteo.net"))
:maintainer
'("Thierry Volpiatto" . "thievol@posteo.net")
:url "https://emacs-helm.github.io/helm/")
;; Local Variables:
;; no-byte-compile: t
;; End:

132
code/elpa/helm-20220822.659/helm-regexp.el Normal file
View File

@ -0,0 +1,132 @@
;;; helm-regexp.el --- In buffer regexp searching and replacement 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/>.
;;; Code:
(require 'cl-lib)
(require 'helm)
(require 'helm-help)
(require 'helm-utils)
(declare-function helm-mm-split-pattern "helm-multi-match")
(defgroup helm-regexp nil
"Regexp related Applications and libraries for Helm."
:group 'helm)
;; History vars
(defvar helm-build-regexp-history nil)
(defun helm-query-replace-regexp (_candidate)
"Query replace regexp from `helm-regexp'.
With a prefix arg replace only matches surrounded by word boundaries,
i.e. don't replace inside a word, regexp is surrounded with \\bregexp\\b."
(let ((regexp helm-input))
(apply 'query-replace-regexp
(helm-query-replace-args regexp))))
(defun helm-kill-regexp-as-sexp (_candidate)
"Kill regexp in a format usable in lisp code."
(helm-regexp-kill-new
(prin1-to-string helm-input)))
(defun helm-kill-regexp (_candidate)
"Kill regexp as it is in `helm-pattern'."
(helm-regexp-kill-new helm-input))
(defun helm-query-replace-args (regexp)
"Create arguments of `query-replace-regexp' action in `helm-regexp'."
(let ((region-only (helm-region-active-p)))
(list
regexp
(query-replace-read-to regexp
(format "Query replace %sregexp %s"
(if helm-current-prefix-arg "word " "")
(if region-only "in region " ""))
t)
helm-current-prefix-arg
(when region-only (region-beginning))
(when region-only (region-end)))))
(defvar helm-source-regexp
(helm-build-in-buffer-source "Regexp Builder"
:init (lambda ()
(helm-init-candidates-in-buffer
'global (with-temp-buffer
(insert-buffer-substring helm-current-buffer)
(buffer-string))))
:get-line #'helm-regexp-get-line
:persistent-action #'helm-regexp-persistent-action
:persistent-help "Show this line"
:multiline t
:multimatch nil
:requires-pattern 2
:group 'helm-regexp
:mode-line "Press TAB to select action."
:action '(("Kill Regexp as sexp" . helm-kill-regexp-as-sexp)
("Query Replace Regexp (C-u Not inside word.)"
. helm-query-replace-regexp)
("Kill Regexp" . helm-kill-regexp))))
(defun helm-regexp-get-line (s e)
(let ((matches (match-data))
(line (buffer-substring s e)))
(propertize
(cl-loop with ln = (format "%5d: %s" (1- (line-number-at-pos s)) line)
for i from 0 to (1- (/ (length matches) 2))
if (match-string i)
concat (format "\n%s%s'%s'"
(make-string 10 ? ) (format "Group %d: " i) it)
into ln1
finally return (concat ln ln1))
'helm-realvalue s)))
(defun helm-regexp-persistent-action (pt)
(helm-goto-char pt)
(helm-highlight-current-line))
(defun helm-regexp-kill-new (input)
(kill-new (substring-no-properties input))
(message "Killed: %s" input))
;;; Predefined commands
;;
;;
;;;###autoload
(defun helm-regexp ()
"Preconfigured helm to build regexps.
`query-replace-regexp' can be run from there against found regexp."
(interactive)
(save-restriction
(when (and (helm-region-active-p)
;; Don't narrow to region if buffer is already narrowed.
(not (helm-current-buffer-narrowed-p (current-buffer))))
(narrow-to-region (region-beginning) (region-end)))
(helm :sources helm-source-regexp
:buffer "*helm regexp*"
:prompt "Regexp: "
:history 'helm-build-regexp-history)))
(provide 'helm-regexp)
;;; helm-regexp.el ends here

604
code/elpa/helm-20220822.659/helm-ring.el Normal file
View File

@ -0,0 +1,604 @@
;;; helm-ring.el --- kill-ring, mark-ring, and register browsers 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/>.
;;; Code:
(require 'cl-lib)
(require 'helm)
(require 'helm-utils)
(require 'helm-help)
(require 'helm-elisp)
(declare-function undo-tree-restore-state-from-register "ext:undo-tree.el" (register))
(defgroup helm-ring nil
"Ring related Applications and libraries for Helm."
:group 'helm)
(defcustom helm-kill-ring-threshold 3
"Minimum length of a candidate to be listed by `helm-source-kill-ring'."
:type 'integer
:group 'helm-ring)
(defcustom helm-kill-ring-max-offset 400
"Max number of chars displayed per candidate in kill-ring browser.
When `t', don't truncate candidate, show all.
By default it is approximatively the number of bits contained in five lines
of 80 chars each, i.e. 80*5.
Note that if you set this to nil multiline will be disabled, i.e. you
will not have separators between candidates any more."
:type '(choice (const :tag "Disabled" t)
(integer :tag "Max candidate offset"))
:group 'helm-ring)
(defcustom helm-kill-ring-actions
'(("Yank marked" . helm-kill-ring-action-yank)
("Delete marked" . helm-kill-ring-action-delete)
("Search from candidate" . helm-kill-ring-search-from-string))
"List of actions for kill ring source."
:group 'helm-ring
:type '(alist :key-type string :value-type function))
(defcustom helm-kill-ring-separator "\n"
"The separator used to separate marked candidates when yanking."
:group 'helm-ring
:type 'string)
(defcustom helm-register-max-offset 160
"Max size of string register entries before truncating."
:group 'helm-ring
:type 'integer)
;;; Kill ring
;;
;;
(defvar helm-kill-ring-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map helm-map)
(define-key map (kbd "M-y") 'helm-next-line)
(define-key map (kbd "M-u") 'helm-previous-line)
(define-key map (kbd "M-D") 'helm-kill-ring-delete)
(define-key map (kbd "C-s") 'helm-kill-ring-run-search-from-string)
(define-key map (kbd "C-]") 'helm-kill-ring-toggle-truncated)
(define-key map (kbd "C-c C-k") 'helm-kill-ring-kill-selection)
(define-key map (kbd "C-c d") 'helm-kill-ring-run-persistent-delete)
map)
"Keymap for `helm-show-kill-ring'.")
(defvar helm-source-kill-ring
(helm-build-sync-source "Kill Ring"
:init (lambda ()
(helm-set-attr 'last-command last-command)
(helm-set-attr 'multiline helm-kill-ring-max-offset))
:candidates #'helm-kill-ring-candidates
:filtered-candidate-transformer #'helm-kill-ring-transformer
:action 'helm-kill-ring-actions
:persistent-action 'ignore
:help-message 'helm-kill-ring-help-message
:persistent-help "DoNothing"
:keymap helm-kill-ring-map
:migemo t
:multiline 'helm-kill-ring-max-offset
:group 'helm-ring)
"Source for browse and insert contents of kill-ring.")
(defun helm-kill-ring-candidates ()
(cl-loop with cands = (helm-fast-remove-dups kill-ring :test 'equal)
for kill in (if (eq (helm-get-attr 'last-command) 'yank)
(cdr cands)
cands)
unless (or (< (length kill) helm-kill-ring-threshold)
(string-match "\\`[\n[:blank:]]+\\'" kill))
collect kill))
(defun helm-kill-ring-transformer (candidates _source)
"Ensure CANDIDATES are not read-only."
(cl-loop for i in candidates
when (get-text-property 0 'read-only i)
do (set-text-properties 0 (length i) '(read-only nil) i)
collect i))
(defvar helm-kill-ring--truncated-flag nil)
(defun helm-kill-ring-toggle-truncated ()
"Toggle truncated view of candidates in helm kill-ring browser."
(interactive)
(with-helm-alive-p
(setq helm-kill-ring--truncated-flag (not helm-kill-ring--truncated-flag))
(let* ((cur-cand (helm-get-selection))
(presel-fn (lambda ()
(helm-kill-ring--preselect-fn cur-cand))))
(helm-set-attr 'multiline
(if helm-kill-ring--truncated-flag
15000000
helm-kill-ring-max-offset))
(helm-update presel-fn))))
(put 'helm-kill-ring-toggle-truncated 'helm-only t)
(defun helm-kill-ring-kill-selection ()
"Store the real value of candidate in kill-ring.
Same as `helm-kill-selection-and-quit' called with a prefix arg."
(interactive)
(helm-kill-selection-and-quit t))
(put 'helm-kill-ring-kill-selection 'helm-only t)
(defun helm-kill-ring--preselect-fn (candidate)
"Internal, used to preselect CANDIDATE when toggling truncated view."
;; Preselection by regexp may not work if candidate is huge, so walk
;; the helm buffer until selection is on CANDIDATE.
(helm-awhile (condition-case-unless-debug nil
(and (not (helm-pos-header-line-p))
(helm-get-selection))
(error nil))
(if (string= it candidate)
(cl-return)
(helm-next-line))))
(defun helm-kill-ring-action-yank (_str)
"Insert concatenated marked candidates in current-buffer.
When two prefix args are given prompt to choose separator, otherwise
use `helm-kill-ring-separator' as default."
(let ((marked (helm-marked-candidates))
(sep (if (equal helm-current-prefix-arg '(16))
(read-string "Separator: ")
helm-kill-ring-separator)))
(helm-kill-ring-action-yank-1
(cl-loop for c in (butlast marked)
concat (concat c sep) into str
finally return (concat str (car (last marked)))))))
(defun helm-kill-ring-action-yank-1 (str)
"Insert STR in `kill-ring' and set STR to the head.
When called with a prefix arg, point and mark are exchanged
without activating region.
If this action is executed just after `yank', replace with STR as
yanked string."
(let ((yank-fn (lambda (&optional before yank-pop)
(insert-for-yank str)
;; Set the window start back where it was in
;; the yank command, if possible.
(when yank-pop
(set-window-start (selected-window) yank-window-start t))
(when (or (equal helm-current-prefix-arg '(4)) before)
;; Same as exchange-point-and-mark but without
;; activating region.
(goto-char (prog1 (mark t)
(set-marker (mark-marker)
(point)
helm-current-buffer)))))))
;; Prevent inserting and saving highlighted items.
(set-text-properties 0 (length str) nil str)
(with-helm-current-buffer
(unwind-protect
(progn
(setq kill-ring (delete str kill-ring))
;; Adding a `delete-selection' property
;; to `helm-kill-ring-action' is not working
;; because `this-command' will be `helm-maybe-exit-minibuffer',
;; so use this workaround (Bug#1520).
(when (and (region-active-p) delete-selection-mode)
(delete-region (region-beginning) (region-end)))
(if (not (eq (helm-get-attr 'last-command helm-source-kill-ring) 'yank))
(progn
;; Ensure mark is at beginning of inserted text.
(push-mark)
;; When yanking in a helm minibuffer we need a small
;; delay to detect the mark in previous minibuffer. [1]
(run-with-timer 0.01 nil yank-fn))
;; from `yank-pop'
(let ((inhibit-read-only t)
(before (< (point) (mark t))))
(if before
(funcall (or yank-undo-function 'delete-region) (point) (mark t))
(funcall (or yank-undo-function 'delete-region) (mark t) (point)))
(setq yank-undo-function nil)
(set-marker (mark-marker) (point) helm-current-buffer)
;; Same as [1] but use the same mark and point as in
;; the initial yank according to BEFORE even if no
;; prefix arg is given.
(run-with-timer 0.01 nil yank-fn before 'pop))))
(kill-new str)))))
(define-obsolete-function-alias 'helm-kill-ring-action 'helm-kill-ring-action-yank "2.4.0")
(defun helm-kill-ring-search-from-string (candidate)
(let ((str (car (split-string candidate "\n"))))
(helm-multi-occur-1
(list (current-buffer))
(regexp-quote (substring-no-properties str)))))
(defun helm-kill-ring-run-search-from-string ()
(interactive)
(with-helm-alive-p
(helm-exit-and-execute-action 'helm-kill-ring-search-from-string)))
(put 'helm-kill-ring-run-search-from-string 'helm-only t)
(defun helm-kill-ring-action-delete (_candidate)
"Delete marked candidates from `kill-ring'."
(cl-loop for c in (helm-marked-candidates)
do (setq kill-ring
(delete c kill-ring))))
(defun helm-kill-ring-persistent-delete (_candidate)
(unwind-protect
(cl-loop for c in (helm-marked-candidates)
do (progn
(helm-preselect (format "^%s" (regexp-quote c)))
(setq kill-ring (delete c kill-ring))
(helm-delete-current-selection)
(helm--remove-marked-and-update-mode-line c)))
(with-helm-buffer
(setq helm-marked-candidates nil
helm-visible-mark-overlays nil))
(helm-force-update (helm-aif (helm-get-selection nil t) (regexp-quote it)))))
(defun helm-kill-ring-run-persistent-delete ()
"Delete current candidate without quitting."
(interactive)
(with-helm-alive-p
(helm-set-attr 'quick-delete '(helm-kill-ring-persistent-delete . never-split))
(helm-execute-persistent-action 'quick-delete)))
(put 'helm-kill-ring-run-persistent-delete 'helm-only t)
(defun helm-kill-ring-delete ()
"Delete marked candidates from `kill-ring'.
This is a command for `helm-kill-ring-map'."
(interactive)
(with-helm-alive-p
(helm-exit-and-execute-action 'helm-kill-ring-action-delete)))
(put 'helm-kill-ring-delete 'helm-only t)
;;;; <Mark ring>
;; DO NOT use these sources with other sources use
;; the commands `helm-mark-ring', `helm-global-mark-ring' or
;; `helm-all-mark-rings' instead.
(defun helm-mark-ring-line-string-at-pos (pos)
"Return line string at position POS."
(save-excursion
(goto-char pos)
(forward-line 0)
(let ((line (car (split-string (thing-at-point 'line) "[\n\r]"))))
(remove-text-properties 0 (length line) '(read-only) line)
(if (string= "" line)
"<EMPTY LINE>"
line))))
(defun helm-mark-ring-get-candidates ()
(with-helm-current-buffer
(cl-loop with marks = (if (mark t)
(cons (mark-marker) mark-ring)
mark-ring)
for marker in marks
with max-line-number = (line-number-at-pos (point-max))
with width = (length (number-to-string max-line-number))
for m = (format (concat "%" (number-to-string width) "d: %s")
(line-number-at-pos marker)
(helm-mark-ring-line-string-at-pos marker))
unless (and recip (assoc m recip))
collect (cons m marker) into recip
finally return recip)))
(defun helm-mark-ring-default-action (candidate)
(let ((target (copy-marker candidate)))
(helm-aif (marker-buffer candidate)
(progn
(switch-to-buffer it)
(helm-log-run-hook 'helm-goto-line-before-hook)
(helm-match-line-cleanup)
(with-helm-current-buffer
(unless helm-yank-point (setq helm-yank-point (point))))
(helm-goto-char target)
(helm-highlight-current-line))
;; marker points to no buffer, no need to dereference it, just
;; delete it.
(setq mark-ring (delete target mark-ring))
(error "Marker points to no buffer"))))
(defvar helm-source-mark-ring
(helm-build-sync-source "mark-ring"
:candidates #'helm-mark-ring-get-candidates
:action '(("Goto line" . helm-mark-ring-default-action))
:persistent-help "Show this line"
:group 'helm-ring))
;;; Global-mark-ring
(defvar helm-source-global-mark-ring
(helm-build-sync-source "global-mark-ring"
:candidates #'helm-global-mark-ring-get-candidates
:action '(("Goto line" . helm-mark-ring-default-action))
:persistent-help "Show this line"
:group 'helm-ring))
(defun helm-global-mark-ring-format-buffer (marker)
(with-current-buffer (marker-buffer marker)
(goto-char marker)
(forward-line 0)
(let ((line (pcase (thing-at-point 'line)
((and line (pred stringp)
(guard (not (string-match-p "\\`\n?\\'" line))))
(car (split-string line "[\n\r]")))
(_ "<EMPTY LINE>"))))
(remove-text-properties 0 (length line) '(read-only) line)
(format "%7d:%s: %s"
(line-number-at-pos) (marker-buffer marker) line))))
(defun helm-global-mark-ring-get-candidates ()
(let ((marks global-mark-ring))
(when marks
(cl-loop for marker in marks
for mb = (marker-buffer marker)
for gm = (unless (or (string-match "^ " (format "%s" mb))
(null mb))
(helm-global-mark-ring-format-buffer marker))
when (and gm (not (assoc gm recip)))
collect (cons gm marker) into recip
finally return recip))))
;;;; <Register>
;;; Insert from register
(defvar helm-source-register
(helm-build-sync-source "Registers"
:candidates #'helm-register-candidates
:action-transformer #'helm-register-action-transformer
:persistent-help ""
:multiline t
:action '(("Delete Register(s)" .
(lambda (_candidate)
(cl-loop for candidate in (helm-marked-candidates)
for register = (car candidate)
do (setq register-alist
(delq (assoc register register-alist)
register-alist))))))
:group 'helm-ring)
"See (info \"(emacs)Registers\")")
(defun helm-register-candidates ()
"Collecting register contents and appropriate commands."
(cl-loop for (char . rval) in register-alist
for key = (single-key-description char)
for e27 = (registerv-p rval)
for val = (if e27 ; emacs-27
(registerv-data rval)
rval)
for string-actions =
(cond
((numberp val)
(list (int-to-string val)
'insert-register
'increment-register))
((markerp val)
(let ((buf (marker-buffer val)))
(if (null buf)
(list "a marker in no buffer")
(list (concat
"a buffer position:"
(buffer-name buf)
", position "
(int-to-string (marker-position val)))
'jump-to-register
'insert-register))))
((and (consp val) (window-configuration-p (car val)))
(list "window configuration."
'jump-to-register))
((and (vectorp val)
(fboundp 'undo-tree-register-data-p)
(undo-tree-register-data-p (if e27 val (elt val 1))))
(list
"Undo-tree entry."
'undo-tree-restore-state-from-register))
((or (and (vectorp val) (eq 'registerv (aref val 0)))
(and (consp val) (frame-configuration-p (car val))))
(list "frame configuration."
'jump-to-register))
((and (consp val) (eq (car val) 'file))
(list (concat "file:"
(prin1-to-string (cdr val))
".")
'jump-to-register))
((and (consp val) (eq (car val) 'file-query))
(list (concat "file:a file-query reference: file "
(car (cdr val))
", position "
(int-to-string (car (cdr (cdr val))))
".")
'jump-to-register))
((consp val)
(let ((lines (format "%4d" (length val))))
(list (format "%s: %s\n" lines
(truncate-string-to-width
(mapconcat 'identity (list (car val))
"^J")
(- (window-width) 15)))
'insert-register)))
((stringp val)
(list
(concat (substring-no-properties
val 0 (min (length val) helm-register-max-offset))
(if (> (length val) helm-register-max-offset)
"[...]" ""))
'insert-register
'kill-new
'append-to-register
'prepend-to-register)))
unless (null string-actions) ; Fix Bug#1107.
collect (cons (format "Register %3s:\n %s" key (car string-actions))
(cons char (cdr string-actions)))))
(defun helm-register-action-transformer (actions register-and-functions)
"Decide actions by the contents of register."
(cl-loop with func-actions =
'((insert-register
"Insert Register" .
(lambda (c) (insert-register (car c))))
(kill-new
"Kill Register" .
(lambda (c) (with-temp-buffer
(insert-register (car c))
(kill-new (buffer-string)))))
(jump-to-register
"Jump to Register" .
(lambda (c) (jump-to-register (car c))))
(append-to-register
"Append Region to Register" .
(lambda (c) (append-to-register
(car c) (region-beginning) (region-end))))
(prepend-to-register
"Prepend Region to Register" .
(lambda (c) (prepend-to-register
(car c) (region-beginning) (region-end))))
(increment-register
"Increment Prefix Arg to Register" .
(lambda (c) (increment-register
helm-current-prefix-arg (car c))))
(undo-tree-restore-state-from-register
"Restore Undo-tree register" .
(lambda (c) (and (fboundp 'undo-tree-restore-state-from-register)
(undo-tree-restore-state-from-register (car c))))))
for func in (cdr register-and-functions)
when (assq func func-actions)
collect (cdr it) into transformer-actions
finally return (append transformer-actions actions)))
;;;###autoload
(defun helm-mark-ring ()
"Preconfigured `helm' for `helm-source-mark-ring'."
(interactive)
(helm :sources 'helm-source-mark-ring
:resume 'noresume
:buffer "*helm mark*"))
;;;###autoload
(defun helm-global-mark-ring ()
"Preconfigured `helm' for `helm-source-global-mark-ring'."
(interactive)
(helm :sources 'helm-source-global-mark-ring
:resume 'noresume
:buffer "*helm global mark*"))
;;;###autoload
(defun helm-all-mark-rings ()
"Preconfigured `helm' for mark rings.
Source used are `helm-source-global-mark-ring' and
`helm-source-mark-ring'."
(interactive)
(helm :sources '(helm-source-mark-ring
helm-source-global-mark-ring)
:resume 'noresume
:buffer "*helm mark ring*"))
;;;###autoload
(defun helm-register ()
"Preconfigured `helm' for Emacs registers."
(interactive)
(helm :sources 'helm-source-register
:resume 'noresume
:buffer "*helm register*"))
;;;###autoload
(defun helm-show-kill-ring ()
"Preconfigured `helm' for `kill-ring'.
It is drop-in replacement of `yank-pop'.
First call open the kill-ring browser, next calls move to next line."
(interactive)
(setq helm-kill-ring--truncated-flag nil)
(let ((enable-recursive-minibuffers t))
(helm :sources helm-source-kill-ring
:buffer "*helm kill ring*"
:resume 'noresume
:allow-nest t)))
;;;###autoload
(defun helm-execute-kmacro ()
"Preconfigured helm for keyboard macros.
Define your macros with `f3' and `f4'.
See (info \"(emacs) Keyboard Macros\") for detailed infos.
This command is useful when used with persistent action."
(interactive)
(let ((helm-quit-if-no-candidate
(lambda () (message "No kbd macro has been defined"))))
(helm :sources
(helm-build-sync-source "Kmacro"
:candidates (lambda ()
(helm-fast-remove-dups
(cons (kmacro-ring-head)
kmacro-ring)
:test 'equal))
:multiline t
:candidate-transformer
(lambda (candidates)
(cl-loop for c in candidates collect
(propertize (help-key-description (car c) nil)
'helm-realvalue c)))
:persistent-help "Execute kmacro"
:help-message 'helm-kmacro-help-message
:action
(helm-make-actions
"Execute kmacro (`C-u <n>' to execute <n> times)"
'helm-kbd-macro-execute
"Concat marked macros"
'helm-kbd-macro-concat-macros
"Delete marked macros"
'helm-kbd-macro-delete-macro
"Edit marked macro"
'helm-kbd-macro-edit-macro)
:group 'helm-ring)
:buffer "*helm kmacro*")))
(defun helm-kbd-macro-execute (candidate)
;; Move candidate on top of list for next use.
(setq kmacro-ring (delete candidate kmacro-ring))
(kmacro-push-ring)
(kmacro-split-ring-element candidate)
(kmacro-exec-ring-item
candidate helm-current-prefix-arg))
(defun helm-kbd-macro-concat-macros (_candidate)
(let ((mkd (helm-marked-candidates)))
(when (cdr mkd)
(kmacro-push-ring)
(setq last-kbd-macro
(mapconcat 'identity
(cl-loop for km in mkd
if (vectorp km)
append (cl-loop for k across km collect
(key-description (vector k)))
into result
else collect (car km) into result
finally return result)
"")))))
(defun helm-kbd-macro-delete-macro (_candidate)
(let ((mkd (helm-marked-candidates)))
(kmacro-push-ring)
(cl-loop for km in mkd
do (setq kmacro-ring (delete km kmacro-ring)))
(kmacro-pop-ring1)))
(defun helm-kbd-macro-edit-macro (candidate)
(kmacro-push-ring)
(setq kmacro-ring (delete candidate kmacro-ring))
(kmacro-split-ring-element candidate)
(kmacro-edit-macro))
(provide 'helm-ring)
;;; helm-ring.el ends here

232
code/elpa/helm-20220822.659/helm-semantic.el Normal file
View File

@ -0,0 +1,232 @@
;;; helm-semantic.el --- Helm interface for Semantic -*- lexical-binding: t -*-
;; Copyright (C) 2012 ~ 2017 Daniel Hackney <dan@haxney.org>
;; 2012 ~ 2021 Thierry Volpiatto
;; Author: Daniel Hackney <dan@haxney.org>
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Uses `candidates-in-buffer' for speed.
;;; Code:
(require 'cl-lib)
(require 'semantic)
(require 'helm-help)
(require 'helm-imenu)
(declare-function pulse-momentary-highlight-one-line "pulse.el" (point &optional face))
(defgroup helm-semantic nil
"Semantic tags related libraries and applications for helm."
:group 'helm)
(defcustom helm-semantic-display-style
'((python-mode . semantic-format-tag-summarize)
(c-mode . semantic-format-tag-concise-prototype-c-mode)
(emacs-lisp-mode . semantic-format-tag-abbreviate-emacs-lisp-mode))
"Function to present a semantic tag according to `major-mode'.
It is an alist where the `car' of each element is a `major-mode' and
the `cdr' a `semantic-format-tag-*' function.
If no function is found for current `major-mode', fall back to
`semantic-format-tag-summarize' default function.
You can have more or less informations depending of the `semantic-format-tag-*'
function you choose.
All the supported functions are prefixed with \"semantic-format-tag-\",
you have completion on these functions with `C-M i' in the customize interface."
:group 'helm-semantic
:type '(alist :key-type symbol :value-type symbol))
;;; keymap
(defvar helm-semantic-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map helm-map)
map))
(defcustom helm-semantic-lynx-style-map nil
"Use Arrow keys to jump to occurences."
:group 'helm-semantic
:type 'boolean
:set (lambda (var val)
(set var val)
(if val
(progn
(define-key helm-semantic-map (kbd "<right>") 'helm-execute-persistent-action)
(define-key helm-semantic-map (kbd "<left>") 'helm-maybe-exit-minibuffer))
(define-key helm-semantic-map (kbd "<right>") nil)
(define-key helm-semantic-map (kbd "<left>") nil))))
;; Internals vars
(defvar helm-semantic--tags-cache nil)
(defun helm-semantic--fetch-candidates (tags depth &optional class)
"Write the contents of TAGS to the current buffer."
(let ((class class) cur-type
(stylefn (or (with-helm-current-buffer
(assoc-default major-mode helm-semantic-display-style))
#'semantic-format-tag-summarize)))
(cl-dolist (tag tags)
(when (listp tag)
(cl-case (setq cur-type (semantic-tag-class tag))
((function variable type)
(let ((spaces (make-string (* depth 2) ?\s))
(type-p (eq cur-type 'type)))
(unless (and (> depth 0) (not type-p))
(setq class nil))
(insert
(if (and class (not type-p))
(format "%s%s(%s) "
spaces (if (< depth 2) "" "├►") class)
spaces)
;; Save the tag for later
(propertize (funcall stylefn tag nil t)
'semantic-tag tag)
"\n")
(and type-p (setq class (car tag)))
;; Recurse to children
(unless (eq cur-type 'function)
(helm-semantic--fetch-candidates
(semantic-tag-components tag) (1+ depth) class))))
;; Don't do anything with packages or includes for now
((package include)
(insert
(propertize (funcall stylefn tag nil t)
'semantic-tag tag)
"\n")
)
;; Catch-all
(t))))))
(defun helm-semantic-default-action (_candidate &optional persistent)
;; By default, helm doesn't pass on the text properties of the selection.
;; Fix this.
(helm-log-run-hook 'helm-goto-line-before-hook)
(with-current-buffer helm-buffer
(when (looking-at " ")
(goto-char (next-single-property-change
(point-at-bol) 'semantic-tag nil (point-at-eol))))
(let ((tag (get-text-property (point) 'semantic-tag)))
(semantic-go-to-tag tag)
(unless persistent
(pulse-momentary-highlight-one-line (point))))))
(defun helm-semantic--maybe-set-needs-update ()
(with-helm-current-buffer
(when (semantic-parse-tree-needs-update-p)
(semantic-parse-tree-set-needs-update))))
(defvar helm-source-semantic nil)
(defclass helm-semantic-source (helm-source-in-buffer)
((init :initform (lambda ()
(helm-semantic--maybe-set-needs-update)
(setq helm-semantic--tags-cache (semantic-fetch-tags))
(with-current-buffer (helm-candidate-buffer 'global)
(let ((major-mode (with-helm-current-buffer major-mode)))
(helm-semantic--fetch-candidates helm-semantic--tags-cache 0)))))
(get-line :initform 'buffer-substring)
(persistent-help :initform "Show this entry")
(keymap :initform 'helm-semantic-map)
(help-message :initform 'helm-semantic-help-message)
(persistent-action :initform (lambda (elm)
(helm-semantic-default-action elm t)
(helm-highlight-current-line)))
(action :initform 'helm-semantic-default-action)))
(defcustom helm-semantic-fuzzy-match nil
"Enable fuzzy matching in `helm-source-semantic'."
:group 'helm-semantic
:type 'boolean
:set (lambda (var val)
(set var val)
(setq helm-source-semantic
(helm-make-source "Semantic Tags" 'helm-semantic-source
:fuzzy-match helm-semantic-fuzzy-match))))
;;;###autoload
(defun helm-semantic (arg)
"Preconfigured `helm' for `semantic'.
If ARG is supplied, pre-select symbol at point instead of current."
(interactive "P")
(let ((tag (helm-aif (car (semantic-current-tag-parent))
(let ((curtag (car (semantic-current-tag))))
(if (string= it curtag)
(format "\\_<%s\\_>" curtag)
(cons (format "\\_<%s\\_>" it)
(format "\\_<%s\\_>" curtag))))
(format "\\_<%s\\_>" (car (semantic-current-tag)))))
(helm-highlight-matches-around-point-max-lines 'never))
(unless helm-source-semantic
(setq helm-source-semantic
(helm-make-source "Semantic Tags" 'helm-semantic-source
:fuzzy-match helm-semantic-fuzzy-match)))
(helm :sources 'helm-source-semantic
:candidate-number-limit 9999
:preselect (if arg
(thing-at-point 'symbol)
tag)
:buffer "*helm semantic*")))
;;;###autoload
(defun helm-semantic-or-imenu (arg)
"Preconfigured helm for `semantic' or `imenu'.
If ARG is supplied, pre-select symbol at point instead of current
semantic tag in scope.
If `semantic-mode' is active in the current buffer, then use
semantic for generating tags, otherwise fall back to `imenu'.
Fill in the symbol at point by default."
(interactive "P")
(unless helm-source-semantic
(setq helm-source-semantic
(helm-make-source "Semantic Tags" 'helm-semantic-source
:fuzzy-match helm-semantic-fuzzy-match)))
(unless helm-source-imenu
(setq helm-source-imenu
(helm-make-source "Imenu" 'helm-imenu-source
:fuzzy-match helm-imenu-fuzzy-match)))
(let* ((source (if (semantic-active-p)
'helm-source-semantic
'helm-source-imenu))
(helm-highlight-matches-around-point-max-lines 'never)
(imenu-p (eq source 'helm-source-imenu))
(imenu-auto-rescan imenu-p)
(str (thing-at-point 'symbol))
(helm-execute-action-at-once-if-one
(and imenu-p
helm-imenu-execute-action-at-once-if-one))
(tag (helm-aif (car (semantic-current-tag-parent))
(let ((curtag (car (semantic-current-tag))))
(if (string= it curtag)
(format "\\_<%s\\_>" curtag)
(cons (format "\\_<%s\\_>" it)
(format "\\_<%s\\_>" curtag))))
(format "\\_<%s\\_>" (car (semantic-current-tag))))))
(helm :sources source
:candidate-number-limit 9999
:default (and imenu-p (list (concat "\\_<" (and str (regexp-quote str)) "\\_>") str))
:preselect (if (or arg imenu-p) str tag)
:buffer "*helm semantic/imenu*")))
(provide 'helm-semantic)
;;; helm-semantic.el ends here

38
code/elpa/helm-20220822.659/helm-shell.el Normal file
View File

@ -0,0 +1,38 @@
;;; helm-shell.el --- Shell prompt navigation for helm. -*- lexical-binding: t -*-
;; Copyright (C) 2020 Pierre Neidhardt <mail@ambrevar.xyz>
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; This is superseded by helm-comint.el.
;;; Code:
(require 'cl-lib)
(require 'helm)
(require 'helm-lib)
(require 'helm-help)
(require 'helm-elisp)
(require 'helm-comint)
;;;###autoload
(defalias 'helm-shell-prompts 'helm-comint-prompts)
;;;###autoload
(defalias 'helm-shell-prompts-all 'helm-comint-prompts-all)
(provide 'helm-shell)
;;; helm-shell ends here

472
code/elpa/helm-20220822.659/helm-sys.el Normal file
View File

@ -0,0 +1,472 @@
;;; helm-sys.el --- System related functions 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/>.
;;; Code:
(require 'cl-lib)
(require 'helm)
(require 'helm-help)
(require 'helm-utils)
(defgroup helm-sys nil
"System related helm library."
:group 'helm)
(defface helm-top-columns
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:inherit helm-header))
"Face for helm help string in minibuffer."
:group 'helm-sys)
(defcustom helm-top-command
(cl-case system-type
(darwin "env COLUMNS=%s ps -axo pid,user,pri,nice,ucomm,tty,start_time,vsz,%%cpu,%%mem,etime,command")
(t "env COLUMNS=%s top -b -n 1"))
"Top command used to display output of top.
A format string where %s will be replaced with `frame-width'.
To use 'top' command, a version supporting batch mode (-b option)
is needed. On Mac OSX 'top' command doesn't support this, so the
'ps' command is used instead by default.
Normally 'top' command output have 12 columns, but in some
versions you may have less than this, so you can either customize
'top' to use 12 columns with the interactives 'f' and 'W' commands
of 'top', or modify `helm-top-sort-columns-alist' to fit with the
number of columns your 'top' command is using.
If you modify 'ps' command be sure that 'pid' comes in first and
\"env COLUMNS=%s\" is specified at beginning of command. Ensure
also that no elements contain spaces (e.g., use start_time and
not start). Same as for 'top': you can customize
`helm-top-sort-columns-alist' to make sort commands working
properly according to your settings."
:group 'helm-sys
:type 'string)
(defcustom helm-top-sort-columns-alist '((com . 11)
(mem . 9)
(cpu . 8)
(user . 1))
"Allow defining which column to use when sorting output of top/ps command.
Only com, mem, cpu and user are sorted, so no need to put something
else there,it will have no effect.
Note that column numbers are counted from zero, i.e. column 1 is the
nth 0 column."
:group 'helm-sys
:type '(alist :key-type symbol :value-type (integer :tag "Column number")))
(defcustom helm-top-poll-delay 1.5
"Helm top poll after this delay when `helm-top-poll-mode' is enabled.
The minimal delay allowed is 1.5, if less than this helm-top will use 1.5."
:group 'helm-sys
:type 'float)
(defcustom helm-top-poll-delay-post-command 1.0
"Helm top stop polling during this delay.
This delay is added to `helm-top-poll-delay' after Emacs stops
being idle."
:group 'helm-sys
:type 'float)
(defcustom helm-top-poll-preselection 'linum
"Stay on same line or follow candidate when `helm-top-poll' updates display.
Possible values are \\='candidate or \\='linum.
This affects also sorting functions in the same way."
:group'helm-sys
:type '(radio :tag "Preferred preselection action for helm-top"
(const :tag "Follow candidate" candidate)
(const :tag "Stay on same line" linum)))
;;; Top (process)
;;
;;
(defvar helm-top-sort-fn nil)
(defvar helm-top-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map helm-map)
(define-key map (kbd "M-P") 'helm-top-run-sort-by-cpu)
(define-key map (kbd "M-C") 'helm-top-run-sort-by-com)
(define-key map (kbd "M-M") 'helm-top-run-sort-by-mem)
(define-key map (kbd "M-U") 'helm-top-run-sort-by-user)
map))
(defvar helm-top-after-init-hook nil
"Local hook for helm-top.")
(defvar helm-top--poll-timer nil)
(defun helm-top-poll (&optional no-update delay)
(when helm-top--poll-timer
(cancel-timer helm-top--poll-timer))
(condition-case nil
(progn
(when (and (helm--alive-p) (null no-update))
;; Fix quitting while process is running
;; by binding `with-local-quit' in init function
;; Bug#1521.
(helm-force-update
(cl-ecase helm-top-poll-preselection
(candidate (replace-regexp-in-string
"[0-9]+" "[0-9]+"
(regexp-quote (helm-get-selection nil t))))
(linum `(lambda ()
(goto-char (point-min))
(forward-line ,(helm-candidate-number-at-point)))))))
(setq helm-top--poll-timer
(run-with-idle-timer
(helm-aif (current-idle-time)
(time-add it (seconds-to-time
(or delay (helm-top--poll-delay))))
(or delay (helm-top--poll-delay)))
nil
'helm-top-poll)))
(quit (cancel-timer helm-top--poll-timer))))
(defun helm-top--poll-delay ()
(max 1.5 helm-top-poll-delay))
(defun helm-top-poll-no-update ()
(helm-top-poll t (+ (helm-top--poll-delay)
helm-top-poll-delay-post-command)))
(defun helm-top-initialize-poll-hooks ()
;; When Emacs is idle during say 20s
;; the idle timer will run in 20+1.5 s.
;; This is fine when Emacs stays idle, because the next timer
;; will run at 21.5+1.5 etc... so the display will be updated
;; at every 1.5 seconds.
;; But as soon as emacs looses its idleness, the next update
;; will occur at say 21+1.5 s, so we have to reinitialize
;; the timer at 0+1.5.
(add-hook 'post-command-hook 'helm-top-poll-no-update)
(add-hook 'focus-in-hook 'helm-top-poll-no-update))
;;;###autoload
(define-minor-mode helm-top-poll-mode
"Refresh automatically helm top buffer once enabled."
:group 'helm-top
:global t
(if helm-top-poll-mode
(progn
(add-hook 'helm-top-after-init-hook 'helm-top-poll-no-update)
(add-hook 'helm-top-after-init-hook 'helm-top-initialize-poll-hooks))
(remove-hook 'helm-top-after-init-hook 'helm-top-poll-no-update)
(remove-hook 'helm-top-after-init-hook 'helm-top-initialize-poll-hooks)))
(defvar helm-source-top
(helm-build-in-buffer-source "Top"
:header-name (lambda (name)
(concat name (if helm-top-poll-mode
" (auto updating)"
" (Press C-c C-u to refresh)")))
:init #'helm-top-init
:after-init-hook 'helm-top-after-init-hook
:cleanup (lambda ()
(when helm-top--poll-timer
(cancel-timer helm-top--poll-timer))
(remove-hook 'post-command-hook 'helm-top-poll-no-update)
(remove-hook 'focus-in-hook 'helm-top-poll-no-update))
:display-to-real #'helm-top-display-to-real
:persistent-action '(helm-top-sh-persistent-action . never-split)
:persistent-help "SIGTERM"
:help-message 'helm-top-help-message
:mode-line 'helm-top-mode-line
:follow 'never
:keymap helm-top-map
:filtered-candidate-transformer #'helm-top-sort-transformer
:action-transformer #'helm-top-action-transformer
:group 'helm-sys))
(defvar helm-top--line nil)
(defun helm-top-transformer (candidates _source)
"Transformer for `helm-top'.
Return empty string for non--valid candidates."
(cl-loop for disp in candidates collect
(cond ((string-match "^ *[0-9]+" disp) disp)
((string-match "^ *PID" disp)
(setq helm-top--line (cons (propertize disp 'face 'helm-top-columns) "")))
(t (cons disp "")))
into lst
finally return (or (member helm-top--line lst)
(cons helm-top--line lst))))
(defun helm-top--skip-top-line ()
(let* ((src (helm-get-current-source))
(src-name (assoc-default 'name src)))
(helm-aif (and (stringp src-name)
(string= src-name "Top")
(helm-get-selection nil t src))
(when (string-match-p "^ *PID" it)
(helm-next-line)))))
(defun helm-top-action-transformer (actions _candidate)
"Action transformer for `top'.
Show actions only on line starting by a PID."
(let ((disp (helm-get-selection nil t)))
(cond ((string-match "\\` *[0-9]+" disp)
(list '("kill (SIGTERM)" . (lambda (_pid)
(helm-top-sh "TERM" (helm-top--marked-pids))))
'("kill (SIGKILL)" . (lambda (_pid)
(helm-top-sh "KILL" (helm-top--marked-pids))))
'("kill (SIGINT)" . (lambda (_pid)
(helm-top-sh "INT" (helm-top--marked-pids))))
'("kill (Choose signal)"
. (lambda (_pid)
(let ((pids (helm-top--marked-pids)))
(helm-top-sh
(helm-comp-read (format "Kill %d pids with signal: "
(length pids))
'("ALRM" "HUP" "INT" "KILL" "PIPE" "POLL"
"PROF" "TERM" "USR1" "USR2" "VTALRM"
"STKFLT" "PWR" "WINCH" "CHLD" "URG"
"TSTP" "TTIN" "TTOU" "STOP" "CONT"
"ABRT" "FPE" "ILL" "QUIT" "SEGV"
"TRAP" "SYS" "EMT" "BUS" "XCPU" "XFSZ")
:must-match t)
pids))))))
(t actions))))
(defun helm-top--marked-pids ()
(helm-remove-if-not-match "\\`[0-9]+\\'" (helm-marked-candidates)))
(defun helm-top-sh (sig pids)
"Run kill shell command with signal SIG on PIDS for `helm-top'."
(message "kill -%s %s exited with status %s"
sig (mapconcat 'identity pids " ")
(apply #'call-process
"kill" nil nil nil (format "-%s" sig) pids)))
(defun helm-top-sh-persistent-action (pid)
(helm-top-sh "TERM" (list pid))
(helm-delete-current-selection))
(defun helm-top-init ()
"Insert output of top command in candidate buffer."
(with-local-quit
(unless helm-top-sort-fn (helm-top-set-mode-line "CPU"))
(with-current-buffer (helm-candidate-buffer 'global)
(call-process-shell-command
(format helm-top-command (frame-width))
nil (current-buffer)))))
(defun helm-top-display-to-real (line)
"Return pid only from LINE."
(car (split-string line)))
;; Sort top command
(defun helm-top-set-mode-line (str)
(if (string-match "Sort:\\[\\(.*\\)\\] " helm-top-mode-line)
(setq helm-top-mode-line (replace-match str nil nil helm-top-mode-line 1))
(setq helm-top-mode-line (concat (format "Sort:[%s] " str) helm-top-mode-line))))
(defun helm-top-sort-transformer (candidates source)
(helm-top-transformer
(if helm-top-sort-fn
(cl-loop for c in candidates
if (string-match "^ *[0-9]+" c)
collect c into pid-cands
else collect c into header-cands
finally return (append
header-cands
(sort pid-cands helm-top-sort-fn)))
candidates)
source))
(defun helm-top-sort-by-com (s1 s2)
(let* ((split-1 (split-string s1))
(split-2 (split-string s2))
(col (cdr (assq 'com helm-top-sort-columns-alist)))
(com-1 (nth col split-1))
(com-2 (nth col split-2)))
(string< com-1 com-2)))
(defun helm-top-sort-by-mem (s1 s2)
(let* ((split-1 (split-string s1))
(split-2 (split-string s2))
(col (cdr (assq 'mem helm-top-sort-columns-alist)))
(mem-1 (string-to-number (nth col split-1)))
(mem-2 (string-to-number (nth col split-2))))
(> mem-1 mem-2)))
(defun helm-top-sort-by-cpu (s1 s2)
(let* ((split-1 (split-string s1))
(split-2 (split-string s2))
(col (cdr (assq 'cpu helm-top-sort-columns-alist)))
(cpu-1 (string-to-number (nth col split-1)))
(cpu-2 (string-to-number (nth col split-2))))
(> cpu-1 cpu-2)))
(defun helm-top-sort-by-user (s1 s2)
(let* ((split-1 (split-string s1))
(split-2 (split-string s2))
(col (cdr (assq 'user helm-top-sort-columns-alist)))
(user-1 (nth col split-1))
(user-2 (nth col split-2)))
(string< user-1 user-2)))
(defun helm-top--preselect-fn ()
(if (eq helm-top-poll-preselection 'linum)
`(lambda ()
(goto-char (point-min))
(forward-line ,(helm-candidate-number-at-point)))
(replace-regexp-in-string
"[0-9]+" "[0-9]+"
(regexp-quote (helm-get-selection nil t)))))
(defun helm-top-run-sort-by-com ()
(interactive)
(helm-top-set-mode-line "COM")
(setq helm-top-sort-fn 'helm-top-sort-by-com)
(helm-update (helm-top--preselect-fn)))
(defun helm-top-run-sort-by-cpu ()
(interactive)
(helm-top-set-mode-line "CPU")
;; Force sorting by CPU even if some versions of top are using by
;; default CPU sorting (Bug#1908).
(setq helm-top-sort-fn 'helm-top-sort-by-cpu)
(helm-update (helm-top--preselect-fn)))
(defun helm-top-run-sort-by-mem ()
(interactive)
(helm-top-set-mode-line "MEM")
(setq helm-top-sort-fn 'helm-top-sort-by-mem)
(helm-update (helm-top--preselect-fn)))
(defun helm-top-run-sort-by-user ()
(interactive)
(helm-top-set-mode-line "USER")
(setq helm-top-sort-fn 'helm-top-sort-by-user)
(helm-update (helm-top--preselect-fn)))
;;; X RandR resolution change
;;
;;
;;; FIXME I do not care multi-display.
(defun helm-xrandr-info ()
"Return a pair with current X screen number and current X display name."
(with-temp-buffer
(call-process "xrandr" nil (current-buffer) nil
"--current")
(let (screen output)
(goto-char (point-min))
(save-excursion
(when (re-search-forward "\\(^Screen \\)\\([0-9]\\):" nil t)
(setq screen (match-string 2))))
(when (re-search-forward "^\\(.*\\) connected" nil t)
(setq output (match-string 1)))
(list screen output))))
(defun helm-xrandr-screen ()
"Return current X screen number."
(car (helm-xrandr-info)))
(defun helm-xrandr-output ()
"Return current X display name."
(cadr (helm-xrandr-info)))
(defvar helm-source-xrandr-change-resolution
(helm-build-sync-source "Change Resolution"
:candidates
(lambda ()
(with-temp-buffer
(call-process "xrandr" nil (current-buffer) nil
"--screen" (helm-xrandr-screen) "-q")
(goto-char 1)
(cl-loop while (re-search-forward " \\([0-9]+x[0-9]+\\)" nil t)
for mode = (match-string 1)
unless (member mode modes)
collect mode into modes
finally return modes)))
:action
(helm-make-actions "Change Resolution"
(lambda (mode)
(call-process "xrandr" nil nil nil
"--screen" (helm-xrandr-screen)
"--output" (helm-xrandr-output)
"--mode" mode)))))
;;; Emacs process
;;
;;
(defvar helm-source-emacs-process
(helm-build-sync-source "Emacs Process"
:init (lambda ()
(let (tabulated-list-use-header-line)
(list-processes--refresh)))
:candidates (lambda () (mapcar #'process-name (process-list)))
:candidate-transformer
(lambda (candidates)
(cl-loop for c in candidates
for command = (mapconcat
'identity
(process-command (get-process c)) " ")
if (and command (not (string= command ""))) collect
(cons (concat c " --> "
(mapconcat 'identity
(process-command (get-process c)) " "))
c)
else collect c))
:multiline t
:persistent-action (lambda (elm)
(delete-process (get-process elm))
(helm-delete-current-selection))
:persistent-help "Kill Process"
:action (helm-make-actions "Kill Process"
(lambda (_elm)
(cl-loop for p in (helm-marked-candidates)
do (delete-process (get-process p)))))))
;;;###autoload
(defun helm-top ()
"Preconfigured `helm' for top command."
(interactive)
(add-hook 'helm-after-update-hook 'helm-top--skip-top-line)
(unwind-protect
(helm :sources 'helm-source-top
:buffer "*helm top*" :full-frame t
:candidate-number-limit 9999
:preselect "^\\s-*[0-9]+"
:truncate-lines helm-show-action-window-other-window)
(remove-hook 'helm-after-update-hook 'helm-top--skip-top-line)))
;;;###autoload
(defun helm-list-emacs-process ()
"Preconfigured `helm' for Emacs process."
(interactive)
(helm :sources 'helm-source-emacs-process
:truncate-lines t
:buffer "*helm process*"))
;;;###autoload
(defun helm-xrandr-set ()
"Preconfigured helm for xrandr."
(interactive)
(helm :sources 'helm-source-xrandr-change-resolution
:buffer "*helm xrandr*"))
(provide 'helm-sys)
;;; helm-sys.el ends here

342
code/elpa/helm-20220822.659/helm-tags.el Normal file
View File

@ -0,0 +1,342 @@
;;; helm-tags.el --- Helm for Etags. -*- 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-utils)
(require 'helm-grep)
(defvar helm-etags-fuzzy-match)
(declare-function xref-push-marker-stack "xref")
(defgroup helm-tags nil
"Tags related Applications and libraries for Helm."
:group 'helm)
(defcustom helm-etags-tag-file-name "TAGS"
"Etags tag file name."
:type 'string)
(defcustom helm-etags-tag-file-search-limit 10
"The limit level of directory to search tag file.
Don't search tag file deeply if outside this value."
:type 'number)
(defcustom helm-etags-match-part-only 'tag
"Allow choosing the tag part of CANDIDATE in `helm-source-etags-select'.
A tag looks like this:
filename: (defun foo
You can choose matching against the tag part (i.e \"(defun foo\"),
or against the whole candidate (i.e \"(filename:5:(defun foo\")."
:type '(choice
(const :tag "Match only tag" tag)
(const :tag "Match all file+tag" all)))
(defcustom helm-etags-execute-action-at-once-if-one t
"Whether to jump straight to the selected tag if there's only
one match."
:type 'boolean)
(defgroup helm-tags-faces nil
"Customize the appearance of helm-tags faces."
:prefix "helm-"
:group 'helm-tags
:group 'helm-faces)
(defface helm-etags-file
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:foreground "Lightgoldenrod4"
:underline t))
"Face used to highlight etags filenames."
:group 'helm-tags-faces)
;;; Etags
;;
;;
(defun helm-etags-run-switch-other-window ()
"Run switch to other window action from `helm-source-etags-select'."
(interactive)
(with-helm-alive-p
(helm-exit-and-execute-action
(lambda (c)
(helm-etags-action-goto 'find-file-other-window c)))))
(put 'helm-etags-run-switch-other-window 'helm-only t)
(defun helm-etags-run-switch-other-frame ()
"Run switch to other frame action from `helm-source-etags-select'."
(interactive)
(with-helm-alive-p
(helm-exit-and-execute-action
(lambda (c)
(helm-etags-action-goto 'find-file-other-frame c)))))
(put 'helm-etags-run-switch-other-frame 'helm-only t)
(defvar helm-etags-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map helm-map)
(define-key map (kbd "M-<down>") 'helm-goto-next-file)
(define-key map (kbd "M-<up>") 'helm-goto-precedent-file)
(define-key map (kbd "C-c o") 'helm-etags-run-switch-other-window)
(define-key map (kbd "C-c C-o") 'helm-etags-run-switch-other-frame)
map)
"Keymap used in Etags.")
(defvar helm-etags-mtime-alist nil
"Store the last modification time of etags files here.")
(defvar helm-etags-cache (make-hash-table :test 'equal)
"Cache content of etags files used here for faster access.")
(defun helm-etags-get-tag-file (&optional directory)
"Return the path of etags file if found in DIRECTORY.
Look recursively in parents directorys for a
`helm-etags-tag-file-name' file."
;; Get tag file from `default-directory' or upper directory.
(let ((current-dir (helm-etags-find-tag-file-directory
(or directory default-directory))))
;; Return nil if not find tag file.
(when current-dir
(expand-file-name helm-etags-tag-file-name current-dir))))
(defun helm-etags-all-tag-files ()
"Find Etags files.
Return files from the following sources:
1) An automatically located file in the parent directories,
by `helm-etags-get-tag-file'.
2) `tags-file-name', which is commonly set by `find-tag' command.
3) `tags-table-list' which is commonly set by `visit-tags-table' command."
(helm-fast-remove-dups
(delq nil
(append (list (helm-etags-get-tag-file)
tags-file-name)
tags-table-list))
:test 'equal))
(defun helm-etags-find-tag-file-directory (current-dir)
"Try to find the directory containing tag file.
If not found in CURRENT-DIR search in upper directory."
(let ((file-exists? (lambda (dir)
(let ((tag-path (expand-file-name
helm-etags-tag-file-name dir)))
(and (stringp tag-path)
(file-regular-p tag-path)
(file-readable-p tag-path))))))
(cl-loop with count = 0
until (funcall file-exists? current-dir)
;; Return nil if outside the value of
;; `helm-etags-tag-file-search-limit'.
if (= count helm-etags-tag-file-search-limit)
do (cl-return nil)
;; Or search upper directories.
else
do (cl-incf count)
(setq current-dir (expand-file-name (concat current-dir "../")))
finally return current-dir)))
(defun helm-etags-get-header-name (_x)
"Create header name for this helm etags session."
(concat "Etags in "
(with-helm-current-buffer
(helm-etags-get-tag-file))))
(defun helm-etags-create-buffer (file)
"Create the `helm-buffer' based on contents of etags tag FILE."
(let* (max
(split (with-temp-buffer
(insert-file-contents file)
(prog1
(split-string (buffer-string) "\n" 'omit-nulls)
(setq max (line-number-at-pos (point-max))))))
(progress-reporter (make-progress-reporter "Loading tag file..." 0 max)))
(cl-loop
with fname
with cand
for i in split for count from 0
for elm = (unless (string-match "^\x0c" i) ;; "^L"
(helm-aif (string-match "\177" i) ;; "^?"
(substring i 0 it)
i))
for linum = (when (string-match "[0-9]+,?[0-9]*$" i)
(car (split-string (match-string 0 i) ",")))
do (cond ((and elm (string-match "^\\([^,]+\\),[0-9]+$" elm))
(setq fname (propertize (match-string 1 elm)
'face 'helm-etags-file)))
(elm (setq cand (format "%s:%s:%s" fname linum elm)))
(t (setq cand nil)))
when cand do (progn
(insert (propertize (concat cand "\n") 'linum linum))
(progress-reporter-update progress-reporter count)))))
(defun helm-etags-init ()
"Feed `helm-buffer' using `helm-etags-cache' or tag file.
If there is no entry in cache, create one."
(let ((tagfiles (helm-etags-all-tag-files)))
(when tagfiles
(with-current-buffer (helm-candidate-buffer 'global)
(dolist (f tagfiles)
(helm-aif (gethash f helm-etags-cache)
;; An entry is present in cache, insert it.
(insert it)
;; No entry, create a new buffer using content of tag file (slower).
(helm-etags-create-buffer f)
;; Store content of buffer in cache.
(puthash f (buffer-string) helm-etags-cache)
;; Store or set the last modification of tag file.
(helm-aif (assoc f helm-etags-mtime-alist)
;; If an entry exists modify it.
(setcdr it (helm-etags-mtime f))
;; No entry create a new one.
(cl-pushnew (cons f (helm-etags-mtime f))
helm-etags-mtime-alist
:test 'equal))))))))
(defvar helm-source-etags-select nil
"Helm source for Etags.")
(defun helm-etags-build-source ()
(helm-build-in-buffer-source "Etags"
:header-name 'helm-etags-get-header-name
:init 'helm-etags-init
:get-line 'buffer-substring
:match-part (lambda (candidate)
;; Match only the tag part of CANDIDATE
;; and not the filename.
(cl-case helm-etags-match-part-only
(tag (cl-caddr (helm-grep-split-line candidate)))
(t candidate)))
:fuzzy-match helm-etags-fuzzy-match
:help-message 'helm-etags-help-message
:keymap helm-etags-map
:action '(("Go to tag" . (lambda (c)
(helm-etags-action-goto 'find-file c)))
("Go to tag in other window" . (lambda (c)
(helm-etags-action-goto
'find-file-other-window
c)))
("Go to tag in other frame" . (lambda (c)
(helm-etags-action-goto
'find-file-other-frame
c))))
:group 'helm-tags
:persistent-help "Go to line"
:persistent-action (lambda (candidate)
(helm-etags-action-goto 'find-file candidate)
(helm-highlight-current-line))))
(defcustom helm-etags-fuzzy-match nil
"Use fuzzy matching in `helm-etags-select'."
:group 'helm-tags
:type 'boolean
:set (lambda (var val)
(set var val)
(setq helm-source-etags-select
(helm-etags-build-source))))
(defsubst helm-etags--file-from-tag (fname)
(cl-loop for ext in
(cons "" (remove "" tags-compression-info-list))
for file = (concat fname ext)
when (file-exists-p file)
return file))
(defun helm-etags-action-goto (switcher candidate)
"Helm default action to jump to an etags entry in other window."
(require 'etags)
(deactivate-mark t)
(helm-log-run-hook 'helm-goto-line-before-hook)
(let* ((split (helm-grep-split-line candidate))
(fname (cl-loop for tagf being the hash-keys of helm-etags-cache
for f = (expand-file-name
(car split) (file-name-directory tagf))
;; Try to find an existing file, possibly compressed.
when (helm-etags--file-from-tag f)
return it))
(elm (cl-caddr split))
(linum (string-to-number (cadr split))))
(if (null fname)
(error "file %s not found" fname)
(xref-push-marker-stack)
(funcall switcher fname)
(helm-goto-line linum t)
(when (search-forward elm nil t)
(goto-char (match-beginning 0))))))
(defun helm-etags-mtime (file)
"Last modification time of etags tag FILE."
(cadr (nth 5 (file-attributes file))))
(defun helm-etags-file-modified-p (file)
"Check if tag FILE have been modified in this session.
If FILE is nil return nil."
(let ((last-modif (and file
(assoc-default file helm-etags-mtime-alist))))
(and last-modif
(/= last-modif (helm-etags-mtime file)))))
;;;###autoload
(defun helm-etags-select (reinit)
"Preconfigured helm for etags.
If called with a prefix argument REINIT
or if any of the tag files have been modified, reinitialize cache.
This function aggregates three sources of tag files:
1) An automatically located file in the parent directories,
by `helm-etags-get-tag-file'.
2) `tags-file-name', which is commonly set by `find-tag' command.
3) `tags-table-list' which is commonly set by `visit-tags-table' command."
(interactive "P")
(let ((tag-files (helm-etags-all-tag-files))
(helm-execute-action-at-once-if-one
helm-etags-execute-action-at-once-if-one)
(str (if (region-active-p)
(buffer-substring-no-properties
(region-beginning) (region-end))
(thing-at-point 'symbol))))
(if (cl-notany 'file-exists-p tag-files)
(message "Error: No tag file found.\
Create with etags shell command, or visit with `find-tag' or `visit-tags-table'.")
(cl-loop for k being the hash-keys of helm-etags-cache
unless (member k tag-files)
do (remhash k helm-etags-cache))
(mapc (lambda (f)
(when (or (equal reinit '(4))
(and helm-etags-mtime-alist
(helm-etags-file-modified-p f)))
(remhash f helm-etags-cache)))
tag-files)
(unless helm-source-etags-select
(setq helm-source-etags-select
(helm-etags-build-source)))
(helm :sources 'helm-source-etags-select
:keymap helm-etags-map
:default (and (stringp str)
(if (or helm-etags-fuzzy-match
(and (eq major-mode 'haskell-mode)
(string-match "[']\\'" str)))
str
(list (concat "\\_<" str "\\_>") str)))
:buffer "*helm etags*"))))
(provide 'helm-tags)
;;; helm-tags.el ends here

336
code/elpa/helm-20220822.659/helm-types.el Normal file
View File

@ -0,0 +1,336 @@
;;; helm-types.el --- Helm types classes and methods. -*- lexical-binding: t -*-
;; Copyright (C) 2015 ~ 2020 Thierry Volpiatto
;; Author: Thierry Volpiatto
;; URL: http://github.com/emacs-helm/helm
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Code:
(require 'cl-lib)
(require 'eieio)
(eval-when-compile (require 'helm-source))
(defvar helm-map)
(defvar helm-mode-line-string)
(defvar helm-bookmark-map)
(declare-function helm-make-actions "helm-lib")
(declare-function helm-ediff-marked-buffers "helm-buffers")
(declare-function helm-make-type "helm-source")
;; Files
(defclass helm-type-file (helm-source) ()
"A class to define helm type file.")
(cl-defmethod helm-source-get-action-from-type ((object helm-type-file))
(slot-value object 'action))
(defun helm-actions-from-type-file ()
(let ((source (make-instance 'helm-type-file)))
(helm--setup-source source)
(helm-source-get-action-from-type source)))
(defvar helm-generic-files-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map helm-map)
(define-key map (kbd "C-]") 'helm-ff-run-toggle-basename)
(define-key map (kbd "C-s") 'helm-ff-run-grep)
(define-key map (kbd "M-g s") 'helm-ff-run-grep)
(define-key map (kbd "M-g z") 'helm-ff-run-zgrep)
(define-key map (kbd "M-g p") 'helm-ff-run-pdfgrep)
(define-key map (kbd "M-R") 'helm-ff-run-rename-file)
(define-key map (kbd "M-C") 'helm-ff-run-copy-file)
(define-key map (kbd "M-B") 'helm-ff-run-byte-compile-file)
(define-key map (kbd "M-L") 'helm-ff-run-load-file)
(define-key map (kbd "M-S") 'helm-ff-run-symlink-file)
(define-key map (kbd "M-H") 'helm-ff-run-hardlink-file)
(define-key map (kbd "M-D") 'helm-ff-run-delete-file)
(define-key map (kbd "C-=") 'helm-ff-run-ediff-file)
(define-key map (kbd "C-c =") 'helm-ff-run-ediff-merge-file)
(define-key map (kbd "C-c o") 'helm-ff-run-switch-other-window)
(define-key map (kbd "C-c r") 'helm-ff-run-find-file-as-root)
(define-key map (kbd "C-c C-o") 'helm-ff-run-switch-other-frame)
(define-key map (kbd "M-i") 'helm-ff-properties-persistent)
(define-key map (kbd "C-c C-x") 'helm-ff-run-open-file-externally)
(define-key map (kbd "C-c X") 'helm-ff-run-open-file-with-default-tool)
(define-key map (kbd "C-c @") 'helm-ff-run-insert-org-link)
(define-key map (kbd "C-x C-q") 'helm-ff-run-marked-files-in-dired)
(define-key map (kbd "C-c C-a") 'helm-ff-run-mail-attach-files)
map)
"Generic Keymap for files.")
(defcustom helm-type-file-actions
(helm-make-actions
"Find file" 'helm-find-file-or-marked
"Find file as root" 'helm-find-file-as-root
"Find file other window" 'helm-find-files-other-window
"Find file other frame" 'find-file-other-frame
"Open dired in file's directory" 'helm-open-dired
"Attach file(s) to mail buffer `C-c C-a'" 'helm-ff-mail-attach-files
"Marked files in dired" 'helm-marked-files-in-dired
"Grep File(s) `C-u recurse'" 'helm-find-files-grep
"Zgrep File(s) `C-u Recurse'" 'helm-ff-zgrep
"Pdfgrep File(s)" 'helm-ff-pdfgrep
"Insert as org link" 'helm-files-insert-as-org-link
"Checksum File" 'helm-ff-checksum
"Ediff File" 'helm-find-files-ediff-files
"Ediff Merge File" 'helm-find-files-ediff-merge-files
"View file" 'view-file
"Insert file" 'insert-file
"Add marked files to file-cache" 'helm-ff-cache-add-file
"Delete file(s)" 'helm-ff-delete-files
"Copy file(s) `M-C, C-u to follow'" 'helm-find-files-copy
"Rename file(s) `M-R, C-u to follow'" 'helm-find-files-rename
"Symlink files(s) `M-S, C-u to follow'" 'helm-find-files-symlink
"Relsymlink file(s) `C-u to follow'" 'helm-find-files-relsymlink
"Hardlink file(s) `M-H, C-u to follow'" 'helm-find-files-hardlink
"Open file externally (C-u to choose)" 'helm-open-file-externally
"Open file with default tool" 'helm-open-file-with-default-tool
"Find file in hex dump" 'hexl-find-file)
"Default actions for type files."
:group 'helm-files
:type '(alist :key-type string :value-type function))
(cl-defmethod helm--setup-source ((_source helm-type-file)))
(cl-defmethod helm--setup-source :before ((source helm-type-file))
(setf (slot-value source 'action) 'helm-type-file-actions)
(setf (slot-value source 'persistent-help) "Show this file")
(setf (slot-value source 'action-transformer)
'(helm-transform-file-load-el
helm-transform-file-browse-url
helm-transform-file-cache))
(setf (slot-value source 'candidate-transformer)
'(helm-skip-boring-files
helm-w32-pathname-transformer))
(setf (slot-value source 'filtered-candidate-transformer)
'helm-highlight-files)
(setf (slot-value source 'help-message) 'helm-generic-file-help-message)
(setf (slot-value source 'mode-line) (list "File(s)" helm-mode-line-string))
(setf (slot-value source 'keymap) helm-generic-files-map)
(setf (slot-value source 'group) 'helm-files))
;; Bookmarks
(defclass helm-type-bookmark (helm-source) ()
"A class to define type bookmarks.")
(defcustom helm-type-bookmark-actions
(helm-make-actions
"Jump to bookmark" 'helm-bookmark-jump
"Jump to BM other window" 'helm-bookmark-jump-other-window
"Jump to BM other frame" 'helm-bookmark-jump-other-frame
"Bookmark edit annotation" 'bookmark-edit-annotation
"Bookmark show annotation" 'bookmark-show-annotation
"Delete bookmark(s)" 'helm-delete-marked-bookmarks
"Edit Bookmark" 'helm-bookmark-edit-bookmark
"Rename bookmark" 'helm-bookmark-rename
"Relocate bookmark" 'bookmark-relocate)
"Default actions for type bookmarks."
:group 'helm-bookmark
:type '(alist :key-type string
:value-type function))
(cl-defmethod helm-source-get-action-from-type ((object helm-type-bookmark))
(slot-value object 'action))
(cl-defmethod helm--setup-source ((_source helm-type-bookmark)))
(cl-defmethod helm--setup-source :before ((source helm-type-bookmark))
(setf (slot-value source 'action) 'helm-type-bookmark-actions)
(setf (slot-value source 'keymap) helm-bookmark-map)
(setf (slot-value source 'mode-line) (list "Bookmark(s)" helm-mode-line-string))
(setf (slot-value source 'help-message) 'helm-bookmark-help-message)
(setf (slot-value source 'migemo) t)
(setf (slot-value source 'follow) 'never)
(setf (slot-value source 'group) 'helm-bookmark))
;; Buffers
(defclass helm-type-buffer (helm-source) ()
"A class to define type buffer.")
(defcustom helm-type-buffer-actions
(helm-make-actions
"Switch to buffer(s)" 'helm-buffer-switch-buffers
"Switch to buffer(s) other window `C-c o'"
'helm-buffer-switch-buffers-other-window
"Switch to buffer(s) other frame `C-c C-o'"
'helm-buffer-switch-to-buffer-other-frame
"Raise buffer frame maybe"
'helm-buffers-maybe-raise-buffer-frame
(lambda () (and (fboundp 'tab-bar-mode)
"Switch to buffer(s) other tab `C-c C-t'"))
'helm-buffers-switch-to-buffer-other-tab
"Switch to buffer at line number"
'helm-switch-to-buffer-at-linum
"Browse project `C-x C-d'"
'helm-buffers-browse-project
"Switch to shell"
'helm-buffer-switch-to-shell
"Query replace regexp `C-M-%'"
'helm-buffer-query-replace-regexp
"Query replace `M-%'" 'helm-buffer-query-replace
"View buffer" 'view-buffer
"Display buffer" 'display-buffer
"Rename buffer `M-R'" 'helm-buffers-rename-buffer
"Grep buffer(s) `M-g s' (C-u grep all buffers)"
'helm-zgrep-buffers
"Multi occur buffer(s) `C-s (C-u search also in current)'"
'helm-multi-occur-as-action
"Revert buffer(s) `M-G'" 'helm-revert-marked-buffers
"Insert buffer" 'insert-buffer
"Kill buffer(s) `M-D'" 'helm-kill-marked-buffers
"Diff with file `C-='" 'diff-buffer-with-file
"Ediff Marked buffers `C-c ='" 'helm-ediff-marked-buffers
"Ediff Merge marked buffers `M-='"
(lambda (candidate)
(helm-ediff-marked-buffers candidate t)))
"Default actions for type buffers."
:group 'helm-buffers
:type '(alist :key-type string :value-type function))
(cl-defmethod helm-source-get-action-from-type ((object helm-type-buffer))
(slot-value object 'action))
(cl-defmethod helm--setup-source ((_source helm-type-buffer)))
(cl-defmethod helm--setup-source :before ((source helm-type-buffer))
(setf (slot-value source 'action) 'helm-type-buffer-actions)
(setf (slot-value source 'persistent-help) "Show this buffer")
(setf (slot-value source 'mode-line)
;; Use default-value of `helm-mode-line-string' in case user
;; starts with a helm buffer as current-buffer otherwise the
;; local value of this helm buffer is used (bug#1517, bug#2377).
(list "Buffer(s)" (default-value 'helm-mode-line-string)))
(setf (slot-value source 'filtered-candidate-transformer)
'(helm-skip-boring-buffers
helm-buffers-sort-transformer
helm-highlight-buffers))
(setf (slot-value source 'group) 'helm-buffers))
;; Functions
(defclass helm-type-function (helm-source) ()
"A class to define helm type function.")
(defcustom helm-type-function-actions
(helm-make-actions
"Describe function" 'helm-describe-function
"Find function" 'helm-find-function
"Info lookup" 'helm-info-lookup-symbol
"Debug on entry" 'debug-on-entry
"Cancel debug on entry" 'cancel-debug-on-entry
"Trace function" 'trace-function
"Trace function (background)" 'trace-function-background
"Untrace function" 'untrace-function)
"Default actions for type functions."
:group 'helm-elisp
;; Use symbol as value type because some functions may not be
;; autoloaded (like untrace-function).
:type '(alist :key-type string :value-type symbol))
(cl-defmethod helm-source-get-action-from-type ((object helm-type-function))
(slot-value object 'action))
(defun helm-actions-from-type-function ()
(let ((source (make-instance 'helm-type-function)))
(helm--setup-source source)
(helm-source-get-action-from-type source)))
(cl-defmethod helm--setup-source ((_source helm-type-function)))
(cl-defmethod helm--setup-source :before ((source helm-type-function))
(setf (slot-value source 'action) 'helm-type-function-actions)
(setf (slot-value source 'action-transformer)
'helm-transform-function-call-interactively)
(setf (slot-value source 'candidate-transformer)
'helm-mark-interactive-functions)
(setf (slot-value source 'coerce) 'helm-symbolify))
;; Commands
(defclass helm-type-command (helm-source) ()
"A class to define helm type command.")
(defun helm-actions-from-type-command ()
(let ((source (make-instance 'helm-type-command)))
(helm--setup-source source)
(helm-source-get-action-from-type source)))
(defcustom helm-type-command-actions
(append (helm-make-actions
"Execute command" 'helm-M-x-execute-command)
(symbol-value
(helm-actions-from-type-function)))
"Default actions for type command."
:group 'helm-command
:type '(alist :key-type string :value-type symbol))
(cl-defmethod helm--setup-source ((_source helm-type-command)))
(cl-defmethod helm--setup-source :before ((source helm-type-command))
(setf (slot-value source 'action) 'helm-type-command-actions)
(setf (slot-value source 'coerce) 'helm-symbolify)
(setf (slot-value source 'persistent-action) 'helm-M-x-persistent-action)
(setf (slot-value source 'persistent-help) "Describe this command")
(setf (slot-value source 'group) 'helm-command))
;; Timers
(defclass helm-type-timers (helm-source) ()
"A class to define helm type timers.")
(defcustom helm-type-timers-actions
'(("Cancel Timer" . (lambda (_timer)
(let ((mkd (helm-marked-candidates)))
(cl-loop for timer in mkd
do (cancel-timer timer)))))
("Describe Function" . (lambda (tm)
(describe-function (timer--function tm))))
("Find Function" . (lambda (tm)
(helm-aif (timer--function tm)
(if (or (byte-code-function-p it)
(helm-subr-native-elisp-p it))
(message "Can't find anonymous function `%s'" it)
(find-function it))))))
"Default actions for type timers."
:group 'helm-elisp
:type '(alist :key-type string :value-type function))
(cl-defmethod helm--setup-source ((_source helm-type-timers)))
(cl-defmethod helm--setup-source :before ((source helm-type-timers))
(setf (slot-value source 'action) 'helm-type-timers-actions)
(setf (slot-value source 'persistent-action)
(lambda (tm)
(describe-function (timer--function tm))))
(setf (slot-value source 'persistent-help) "Describe Function")
(setf (slot-value source 'group) 'helm-elisp))
;; Builders.
(defun helm-build-type-file ()
(helm-make-type 'helm-type-file))
(defun helm-build-type-function ()
(helm-make-type 'helm-type-function))
(defun helm-build-type-command ()
(helm-make-type 'helm-type-command))
(provide 'helm-types)
;;; helm-types.el ends here

1094
code/elpa/helm-20220822.659/helm-utils.el Normal file
View File

File diff suppressed because it is too large Load Diff

126
code/elpa/helm-20220822.659/helm-x-files.el Normal file
View File

@ -0,0 +1,126 @@
;;; helm-x-files.el --- helm auxiliary functions and sources. -*- 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:
;;; Code:
(require 'helm-for-files)
;;; List of files gleaned from every dired buffer
;;
;;
(defvar dired-buffers)
(defvar directory-files-no-dot-files-regexp)
(defun helm-files-in-all-dired-candidates ()
"Return a list of files from live `dired' buffers."
(save-excursion
(cl-loop for (f . b) in dired-buffers
when (buffer-live-p b)
append (let ((dir (with-current-buffer b dired-directory)))
(if (listp dir) (cdr dir)
(directory-files f t directory-files-no-dot-files-regexp))))))
;; (dired '("~/" "~/.emacs.d/.emacs-custom.el" "~/.emacs.d/.emacs.bmk"))
(defclass helm-files-dired-source (helm-source-sync helm-type-file)
((candidates :initform #'helm-files-in-all-dired-candidates)))
(defvar helm-source-files-in-all-dired
(helm-make-source "Files in all dired buffer." 'helm-files-dired-source))
;;; session.el files
;;
;; session (http://emacs-session.sourceforge.net/) is an alternative to
;; recentf that saves recent file history and much more.
(defvar session-file-alist)
(defclass helm-source-session-class (helm-source-sync)
((candidates :initform (lambda ()
(cl-delete-if-not
(lambda (f)
(or (string-match helm-tramp-file-name-regexp f)
(file-exists-p f)))
(mapcar 'car session-file-alist))))
(keymap :initform 'helm-generic-files-map)
(help-message :initform 'helm-generic-file-help-message)
(action :initform 'helm-type-file-actions)))
(defvar helm-source-session nil
"File list from emacs-session.")
(defcustom helm-session-fuzzy-match nil
"Enable fuzzy matching in `helm-source-session' when non--nil."
:group 'helm-files
:type 'boolean
:set (lambda (var val)
(set var val)
(setq helm-source-session
(helm-make-source "Session" 'helm-source-session-class
:fuzzy-match val))))
;;; External searching file tools.
;;
;; Tracker desktop search
(defun helm-source-tracker-transformer (candidates _source)
"Return file names from tracker CANDIDATES."
;; loop through tracker candidates selecting out file:// lines
;; then select part after file:// and url decode to get straight filenames
(cl-loop for cand in candidates
when (and (stringp cand)
(string-match "\\`[[:space:]]*file://\\(.*\\)" cand))
collect (url-unhex-string (match-string 1 cand))))
(defvar helm-source-tracker-search
(helm-build-async-source "Tracker Search"
:candidates-process
(lambda ()
;; the tracker-search command has been deprecated, now invoke via tracker
;; also, disable the contextual snippets which we don't currently use
(start-process "tracker-search-process" nil
"tracker" "search"
"--disable-snippets"
"--disable-color"
"--limit=512"
helm-pattern))
;; new simplified transformer of tracker search results
:filtered-candidate-transformer #'helm-source-tracker-transformer
;;(multiline) ; https://github.com/emacs-helm/helm/issues/529
:keymap helm-generic-files-map
:action 'helm-type-file-actions
:action-transformer '(helm-transform-file-load-el
helm-transform-file-browse-url)
:requires-pattern 3)
"Source for the Tracker desktop search engine.")
;; Spotlight (MacOS X desktop search)
(defclass helm-mac-spotlight-source (helm-source-async helm-type-file)
((candidates-process :initform
(lambda ()
(start-process
"mdfind-process" nil "mdfind" helm-pattern)))
(requires-pattern :initform 3)))
(defvar helm-source-mac-spotlight
(helm-make-source "mdfind" 'helm-mac-spotlight-source)
"Source for retrieving files via Spotlight's command line utility mdfind.")
(provide 'helm-x-files)
;;; helm-x-files.el ends here

43
code/elpa/helm-20220822.659/helm.el Normal file
View File

@ -0,0 +1,43 @@
;;; helm.el --- Helm is an Emacs incremental and narrowing framework -*- lexical-binding: t -*-
;; Copyright (C) 2007 Tamas Patrovics
;; 2008 ~ 2011 rubikitch <rubikitch@ruby-lang.org>
;; 2011 ~ 2021 Thierry Volpiatto
;; This is a fork of anything.el wrote by Tamas Patrovics.
;; Authors of anything.el: Tamas Patrovics
;; rubikitch <rubikitch@ruby-lang.org>
;; Thierry Volpiatto
;; Author: Thierry Volpiatto <thievol@posteo.net>
;; Version: 3.8.7
;; URL: https://emacs-helm.github.io/helm/
;; Package-Requires: ((helm-core "3.8.7") (popup "0.5.3"))
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This is just a wrapper for helm-core.el and a place holder we
;; currently use only to hold the package's metadata in the header.
;;; Code:
(require 'helm-core)
(require 'helm-global-bindings)
(provide 'helm)
;;; helm.el ends here

264
code/elpa/helm-core-20220824.1925/helm-core-autoloads.el Normal file
View File

@ -0,0 +1,264 @@
;;; helm-core-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 "helm-core" "helm-core.el" (0 0 0 0))
;;; Generated autoloads from helm-core.el
(autoload 'helm-define-multi-key "helm-core" "\
In KEYMAP, define key sequence KEY for function list FUNCTIONS.
Each function runs sequentially for each KEY press.
If DELAY is specified, switch back to initial function of FUNCTIONS list
after DELAY seconds.
The functions in FUNCTIONS list take no args.
E.g.
(defun foo ()
(interactive)
(message \"Run foo\"))
(defun bar ()
(interactive)
(message \"Run bar\"))
(defun baz ()
(interactive)
(message \"Run baz\"))
\(helm-define-multi-key global-map (kbd \"<f5> q\") \\='(foo bar baz) 2)
Each time \"<f5> q\" is pressed, the next function is executed.
Waiting more than 2 seconds between key presses switches back to
executing the first function on the next hit.
\(fn KEYMAP KEY FUNCTIONS &optional DELAY)" nil nil)
(autoload 'helm-multi-key-defun "helm-core" "\
Define NAME as a multi-key command running FUNS.
After DELAY seconds, the FUNS list is reinitialized.
See `helm-define-multi-key'.
\(fn NAME DOCSTRING FUNS &optional DELAY)" nil t)
(function-put 'helm-multi-key-defun 'lisp-indent-function '2)
(autoload 'helm-define-key-with-subkeys "helm-core" "\
Define in MAP a KEY and SUBKEY to COMMAND.
This allows typing KEY to call COMMAND the first time and
type only SUBKEY on subsequent calls.
Arg MAP is the keymap to use, SUBKEY is the initial short
key binding to call COMMAND.
Arg OTHER-SUBKEYS is an alist specifying other short key bindings
to use once started, e.g.:
(helm-define-key-with-subkeys global-map
(kbd \"C-x v n\") ?n \\='git-gutter:next-hunk
\\='((?p . git-gutter:previous-hunk)))
In this example, `C-x v n' will run `git-gutter:next-hunk'
subsequent \"n\" will run this command again and subsequent \"p\"
will run `git-gutter:previous-hunk'.
If specified PROMPT can be displayed in minibuffer to describe
SUBKEY and OTHER-SUBKEYS. Arg EXIT-FN specifies a function to run
on exit.
For any other key pressed, run their assigned command as defined
in MAP and then exit the loop running EXIT-FN, if specified.
If DELAY an integer is specified exit after DELAY seconds.
NOTE: SUBKEY and OTHER-SUBKEYS bindings support only char syntax
and vectors, so don't use strings to define them. While defining
or executing a kbd macro no SUBKEY or OTHER-SUBKEYS are provided,
i.e. the loop is not entered after running COMMAND.
\(fn MAP KEY SUBKEY COMMAND &optional OTHER-SUBKEYS PROMPT EXIT-FN DELAY DOCSTRING)" nil nil)
(function-put 'helm-define-key-with-subkeys 'lisp-indent-function '1)
(autoload 'helm-configuration "helm-core" "\
Customize Helm." t nil)
(autoload 'helm-debug-open-last-log "helm-core" "\
Open Helm log file or buffer of last Helm session." t nil)
(autoload 'helm "helm-core" "\
Main function to execute helm sources.
PLIST is a list like
\(:key1 val1 :key2 val2 ...)
or
\(&optional sources input prompt resume preselect
buffer keymap default history allow-nest).
** Keywords
Keywords supported:
- :sources
- :input
- :prompt
- :resume
- :preselect
- :buffer
- :keymap
- :default
- :history
- :allow-nest
Extra LOCAL-VARS keywords are supported, see the \"** Other
keywords\" section below.
Basic keywords are the following:
*** :sources
One of the following:
- List of sources
- Symbol whose value is a list of sources
- Alist representing a Helm source.
- In this case the source has no name and is referenced in
`helm-sources' as a whole alist.
*** :input
Initial input of minibuffer (temporary value of `helm-pattern')
*** :prompt
Minibuffer prompt. Default value is `helm--prompt'.
*** :resume
If t, allow resumption of the previous session of this Helm
command, skipping initialization.
If \\='noresume, this instance of `helm' cannot be resumed.
*** :preselect
Initially selected candidate (string or regexp).
*** :buffer
Buffer name for this Helm session. `helm-buffer' will take this value.
*** :keymap
\[Obsolete]
Keymap used at the start of this Helm session.
It is overridden by keymaps specified in sources, and is kept
only for backward compatibility.
Keymaps should be specified in sources using the :keymap slot
instead. See `helm-source'.
This keymap is not restored by `helm-resume'.
*** :default
Default value inserted into the minibuffer with
\\<minibuffer-local-map>\\[next-history-element].
It can be a string or a list of strings, in this case
\\<minibuffer-local-map>\\[next-history-element] cycles through
the list items, starting with the first.
If nil, `thing-at-point' is used.
If `helm-maybe-use-default-as-input' is non-nil, display is
updated using this value if this value matches, otherwise it is
ignored. If :input is specified, it takes precedence on :default.
*** :history
Minibuffer input, by default, is pushed to `minibuffer-history'.
When an argument HISTORY is provided, input is pushed to
HISTORY. HISTORY should be a valid symbol.
*** :allow-nest
Allow running this Helm command in a running Helm session.
** Other keywords
Other keywords are interpreted as local variables of this Helm
session. The `helm-' prefix can be omitted. For example,
\(helm :sources \\='helm-source-buffers-list
:buffer \"*helm buffers*\"
:candidate-number-limit 10)
Starts a Helm session with the variable
`helm-candidate-number-limit' set to 10.
** Backward compatibility
For backward compatibility, positional parameters are
supported:
\(helm sources input prompt resume preselect
buffer keymap default history allow-nest)
However, the use of non-keyword args is deprecated.
\(fn &key SOURCES INPUT PROMPT RESUME PRESELECT BUFFER KEYMAP DEFAULT HISTORY ALLOW-NEST OTHER-LOCAL-VARS)" nil nil)
(autoload 'helm-cycle-resume "helm-core" "\
Cycle in `helm-buffers' list and resume when waiting more than 1.2s." t nil)
(autoload 'helm-other-buffer "helm-core" "\
Simplified Helm interface with other `helm-buffer'.
Call `helm' only with SOURCES and BUFFER as args.
\(fn SOURCES BUFFER)" nil nil)
(register-definition-prefixes "helm-core" '("helm-" "with-helm-"))
;;;***
;;;### (autoloads nil "helm-lib" "helm-lib.el" (0 0 0 0))
;;; Generated autoloads from helm-lib.el
(register-definition-prefixes "helm-lib" '("helm-" "with-helm-"))
;;;***
;;;### (autoloads nil "helm-multi-match" "helm-multi-match.el" (0
;;;;;; 0 0 0))
;;; Generated autoloads from helm-multi-match.el
(register-definition-prefixes "helm-multi-match" '("helm-m"))
;;;***
;;;### (autoloads nil "helm-source" "helm-source.el" (0 0 0 0))
;;; Generated autoloads from helm-source.el
(register-definition-prefixes "helm-source" '("helm-"))
;;;***
;;;### (autoloads nil nil ("helm-core-pkg.el") (0 0 0 0))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; coding: utf-8
;; End:
;;; helm-core-autoloads.el ends here

11
code/elpa/helm-core-20220824.1925/helm-core-pkg.el Normal file
View File

@ -0,0 +1,11 @@
(define-package "helm-core" "20220824.1925" "Development files for Helm"
'((emacs "25.1")
(async "1.9.4"))
:commit "4e99cc8ef66aac2d824c456f58abe833be26c99d" :authors
'(("Thierry Volpiatto" . "thievol@posteo.net"))
:maintainer
'("Thierry Volpiatto" . "thievol@posteo.net")
:url "https://emacs-helm.github.io/helm/")
;; Local Variables:
;; no-byte-compile: t
;; End:

7773
code/elpa/helm-core-20220824.1925/helm-core.el Normal file
View File

File diff suppressed because it is too large Load Diff

1939
code/elpa/helm-core-20220824.1925/helm-lib.el Normal file
View File

File diff suppressed because it is too large Load Diff

409
code/elpa/helm-core-20220824.1925/helm-multi-match.el Normal file
View File

@ -0,0 +1,409 @@
;;; helm-multi-match.el --- Multiple regexp matching methods for helm -*- lexical-binding: t -*-
;; Original Author: rubikitch
;; Copyright (C) 2008 ~ 2011 rubikitch
;; Copyright (C) 2011 ~ 2020 Thierry Volpiatto
;; Author: Thierry Volpiatto
;; URL: http://github.com/emacs-helm/helm
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Code:
(require 'cl-lib)
(require 'helm-lib)
(defgroup helm-multi-match nil
"Helm multi match."
:group 'helm)
(defcustom helm-mm-matching-method 'multi3
"Matching method for helm match plugin.
You can set here different methods to match candidates in helm.
Here are the possible value of this symbol and their meaning:
- multi1: Respect order, prefix of pattern must match.
- multi2: Same but with partial match.
- multi3: The best, multiple regexp match, allow negation.
- multi3p: Same but prefix must match.
Default is multi3, you should keep this for a better experience.
Note that multi1 and multi3p are incompatible with fuzzy matching
in file completion and by the way fuzzy matching will be disabled there
when these options are used."
:type '(radio :tag "Matching methods for helm"
(const :tag "Multiple regexp 1 ordered with prefix match" multi1)
(const :tag "Multiple regexp 2 ordered with partial match" multi2)
(const :tag "Multiple regexp 3 matching no order, partial, best." multi3)
(const :tag "Multiple regexp 3p matching with prefix match" multi3p))
:group 'helm-multi-match)
;; Internal
(defvar helm-mm-default-match-functions
'(helm-mm-exact-match helm-mm-match))
(defvar helm-mm-default-search-functions
'(helm-mm-exact-search helm-mm-search))
;;; Build regexps
;;
;;
(defconst helm-mm-space-regexp "\\s\\\\s-"
"Regexp to represent space itself in multiple regexp match.")
(defun helm-mm-split-pattern (pattern &optional grep-space)
"Split PATTERN if it contains spaces and return resulting list.
If spaces in PATTERN are escaped, don't split at this place.
i.e \"foo bar baz\"=> (\"foo\" \"bar\" \"baz\")
but \"foo\\ bar baz\"=> (\"foo\\s-bar\" \"baz\").
If GREP-SPACE is used translate escaped space to \"\\s\" instead of \"\\s-\"."
(split-string
;; Match spaces litteraly because candidate buffer syntax-table
;; doesn't understand "\s-" properly.
(replace-regexp-in-string
helm-mm-space-regexp
(if grep-space "\\s" "\\s-") pattern nil t)))
(defun helm-mm-1-make-regexp (pattern)
"Replace spaces in PATTERN with \".*\"."
(mapconcat 'identity (helm-mm-split-pattern pattern) ".*"))
;;; Exact match.
;;
;;
;; Internal.
(defvar helm-mm-exact-pattern-str nil)
(defvar helm-mm-exact-pattern-real nil)
(defun helm-mm-exact-get-pattern (pattern)
(unless (equal pattern helm-mm-exact-pattern-str)
(setq helm-mm-exact-pattern-str pattern
helm-mm-exact-pattern-real (concat "\n" pattern "\n")))
helm-mm-exact-pattern-real)
(cl-defun helm-mm-exact-match (candidate &optional (pattern helm-pattern))
(if case-fold-search
(progn
(setq candidate (downcase candidate)
pattern (downcase pattern))
(string= candidate pattern))
(string= candidate pattern)))
(defun helm-mm-exact-search (pattern &rest _ignore)
(and (search-forward (helm-mm-exact-get-pattern pattern) nil t)
(forward-line -1)))
;;; Prefix match
;;
;;
;; Internal
(defvar helm-mm-prefix-pattern-str nil)
(defvar helm-mm-prefix-pattern-real nil)
(defun helm-mm-prefix-get-pattern (pattern)
(unless (equal pattern helm-mm-prefix-pattern-str)
(setq helm-mm-prefix-pattern-str pattern
helm-mm-prefix-pattern-real (concat "\n" pattern)))
helm-mm-prefix-pattern-real)
(defun helm-mm-prefix-match (candidate &optional pattern)
;; In filename completion basename and basedir may be
;; quoted, unquote them for string comparison (Bug#1283).
(setq pattern (replace-regexp-in-string
"\\\\" "" (or pattern helm-pattern)))
(let ((len (length pattern)))
(and (<= len (length candidate))
(string= (substring candidate 0 len) pattern ))))
(defun helm-mm-prefix-search (pattern &rest _ignore)
(search-forward (helm-mm-prefix-get-pattern pattern) nil t))
;;; Multiple regexp patterns 1 (order is preserved / prefix).
;;
;;
;; Internal
(defvar helm-mm-1-pattern-str nil)
(defvar helm-mm-1-pattern-real nil)
(defun helm-mm-1-get-pattern (pattern)
(unless (equal pattern helm-mm-1-pattern-str)
(setq helm-mm-1-pattern-str pattern
helm-mm-1-pattern-real
(concat "^" (helm-mm-1-make-regexp pattern))))
helm-mm-1-pattern-real)
(cl-defun helm-mm-1-match (candidate &optional (pattern helm-pattern))
(string-match (helm-mm-1-get-pattern pattern) candidate))
(defun helm-mm-1-search (pattern &rest _ignore)
(re-search-forward (helm-mm-1-get-pattern pattern) nil t))
;;; Multiple regexp patterns 2 (order is preserved / partial).
;;
;;
;; Internal
(defvar helm-mm-2-pattern-str nil)
(defvar helm-mm-2-pattern-real nil)
(defun helm-mm-2-get-pattern (pattern)
(unless (equal pattern helm-mm-2-pattern-str)
(setq helm-mm-2-pattern-str pattern
helm-mm-2-pattern-real
(concat "^.*" (helm-mm-1-make-regexp pattern))))
helm-mm-2-pattern-real)
(cl-defun helm-mm-2-match (candidate &optional (pattern helm-pattern))
(string-match (helm-mm-2-get-pattern pattern) candidate))
(defun helm-mm-2-search (pattern &rest _ignore)
(re-search-forward (helm-mm-2-get-pattern pattern) nil t))
;;; Multiple regexp patterns 3 (permutation).
;;
;;
;; Internal
(defvar helm-mm--3-pattern-str nil)
(defvar helm-mm--3-pattern-list nil)
(defun helm-mm-3-get-patterns (pattern)
"Return a list of predicate/regexp cons cells.
E.g., ((identity . \"foo\") (not . \"bar\")).
If PATTERN is unchanged, don't recompute PATTERN and return the
previous value stored in `helm-mm--3-pattern-list'."
(unless (equal pattern helm-mm--3-pattern-str)
(setq helm-mm--3-pattern-str pattern
helm-mm--3-pattern-list
(helm-mm-3-get-patterns-internal pattern)))
helm-mm--3-pattern-list)
(defun helm-mm-3-get-patterns-internal (pattern)
"Return a list of predicate/regexp cons cells.
E.g., ((identity . \"foo\") (not . \"bar\"))."
(unless (string= pattern "")
(cl-loop for pat in (helm-mm-split-pattern pattern)
collect (if (char-equal ?! (aref pat 0))
(cons 'not (substring pat 1))
(cons 'identity pat)))))
(defun helm-mm-regexp-p (string)
(string-match-p "[][*+^$.?]" string))
(defvar helm-mm--match-on-diacritics nil)
(cl-defun helm-mm-3-match (candidate &optional (pattern helm-pattern))
"Check if PATTERN match CANDIDATE.
When PATTERN contains a space, it is splitted and matching is
done with the several resulting regexps against CANDIDATE.
E.g., \"bar foo\" will match \"foobar\" and \"barfoo\".
Argument PATTERN, a string, is transformed in a list of cons cell
with `helm-mm-3-get-patterns' if it contains a space.
E.g., \"foo bar\"=>((identity . \"foo\") (identity . \"bar\")).
Then each predicate of cons cell(s) is called with the regexp of
the same cons cell against CANDIDATE.
I.e. (identity (string-match \"foo\" \"foo bar\")) => t."
(let ((pat (helm-mm-3-get-patterns pattern)))
(cl-loop for (predicate . regexp) in pat
for re = (if (and (not (helm-mm-regexp-p regexp))
helm-mm--match-on-diacritics)
(char-fold-to-regexp regexp)
regexp)
always (funcall predicate
(condition-case _err
;; FIXME: Probably do nothing when
;; using fuzzy leaving the job
;; to the fuzzy fn.
(string-match re candidate)
(invalid-regexp nil))))))
(defun helm-mm-3-search-base (pattern searchfn1 searchfn2)
"Try to find PATTERN in `helm-buffer' with SEARCHFN1 and SEARCHFN2.
This is the search function for `candidates-in-buffer' enabled sources.
Use the same method as `helm-mm-3-match' except it search in buffer
instead of matching on a string.
i.e (identity (re-search-forward \"foo\" (point-at-eol) t)) => t."
(cl-loop with pat = (if (stringp pattern)
(helm-mm-3-get-patterns pattern)
pattern)
with regex = (cdar pat)
with regex1 = (if (and regex
(not (helm-mm-regexp-p regex))
helm-mm--match-on-diacritics)
(char-fold-to-regexp regex)
regex)
when (eq (caar pat) 'not) return
;; Pass the job to `helm-search-match-part'.
(prog1 (list (point-at-bol) (point-at-eol))
(forward-line 1))
while (condition-case _err
(funcall searchfn1 (or regex1 "") nil t)
(invalid-regexp nil))
for bol = (point-at-bol)
for eol = (point-at-eol)
if (cl-loop for (pred . str) in (cdr pat)
for regexp = (if (and (not (helm-mm-regexp-p str))
helm-mm--match-on-diacritics)
(char-fold-to-regexp str)
str)
always
(progn (goto-char bol)
(funcall pred (condition-case _err
(funcall searchfn2 regexp eol t)
(invalid-regexp nil)))))
do (goto-char eol) and return t
else do (goto-char eol)
finally return nil))
(defun helm-mm-3-search (pattern &rest _ignore)
(helm-mm-3-search-base
pattern 're-search-forward 're-search-forward))
(defun helm-mm-3-search-on-diacritics (pattern &rest _ignore)
(let ((helm-mm--match-on-diacritics t))
(helm-mm-3-search pattern)))
;;; mp-3 with migemo
;; Needs https://github.com/emacs-jp/migemo
;;
(defvar helm-mm--previous-migemo-info nil
"[Internal] Cache previous migemo query.")
(make-local-variable 'helm-mm--previous-migemo-info)
(declare-function migemo-get-pattern "ext:migemo.el")
(declare-function migemo-search-pattern-get "ext:migemo.el")
(define-minor-mode helm-migemo-mode
"Enable migemo in helm.
It will be available in the sources handling it,
i.e. the sources which have the slot :migemo with non--nil value."
:lighter " Hmio"
:group 'helm
:global t
(cl-assert (featurep 'migemo)
nil "No feature called migemo found, install migemo.el."))
(defun helm-mm-migemo-get-pattern (pattern)
(let ((regex (migemo-get-pattern pattern)))
(if (ignore-errors (string-match regex "") t)
(concat regex "\\|" pattern) pattern)))
(defun helm-mm-migemo-search-pattern-get (pattern)
(let ((regex (migemo-search-pattern-get pattern)))
(if (ignore-errors (string-match regex "") t)
(concat regex "\\|" pattern) pattern)))
(defun helm-mm-migemo-string-match (pattern str)
"Migemo version of `string-match'."
(unless (assoc pattern helm-mm--previous-migemo-info)
(with-helm-buffer
(setq helm-mm--previous-migemo-info
(push (cons pattern (helm-mm-migemo-get-pattern pattern))
helm-mm--previous-migemo-info))))
(string-match (assoc-default pattern helm-mm--previous-migemo-info) str))
(defun helm-mm-diacritics-string-match (pattern str)
"Check if PATTERN match STR ignoring diacritics.
If PATTERN is a regexp (i.e. `helm-mm-regexp-p') use PATTERN
unmodified, otherwise transform PATTERN with `char-fold-to-regexp'.
This function is used to search match-part of candidate in in-buffer
sources."
(string-match (if (helm-mm-regexp-p pattern)
pattern
(char-fold-to-regexp pattern))
str))
(cl-defun helm-mm-3-migemo-match (candidate &optional (pattern helm-pattern))
(and helm-migemo-mode
(cl-loop for (pred . re) in (helm-mm-3-get-patterns pattern)
always (funcall pred (helm-mm-migemo-string-match re candidate)))))
(defun helm-mm-migemo-forward (word &optional bound noerror count)
(with-helm-buffer
(unless (assoc word helm-mm--previous-migemo-info)
(setq helm-mm--previous-migemo-info
(push (cons word (if (delq 'ascii (find-charset-string word))
word
(helm-mm-migemo-search-pattern-get word)))
helm-mm--previous-migemo-info))))
(re-search-forward
(assoc-default word helm-mm--previous-migemo-info) bound noerror count))
(defun helm-mm-3-migemo-search (pattern &rest _ignore)
(and helm-migemo-mode
(helm-mm-3-search-base
pattern 'helm-mm-migemo-forward 'helm-mm-migemo-forward)))
;;; mp-3p- (multiple regexp pattern 3 with prefix search)
;;
;;
(defun helm-mm-3p-match (candidate &optional pattern)
"Check if PATTERN match CANDIDATE.
Same as `helm-mm-3-match' but only for the cdr of patterns, the car of
patterns must always match CANDIDATE prefix.
E.g. \"bar foo baz\" will match \"barfoobaz\" or \"barbazfoo\" but not
\"foobarbaz\" whereas `helm-mm-3-match' would match all."
(let* ((pat (helm-mm-3-get-patterns (or pattern helm-pattern)))
(first (car pat)))
(and (funcall (car first) (helm-mm-prefix-match candidate (cdr first)))
(cl-loop for (predicate . regexp) in (cdr pat)
always (funcall predicate (string-match regexp candidate))))))
(defun helm-mm-3p-search (pattern &rest _ignore)
(helm-mm-3-search-base
pattern 'helm-mm-prefix-search 're-search-forward))
;;; Generic multi-match/search functions
;;
;;
(cl-defun helm-mm-match (candidate &optional (pattern helm-pattern))
"Call `helm-mm-matching-method' function against CANDIDATE."
(let ((fun (cl-ecase helm-mm-matching-method
(multi1 #'helm-mm-1-match)
(multi2 #'helm-mm-2-match)
(multi3 #'helm-mm-3-match)
(multi3p #'helm-mm-3p-match))))
(funcall fun candidate pattern)))
(cl-defun helm-mm-3-match-on-diacritics (candidate &optional (pattern helm-pattern))
"Same as `helm-mm-3-match' but match on diacritics if possible."
(let ((helm-mm--match-on-diacritics t))
(helm-mm-match candidate pattern)))
(defun helm-mm-search (pattern &rest _ignore)
"Search for PATTERN with `helm-mm-matching-method' function."
(let ((fun (cl-ecase helm-mm-matching-method
(multi1 #'helm-mm-1-search)
(multi2 #'helm-mm-2-search)
(multi3 #'helm-mm-3-search)
(multi3p #'helm-mm-3p-search))))
(funcall fun pattern)))
(provide 'helm-multi-match)
;;; helm-multi-match.el ends here

1302
code/elpa/helm-core-20220824.1925/helm-source.el Normal file
View File

File diff suppressed because it is too large Load Diff

47
code/elpa/helm-ls-git-20220818.553/helm-ls-git-autoloads.el Normal file
View File

@ -0,0 +1,47 @@
;;; helm-ls-git-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 "helm-ls-git" "helm-ls-git.el" (0 0 0 0))
;;; Generated autoloads from helm-ls-git.el
(add-to-list 'auto-mode-alist '("/COMMIT_EDITMSG$" . helm-ls-git-commit-mode))
(autoload 'helm-ls-git-commit-mode "helm-ls-git" "\
Mode to edit COMMIT_EDITMSG files.
Commands:
\\{helm-ls-git-commit-mode-map}
\(fn)" t nil)
(add-to-list 'auto-mode-alist '("/git-rebase-todo$" . helm-ls-git-rebase-todo-mode))
(autoload 'helm-ls-git-rebase-todo-mode "helm-ls-git" "\
Major Mode to edit git-rebase-todo files when using git rebase -i.
Commands:
\\{helm-ls-git-rebase-todo-mode-map}
\(fn)" t nil)
(autoload 'helm-ls-git "helm-ls-git" "\
\(fn &optional ARG)" t nil)
(register-definition-prefixes "helm-ls-git" '("helm-"))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; coding: utf-8
;; End:
;;; helm-ls-git-autoloads.el ends here

2
code/elpa/helm-ls-git-20220818.553/helm-ls-git-pkg.el Normal file
View File

@ -0,0 +1,2 @@
;;; Generated package description from helm-ls-git.el -*- no-byte-compile: t -*-
(define-package "helm-ls-git" "20220818.553" "list git files." '((helm "1.7.8")) :commit "fc44fc1015bbc75d16e7d7aa5d971ff1ad85e9e1")

1979
code/elpa/helm-ls-git-20220818.553/helm-ls-git.el Normal file
View File

File diff suppressed because it is too large Load Diff

79
code/elpa/helm-projectile-20220820.826/helm-projectile-autoloads.el Normal file
View File

@ -0,0 +1,79 @@
;;; helm-projectile-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 "helm-projectile" "helm-projectile.el" (0 0
;;;;;; 0 0))
;;; Generated autoloads from helm-projectile.el
(defvar helm-projectile-fuzzy-match t "\
Enable fuzzy matching for Helm Projectile commands.
This needs to be set before loading helm-projectile.el.")
(custom-autoload 'helm-projectile-fuzzy-match "helm-projectile" t)
(autoload 'helm-projectile-find-file-dwim "helm-projectile" "\
Find file at point based on context." t nil)
(autoload 'helm-projectile-find-other-file "helm-projectile" "\
Switch between files with the same name but different extensions using Helm.
With FLEX-MATCHING, match any file that contains the base name of current file.
Other file extensions can be customized with the variable `projectile-other-file-alist'.
\(fn &optional FLEX-MATCHING)" t nil)
(autoload 'helm-projectile-on "helm-projectile" "\
Turn on `helm-projectile' key bindings." t nil)
(autoload 'helm-projectile-off "helm-projectile" "\
Turn off `helm-projectile' key bindings." t nil)
(autoload 'helm-projectile-grep "helm-projectile" "\
Helm version of `projectile-grep'.
DIR is the project root, if not set then current directory is used
\(fn &optional DIR)" t nil)
(autoload 'helm-projectile-ack "helm-projectile" "\
Helm version of projectile-ack.
\(fn &optional DIR)" t nil)
(autoload 'helm-projectile-ag "helm-projectile" "\
Helm version of `projectile-ag'.
\(fn &optional OPTIONS)" t nil)
(autoload 'helm-projectile-rg "helm-projectile" "\
Projectile version of `helm-rg'." t nil)
(autoload 'helm-projectile-toggle "helm-projectile" "\
Toggle Helm version of Projectile commands.
\(fn TOGGLE)" nil nil)
(autoload 'helm-projectile "helm-projectile" "\
Use projectile with Helm instead of ido.
With a prefix ARG invalidates the cache first.
If invoked outside of a project, displays a list of known projects to jump.
\(fn &optional ARG)" t nil)
(eval-after-load 'projectile '(progn (define-key projectile-command-map (kbd "h") #'helm-projectile)))
(register-definition-prefixes "helm-projectile" '("glob-quote" "helm-"))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; coding: utf-8
;; End:
;;; helm-projectile-autoloads.el ends here

2
code/elpa/helm-projectile-20220820.826/helm-projectile-pkg.el Normal file
View File

@ -0,0 +1,2 @@
;;; Generated package description from helm-projectile.el -*- no-byte-compile: t -*-
(define-package "helm-projectile" "20220820.826" "Helm integration for Projectile" '((helm "1.9.9") (projectile "2.2.0") (cl-lib "0.3")) :commit "5813f7286533990783546c9c39c184faa034d1f1" :authors '(("Bozhidar Batsov")) :maintainer '("Bozhidar Batsov") :keywords '("project" "convenience") :url "https://github.com/bbatsov/helm-projectile")

1126
code/elpa/helm-projectile-20220820.826/helm-projectile.el Normal file
View File

File diff suppressed because it is too large Load Diff

386
code/elpa/magit-20220821.1819/AUTHORS.md Normal file
View File

@ -0,0 +1,386 @@
The following people have contributed to Magit, including the
libraries `git-commit.el`, `magit-popup.el`, and `with-editor.el`
which are distributed as separate Elpa packages.
For statistics see https://magit.vc/stats/magit/authors.html.
Authors
-------
- Marius Vollmer
- Jonas Bernoulli
Active Maintainers
------------------
- Jonas Bernoulli
- Kyle Meyer
Former Maintainers
------------------
- Nicolas Dudebout
- Noam Postavsky
- Peter J. Weisberg
- Phil Jackson
- Rémi Vanicat
- Yann Hodique
All Contributors
----------------
- Aaron Culich
- Aaron L. Zeng
- Aaron Madlon-Kay
- Abdo Roig-Maranges
- Adam Benanti
- Adam Kruszewski
- Adam Porter
- Adam Spiers
- Adeodato Simó
- Ævar Arnfjörð Bjarmason
- Alan Falloon
- Alban Gruin
- Aleksey Uimanov
- Alexander Gramiak
- Alexander Miller
- Alex Branham
- Alex Dunn
- Alexey Voinov
- Alex Kost
- Alex Ott
- Allen Li
- Andreas Fuchs
- Andreas Liljeqvist
- Andreas Rottmann
- Andrei Chițu
- Andrew Eggenberger
- Andrew Kirkpatrick
- Andrew Psaltis
- Andrew Schwartzmeyer
- Andrey Smirnov
- Andriy Kmit'
- Andy Sawyer
- Angel de Vicente
- Aria Edmonds
- Arialdo Martini
- Arnau Roig Ninerola
- Ashlynn Anderson
- Barak A. Pearlmutter
- Bar Magal
- Bart Bakker
- Basil L. Contovounesios
- Bastian Beischer
- Bastian Beranek
- Benjamin Motz
- Ben North
- Ben Walton
- Bob Uhl
- Boruch Baum
- Bradley Wright
- Brandon W Maister
- Brennan Vincent
- Brian Leung
- Brian Warner
- Bryan Shell
- Buster Copley
- Cameron Chaparro
- Carl Lieberman
- Chillar Anand
- Chris Bernard
- Chris Done
- Chris LaRose
- Chris Moore
- Chris Ring
- Chris Shoemaker
- Christian Dietrich
- Christian Kluge
- Christophe Junke
- Christopher Monsanto
- Clément Pit-Claudel
- Cornelius Mika
- Craig Andera
- Dale Hagglund
- Damien Cassou
- Dan Davison
- Dan Erikson
- Daniel Brockman
- Daniel Farina
- Daniel Fleischer
- Daniel Gröber
- Daniel Hackney
- Daniel Kraus
- Daniel Mai
- Daniel Martín
- Daniel Nagy
- Dan Kessler
- Dan LaManna
- Danny Zhu
- Dato Simó
- David Abrahams
- David Ellison
- David Hull
- David L. Rager
- David Wallin
- Dean Kariniemi
- Dennis Paskorz
- Divye Kapoor
- Dominique Quatravaux
- Duianto Vebotci
- Eli Barzilay
- Eric
- Eric Davis
- Eric Prud'hommeaux
- Eric Schulte
- Erik Anderson
- Evan Torrie
- Evgkeni Sampelnikof
- Eyal Lotem
- Fabian Wiget
- Felix Geller
- Felix Yan
- Feng Li
- Florian Ragwitz
- Franklin Delehelle
- Frédéric Giquel
- Fritz Grabo
- Fritz Stelzer
- Geoff Shannon
- George Kadianakis
- Géza Herman
- Graham Clark
- Graham Dobbins
- Greg A. Woods
- Greg Lucas
- Gregory Heytings
- Greg Sexton
- Greg Steuck
- Guillaume Martres
- Hannu Koivisto
- Hans-Peter Deifel
- Hussein Ait-Lahcen
- Ian Eure
- Ian Milligan
- Ilya Grigoriev
- Ingmar Sittl
- Ingo Lohmar
- Ioan-Adrian Ratiu
- Ivan Brennan
- Jan Tatarik
- Jasper St. Pierre
- Jean-Louis Giordano
- Jeff Bellegarde
- Jeff Dairiki
- Jeremy Meng
- Jesse Alama
- Jim Blandy
- Joakim Jalap
- Johannes Altmanninger
- Johann Klähn
- John Mastro
- John Morris
- John Wiegley
- Jonas Bernoulli
- Jonas Galvão Xavier
- Jonathan Arnett
- Jonathan del Strother
- Jonathan Leech-Pepin
- Jonathan Roes
- Jonathon McKitrick
- Jon Vanderwijk
- Jordan Galby
- Jordan Greenberg
- Jorge Israel Peña
- Josh Elsasser
- Josiah Schwab
- Julien Danjou
- Justin Burkett
- Justin Caratzas
- Justin Guenther
- Justin Thomas
- Kan-Ru Chen
- Kenny Ballou
- Keshav Kini
- Kevin Brubeck Unhammer
- Kevin J. Foley
- Kévin Le Gouguec
- Kimberly Wolk
- Knut Olav Bøhmer
- Kyle Meyer
- Laurent Laffont
- Laverne Schrock
- Leandro Facchinetti
- Lele Gaifax
- Leo Liu
- Leonardo Etcheverry
- Leo Vivier
- Lingchao Xin
- Lin Sun
- Li-Yun Chang
- Lluís Vilanova
- Loic Dachary
- Louis Roché
- Luís Oliveira
- Luke Amdor
- Magnus Malm
- Mak Kolybabi
- Manuel Vázquez Acosta
- Marcel Wolf
- Marc Herbert
- Marcin Bachry
- Marco Craveiro
- Marco Wahl
- Marc Sherry
- Marian Schubert
- Mario Rodas
- Marius Vollmer
- Mark Hepburn
- Mark Karpov
- Mark Oteiza
- Martin Joerg
- Martin Polden
- Matthew Fluet
- Matthew Kraai
- Matthieu Hauglustaine
- Matus Goljer
- Maxim Cournoyer
- Michael Fogleman
- Michael Griffiths
- Michael Heerdegen
- Michal Sojka
- Miciah Masters
- Miles Bader
- Miloš Mošić
- Mitchel Humpherys
- Moritz Bunkus
- Naoya Yamashita
- Natalie Weizenbaum
- Nguyễn Tuấn Anh
- Nic Ferier
- Nick Alcock
- Nick Alexander
- Nick Dimiduk
- Nicklas Lindgren
- Nicolas Dudebout
- Nicolas Petton
- Nicolas Richard
- Nikolay Martynov
- Noam Postavsky
- N. Troy de Freitas
- Ola x Nilsson
- Ole Arndt
- Oleh Krehel
- Orivej Desh
- Óscar Fuentes
- Pancho Horrillo
- Paul Stadig
- Pavel Holejsovsky
- Pekka Pessi
- Peter Eisentraut
- Peter Jaros
- Peter J. Weisberg
- Peter Vasil
- Philippe Cavalaria
- Philippe Vaucher
- Philipp Fehre
- Philipp Haselwarter
- Philipp Stephani
- Philip Weaver
- Phil Jackson
- Phil Sainty
- Pierre Neidhardt
- Pieter Praet
- Prathamesh Sonpatki
- Pritam Baral
- rabio
- Radon Rosborough
- Rafael Laboissiere
- Raimon Grau
- Ramkumar Ramachandra
- Remco van 't Veer
- Rémi Vanicat
- René Stadler
- Richard Kim
- Robert Boone
- Robert Irelan
- Robin Green
- Roey Darwish Dror
- Roger Crew
- Romain Francoise
- Ron Parker
- Roy Crihfield
- Rüdiger Sonderfeld
- Russell Black
- Ryan C. Thompson
- Sam Cedarbaum
- Samuel Bronson
- Samuel W. Flint
- Sanjoy Das
- Sean Allred
- Sean Bryant
- Sean Whitton
- Sebastian Wiesner
- Sébastien Gross
- Seong-Kook Shin
- Sergey Pashinin
- Sergey Vinokurov
- Servilio Afre Puentes
- Shuguang Sun
- Siavash Askari Nasr
- Silent Sphere
- Simon Pintarelli
- Stefan Kangas
- Štěpán Němec
- Steven Chow
- Steven E. Harris
- Steven Thomas
- Steven Vancoillie
- Steve Purcell
- Suhail Shergill
- Sylvain Rousseau
- Syohei Yoshida
- Szunti
- Takafumi Arakaki
- Tassilo Horn
- TEC
- Teemu Likonen
- Teruki Shigitani
- Thierry Volpiatto
- Thomas A Caswell
- Thomas Fini Hansen
- Thomas Frössman
- Thomas Jost
- Thomas Riccardi
- Tibor Simko
- Timo Juhani Lindfors
- Tim Perkins
- Tim Wraight
- Ting-Yu Lin
- Tom Feist
- Toon Claes
- Topi Miettinen
- Troy Hinckley
- Tsuyoshi Kitamoto
- Tunc Uzlu
- Vineet Naik
- Vitaly Ostashov
- Vladimir Ivanov
- Vladimir Panteleev
- Vladimir Sedach
- Wei Huang
- Wilfred Hughes
- Win Treese
- Wojciech Siewierski
- Wouter Bolsterlee
- Xavier Noria
- Xu Chunyang
- Yann Herklotz
- Yann Hodique
- Ynilu
- York Zhao
- Yuichi Higashi
- Yuri Khan
- Zach Latta
- zakora
- Zhu Zihao
- zilongshanren

674
code/elpa/magit-20220821.1819/LICENSE Normal file
View File

@ -0,0 +1,674 @@
GNU GENERAL PUBLIC LICENSE
Version 3, 29 June 2007
Copyright (C) 2007 Free Software Foundation, Inc. <https://fsf.org/>
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
Preamble
The GNU General Public License is a free, copyleft license for
software and other kinds of works.
The licenses for most software and other practical works are designed
to take away your freedom to share and change the works. By contrast,
the GNU General Public License is intended to guarantee your freedom to
share and change all versions of a program--to make sure it remains free
software for all its users. We, the Free Software Foundation, use the
GNU General Public License for most of our software; it applies also to
any other work released this way by its authors. You can apply it to
your programs, too.
When we speak of free software, we are referring to freedom, not
price. Our General Public Licenses are designed to make sure that you
have the freedom to distribute copies of free software (and charge for
them if you wish), that you receive source code or can get it if you
want it, that you can change the software or use pieces of it in new
free programs, and that you know you can do these things.
To protect your rights, we need to prevent others from denying you
these rights or asking you to surrender the rights. Therefore, you have
certain responsibilities if you distribute copies of the software, or if
you modify it: responsibilities to respect the freedom of others.
For example, if you distribute copies of such a program, whether
gratis or for a fee, you must pass on to the recipients the same
freedoms that you received. You must make sure that they, too, receive
or can get the source code. And you must show them these terms so they
know their rights.
Developers that use the GNU GPL protect your rights with two steps:
(1) assert copyright on the software, and (2) offer you this License
giving you legal permission to copy, distribute and/or modify it.
For the developers' and authors' protection, the GPL clearly explains
that there is no warranty for this free software. For both users' and
authors' sake, the GPL requires that modified versions be marked as
changed, so that their problems will not be attributed erroneously to
authors of previous versions.
Some devices are designed to deny users access to install or run
modified versions of the software inside them, although the manufacturer
can do so. This is fundamentally incompatible with the aim of
protecting users' freedom to change the software. The systematic
pattern of such abuse occurs in the area of products for individuals to
use, which is precisely where it is most unacceptable. Therefore, we
have designed this version of the GPL to prohibit the practice for those
products. If such problems arise substantially in other domains, we
stand ready to extend this provision to those domains in future versions
of the GPL, as needed to protect the freedom of users.
Finally, every program is threatened constantly by software patents.
States should not allow patents to restrict development and use of
software on general-purpose computers, but in those that do, we wish to
avoid the special danger that patents applied to a free program could
make it effectively proprietary. To prevent this, the GPL assures that
patents cannot be used to render the program non-free.
The precise terms and conditions for copying, distribution and
modification follow.
TERMS AND CONDITIONS
0. Definitions.
"This License" refers to version 3 of the GNU General Public License.
"Copyright" also means copyright-like laws that apply to other kinds of
works, such as semiconductor masks.
"The Program" refers to any copyrightable work licensed under this
License. Each licensee is addressed as "you". "Licensees" and
"recipients" may be individuals or organizations.
To "modify" a work means to copy from or adapt all or part of the work
in a fashion requiring copyright permission, other than the making of an
exact copy. The resulting work is called a "modified version" of the
earlier work or a work "based on" the earlier work.
A "covered work" means either the unmodified Program or a work based
on the Program.
To "propagate" a work means to do anything with it that, without
permission, would make you directly or secondarily liable for
infringement under applicable copyright law, except executing it on a
computer or modifying a private copy. Propagation includes copying,
distribution (with or without modification), making available to the
public, and in some countries other activities as well.
To "convey" a work means any kind of propagation that enables other
parties to make or receive copies. Mere interaction with a user through
a computer network, with no transfer of a copy, is not conveying.
An interactive user interface displays "Appropriate Legal Notices"
to the extent that it includes a convenient and prominently visible
feature that (1) displays an appropriate copyright notice, and (2)
tells the user that there is no warranty for the work (except to the
extent that warranties are provided), that licensees may convey the
work under this License, and how to view a copy of this License. If
the interface presents a list of user commands or options, such as a
menu, a prominent item in the list meets this criterion.
1. Source Code.
The "source code" for a work means the preferred form of the work
for making modifications to it. "Object code" means any non-source
form of a work.
A "Standard Interface" means an interface that either is an official
standard defined by a recognized standards body, or, in the case of
interfaces specified for a particular programming language, one that
is widely used among developers working in that language.
The "System Libraries" of an executable work include anything, other
than the work as a whole, that (a) is included in the normal form of
packaging a Major Component, but which is not part of that Major
Component, and (b) serves only to enable use of the work with that
Major Component, or to implement a Standard Interface for which an
implementation is available to the public in source code form. A
"Major Component", in this context, means a major essential component
(kernel, window system, and so on) of the specific operating system
(if any) on which the executable work runs, or a compiler used to
produce the work, or an object code interpreter used to run it.
The "Corresponding Source" for a work in object code form means all
the source code needed to generate, install, and (for an executable
work) run the object code and to modify the work, including scripts to
control those activities. However, it does not include the work's
System Libraries, or general-purpose tools or generally available free
programs which are used unmodified in performing those activities but
which are not part of the work. For example, Corresponding Source
includes interface definition files associated with source files for
the work, and the source code for shared libraries and dynamically
linked subprograms that the work is specifically designed to require,
such as by intimate data communication or control flow between those
subprograms and other parts of the work.
The Corresponding Source need not include anything that users
can regenerate automatically from other parts of the Corresponding
Source.
The Corresponding Source for a work in source code form is that
same work.
2. Basic Permissions.
All rights granted under this License are granted for the term of
copyright on the Program, and are irrevocable provided the stated
conditions are met. This License explicitly affirms your unlimited
permission to run the unmodified Program. The output from running a
covered work is covered by this License only if the output, given its
content, constitutes a covered work. This License acknowledges your
rights of fair use or other equivalent, as provided by copyright law.
You may make, run and propagate covered works that you do not
convey, without conditions so long as your license otherwise remains
in force. You may convey covered works to others for the sole purpose
of having them make modifications exclusively for you, or provide you
with facilities for running those works, provided that you comply with
the terms of this License in conveying all material for which you do
not control copyright. Those thus making or running the covered works
for you must do so exclusively on your behalf, under your direction
and control, on terms that prohibit them from making any copies of
your copyrighted material outside their relationship with you.
Conveying under any other circumstances is permitted solely under
the conditions stated below. Sublicensing is not allowed; section 10
makes it unnecessary.
3. Protecting Users' Legal Rights From Anti-Circumvention Law.
No covered work shall be deemed part of an effective technological
measure under any applicable law fulfilling obligations under article
11 of the WIPO copyright treaty adopted on 20 December 1996, or
similar laws prohibiting or restricting circumvention of such
measures.
When you convey a covered work, you waive any legal power to forbid
circumvention of technological measures to the extent such circumvention
is effected by exercising rights under this License with respect to
the covered work, and you disclaim any intention to limit operation or
modification of the work as a means of enforcing, against the work's
users, your or third parties' legal rights to forbid circumvention of
technological measures.
4. Conveying Verbatim Copies.
You may convey verbatim copies of the Program's source code as you
receive it, in any medium, provided that you conspicuously and
appropriately publish on each copy an appropriate copyright notice;
keep intact all notices stating that this License and any
non-permissive terms added in accord with section 7 apply to the code;
keep intact all notices of the absence of any warranty; and give all
recipients a copy of this License along with the Program.
You may charge any price or no price for each copy that you convey,
and you may offer support or warranty protection for a fee.
5. Conveying Modified Source Versions.
You may convey a work based on the Program, or the modifications to
produce it from the Program, in the form of source code under the
terms of section 4, provided that you also meet all of these conditions:
a) The work must carry prominent notices stating that you modified
it, and giving a relevant date.
b) The work must carry prominent notices stating that it is
released under this License and any conditions added under section
7. This requirement modifies the requirement in section 4 to
"keep intact all notices".
c) You must license the entire work, as a whole, under this
License to anyone who comes into possession of a copy. This
License will therefore apply, along with any applicable section 7
additional terms, to the whole of the work, and all its parts,
regardless of how they are packaged. This License gives no
permission to license the work in any other way, but it does not
invalidate such permission if you have separately received it.
d) If the work has interactive user interfaces, each must display
Appropriate Legal Notices; however, if the Program has interactive
interfaces that do not display Appropriate Legal Notices, your
work need not make them do so.
A compilation of a covered work with other separate and independent
works, which are not by their nature extensions of the covered work,
and which are not combined with it such as to form a larger program,
in or on a volume of a storage or distribution medium, is called an
"aggregate" if the compilation and its resulting copyright are not
used to limit the access or legal rights of the compilation's users
beyond what the individual works permit. Inclusion of a covered work
in an aggregate does not cause this License to apply to the other
parts of the aggregate.
6. Conveying Non-Source Forms.
You may convey a covered work in object code form under the terms
of sections 4 and 5, provided that you also convey the
machine-readable Corresponding Source under the terms of this License,
in one of these ways:
a) Convey the object code in, or embodied in, a physical product
(including a physical distribution medium), accompanied by the
Corresponding Source fixed on a durable physical medium
customarily used for software interchange.
b) Convey the object code in, or embodied in, a physical product
(including a physical distribution medium), accompanied by a
written offer, valid for at least three years and valid for as
long as you offer spare parts or customer support for that product
model, to give anyone who possesses the object code either (1) a
copy of the Corresponding Source for all the software in the
product that is covered by this License, on a durable physical
medium customarily used for software interchange, for a price no
more than your reasonable cost of physically performing this
conveying of source, or (2) access to copy the
Corresponding Source from a network server at no charge.
c) Convey individual copies of the object code with a copy of the
written offer to provide the Corresponding Source. This
alternative is allowed only occasionally and noncommercially, and
only if you received the object code with such an offer, in accord
with subsection 6b.
d) Convey the object code by offering access from a designated
place (gratis or for a charge), and offer equivalent access to the
Corresponding Source in the same way through the same place at no
further charge. You need not require recipients to copy the
Corresponding Source along with the object code. If the place to
copy the object code is a network server, the Corresponding Source
may be on a different server (operated by you or a third party)
that supports equivalent copying facilities, provided you maintain
clear directions next to the object code saying where to find the
Corresponding Source. Regardless of what server hosts the
Corresponding Source, you remain obligated to ensure that it is
available for as long as needed to satisfy these requirements.
e) Convey the object code using peer-to-peer transmission, provided
you inform other peers where the object code and Corresponding
Source of the work are being offered to the general public at no
charge under subsection 6d.
A separable portion of the object code, whose source code is excluded
from the Corresponding Source as a System Library, need not be
included in conveying the object code work.
A "User Product" is either (1) a "consumer product", which means any
tangible personal property which is normally used for personal, family,
or household purposes, or (2) anything designed or sold for incorporation
into a dwelling. In determining whether a product is a consumer product,
doubtful cases shall be resolved in favor of coverage. For a particular
product received by a particular user, "normally used" refers to a
typical or common use of that class of product, regardless of the status
of the particular user or of the way in which the particular user
actually uses, or expects or is expected to use, the product. A product
is a consumer product regardless of whether the product has substantial
commercial, industrial or non-consumer uses, unless such uses represent
the only significant mode of use of the product.
"Installation Information" for a User Product means any methods,
procedures, authorization keys, or other information required to install
and execute modified versions of a covered work in that User Product from
a modified version of its Corresponding Source. The information must
suffice to ensure that the continued functioning of the modified object
code is in no case prevented or interfered with solely because
modification has been made.
If you convey an object code work under this section in, or with, or
specifically for use in, a User Product, and the conveying occurs as
part of a transaction in which the right of possession and use of the
User Product is transferred to the recipient in perpetuity or for a
fixed term (regardless of how the transaction is characterized), the
Corresponding Source conveyed under this section must be accompanied
by the Installation Information. But this requirement does not apply
if neither you nor any third party retains the ability to install
modified object code on the User Product (for example, the work has
been installed in ROM).
The requirement to provide Installation Information does not include a
requirement to continue to provide support service, warranty, or updates
for a work that has been modified or installed by the recipient, or for
the User Product in which it has been modified or installed. Access to a
network may be denied when the modification itself materially and
adversely affects the operation of the network or violates the rules and
protocols for communication across the network.
Corresponding Source conveyed, and Installation Information provided,
in accord with this section must be in a format that is publicly
documented (and with an implementation available to the public in
source code form), and must require no special password or key for
unpacking, reading or copying.
7. Additional Terms.
"Additional permissions" are terms that supplement the terms of this
License by making exceptions from one or more of its conditions.
Additional permissions that are applicable to the entire Program shall
be treated as though they were included in this License, to the extent
that they are valid under applicable law. If additional permissions
apply only to part of the Program, that part may be used separately
under those permissions, but the entire Program remains governed by
this License without regard to the additional permissions.
When you convey a copy of a covered work, you may at your option
remove any additional permissions from that copy, or from any part of
it. (Additional permissions may be written to require their own
removal in certain cases when you modify the work.) You may place
additional permissions on material, added by you to a covered work,
for which you have or can give appropriate copyright permission.
Notwithstanding any other provision of this License, for material you
add to a covered work, you may (if authorized by the copyright holders of
that material) supplement the terms of this License with terms:
a) Disclaiming warranty or limiting liability differently from the
terms of sections 15 and 16 of this License; or
b) Requiring preservation of specified reasonable legal notices or
author attributions in that material or in the Appropriate Legal
Notices displayed by works containing it; or
c) Prohibiting misrepresentation of the origin of that material, or
requiring that modified versions of such material be marked in
reasonable ways as different from the original version; or
d) Limiting the use for publicity purposes of names of licensors or
authors of the material; or
e) Declining to grant rights under trademark law for use of some
trade names, trademarks, or service marks; or
f) Requiring indemnification of licensors and authors of that
material by anyone who conveys the material (or modified versions of
it) with contractual assumptions of liability to the recipient, for
any liability that these contractual assumptions directly impose on
those licensors and authors.
All other non-permissive additional terms are considered "further
restrictions" within the meaning of section 10. If the Program as you
received it, or any part of it, contains a notice stating that it is
governed by this License along with a term that is a further
restriction, you may remove that term. If a license document contains
a further restriction but permits relicensing or conveying under this
License, you may add to a covered work material governed by the terms
of that license document, provided that the further restriction does
not survive such relicensing or conveying.
If you add terms to a covered work in accord with this section, you
must place, in the relevant source files, a statement of the
additional terms that apply to those files, or a notice indicating
where to find the applicable terms.
Additional terms, permissive or non-permissive, may be stated in the
form of a separately written license, or stated as exceptions;
the above requirements apply either way.
8. Termination.
You may not propagate or modify a covered work except as expressly
provided under this License. Any attempt otherwise to propagate or
modify it is void, and will automatically terminate your rights under
this License (including any patent licenses granted under the third
paragraph of section 11).
However, if you cease all violation of this License, then your
license from a particular copyright holder is reinstated (a)
provisionally, unless and until the copyright holder explicitly and
finally terminates your license, and (b) permanently, if the copyright
holder fails to notify you of the violation by some reasonable means
prior to 60 days after the cessation.
Moreover, your license from a particular copyright holder is
reinstated permanently if the copyright holder notifies you of the
violation by some reasonable means, this is the first time you have
received notice of violation of this License (for any work) from that
copyright holder, and you cure the violation prior to 30 days after
your receipt of the notice.
Termination of your rights under this section does not terminate the
licenses of parties who have received copies or rights from you under
this License. If your rights have been terminated and not permanently
reinstated, you do not qualify to receive new licenses for the same
material under section 10.
9. Acceptance Not Required for Having Copies.
You are not required to accept this License in order to receive or
run a copy of the Program. Ancillary propagation of a covered work
occurring solely as a consequence of using peer-to-peer transmission
to receive a copy likewise does not require acceptance. However,
nothing other than this License grants you permission to propagate or
modify any covered work. These actions infringe copyright if you do
not accept this License. Therefore, by modifying or propagating a
covered work, you indicate your acceptance of this License to do so.
10. Automatic Licensing of Downstream Recipients.
Each time you convey a covered work, the recipient automatically
receives a license from the original licensors, to run, modify and
propagate that work, subject to this License. You are not responsible
for enforcing compliance by third parties with this License.
An "entity transaction" is a transaction transferring control of an
organization, or substantially all assets of one, or subdividing an
organization, or merging organizations. If propagation of a covered
work results from an entity transaction, each party to that
transaction who receives a copy of the work also receives whatever
licenses to the work the party's predecessor in interest had or could
give under the previous paragraph, plus a right to possession of the
Corresponding Source of the work from the predecessor in interest, if
the predecessor has it or can get it with reasonable efforts.
You may not impose any further restrictions on the exercise of the
rights granted or affirmed under this License. For example, you may
not impose a license fee, royalty, or other charge for exercise of
rights granted under this License, and you may not initiate litigation
(including a cross-claim or counterclaim in a lawsuit) alleging that
any patent claim is infringed by making, using, selling, offering for
sale, or importing the Program or any portion of it.
11. Patents.
A "contributor" is a copyright holder who authorizes use under this
License of the Program or a work on which the Program is based. The
work thus licensed is called the contributor's "contributor version".
A contributor's "essential patent claims" are all patent claims
owned or controlled by the contributor, whether already acquired or
hereafter acquired, that would be infringed by some manner, permitted
by this License, of making, using, or selling its contributor version,
but do not include claims that would be infringed only as a
consequence of further modification of the contributor version. For
purposes of this definition, "control" includes the right to grant
patent sublicenses in a manner consistent with the requirements of
this License.
Each contributor grants you a non-exclusive, worldwide, royalty-free
patent license under the contributor's essential patent claims, to
make, use, sell, offer for sale, import and otherwise run, modify and
propagate the contents of its contributor version.
In the following three paragraphs, a "patent license" is any express
agreement or commitment, however denominated, not to enforce a patent
(such as an express permission to practice a patent or covenant not to
sue for patent infringement). To "grant" such a patent license to a
party means to make such an agreement or commitment not to enforce a
patent against the party.
If you convey a covered work, knowingly relying on a patent license,
and the Corresponding Source of the work is not available for anyone
to copy, free of charge and under the terms of this License, through a
publicly available network server or other readily accessible means,
then you must either (1) cause the Corresponding Source to be so
available, or (2) arrange to deprive yourself of the benefit of the
patent license for this particular work, or (3) arrange, in a manner
consistent with the requirements of this License, to extend the patent
license to downstream recipients. "Knowingly relying" means you have
actual knowledge that, but for the patent license, your conveying the
covered work in a country, or your recipient's use of the covered work
in a country, would infringe one or more identifiable patents in that
country that you have reason to believe are valid.
If, pursuant to or in connection with a single transaction or
arrangement, you convey, or propagate by procuring conveyance of, a
covered work, and grant a patent license to some of the parties
receiving the covered work authorizing them to use, propagate, modify
or convey a specific copy of the covered work, then the patent license
you grant is automatically extended to all recipients of the covered
work and works based on it.
A patent license is "discriminatory" if it does not include within
the scope of its coverage, prohibits the exercise of, or is
conditioned on the non-exercise of one or more of the rights that are
specifically granted under this License. You may not convey a covered
work if you are a party to an arrangement with a third party that is
in the business of distributing software, under which you make payment
to the third party based on the extent of your activity of conveying
the work, and under which the third party grants, to any of the
parties who would receive the covered work from you, a discriminatory
patent license (a) in connection with copies of the covered work
conveyed by you (or copies made from those copies), or (b) primarily
for and in connection with specific products or compilations that
contain the covered work, unless you entered into that arrangement,
or that patent license was granted, prior to 28 March 2007.
Nothing in this License shall be construed as excluding or limiting
any implied license or other defenses to infringement that may
otherwise be available to you under applicable patent law.
12. No Surrender of Others' Freedom.
If conditions are imposed on you (whether by court order, agreement or
otherwise) that contradict the conditions of this License, they do not
excuse you from the conditions of this License. If you cannot convey a
covered work so as to satisfy simultaneously your obligations under this
License and any other pertinent obligations, then as a consequence you may
not convey it at all. For example, if you agree to terms that obligate you
to collect a royalty for further conveying from those to whom you convey
the Program, the only way you could satisfy both those terms and this
License would be to refrain entirely from conveying the Program.
13. Use with the GNU Affero General Public License.
Notwithstanding any other provision of this License, you have
permission to link or combine any covered work with a work licensed
under version 3 of the GNU Affero General Public License into a single
combined work, and to convey the resulting work. The terms of this
License will continue to apply to the part which is the covered work,
but the special requirements of the GNU Affero General Public License,
section 13, concerning interaction through a network will apply to the
combination as such.
14. Revised Versions of this License.
The Free Software Foundation may publish revised and/or new versions of
the GNU General Public License from time to time. Such new versions will
be similar in spirit to the present version, but may differ in detail to
address new problems or concerns.
Each version is given a distinguishing version number. If the
Program specifies that a certain numbered version of the GNU General
Public License "or any later version" applies to it, you have the
option of following the terms and conditions either of that numbered
version or of any later version published by the Free Software
Foundation. If the Program does not specify a version number of the
GNU General Public License, you may choose any version ever published
by the Free Software Foundation.
If the Program specifies that a proxy can decide which future
versions of the GNU General Public License can be used, that proxy's
public statement of acceptance of a version permanently authorizes you
to choose that version for the Program.
Later license versions may give you additional or different
permissions. However, no additional obligations are imposed on any
author or copyright holder as a result of your choosing to follow a
later version.
15. Disclaimer of Warranty.
THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
16. Limitation of Liability.
IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
SUCH DAMAGES.
17. Interpretation of Sections 15 and 16.
If the disclaimer of warranty and limitation of liability provided
above cannot be given local legal effect according to their terms,
reviewing courts shall apply local law that most closely approximates
an absolute waiver of all civil liability in connection with the
Program, unless a warranty or assumption of liability accompanies a
copy of the Program in return for a fee.
END OF TERMS AND CONDITIONS
How to Apply These Terms to Your New Programs
If you develop a new program, and you want it to be of the greatest
possible use to the public, the best way to achieve this is to make it
free software which everyone can redistribute and change under these terms.
To do so, attach the following notices to the program. It is safest
to attach them to the start of each source file to most effectively
state the exclusion of warranty; and each file should have at least
the "copyright" line and a pointer to where the full notice is found.
<one line to give the program's name and a brief idea of what it does.>
Copyright (C) <year> <name of author>
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/>.
Also add information on how to contact you by electronic and paper mail.
If the program does terminal interaction, make it output a short
notice like this when it starts in an interactive mode:
<program> Copyright (C) <year> <name of author>
This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the appropriate
parts of the General Public License. Of course, your program's commands
might be different; for a GUI interface, you would use an "about box".
You should also get your employer (if you work as a programmer) or school,
if any, to sign a "copyright disclaimer" for the program, if necessary.
For more information on this, and how to apply and follow the GNU GPL, see
<https://www.gnu.org/licenses/>.
The GNU General Public License does not permit incorporating your program
into proprietary programs. If your program is a subroutine library, you
may consider it more useful to permit linking proprietary applications with
the library. If this is what you want to do, use the GNU Lesser General
Public License instead of this License. But first, please read
<https://www.gnu.org/licenses/why-not-lgpl.html>.

18
code/elpa/magit-20220821.1819/dir Normal file
View 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
* Magit: (magit). Using Git from Emacs with Magit.

861
code/elpa/magit-20220821.1819/git-rebase.el Normal file
View File

@ -0,0 +1,861 @@
;;; git-rebase.el --- Edit Git rebase files -*- lexical-binding:t -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Author: Phil Jackson <phil@shellarchive.co.uk>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This package assists the user in editing the list of commits to be
;; rewritten during an interactive rebase.
;; When the user initiates an interactive rebase, e.g. using "r e" in
;; a Magit buffer or on the command line using "git rebase -i REV",
;; Git invokes the `$GIT_SEQUENCE_EDITOR' (or if that is undefined
;; `$GIT_EDITOR' or even `$EDITOR') letting the user rearrange, drop,
;; reword, edit, and squash commits.
;; This package provides the major-mode `git-rebase-mode' which makes
;; doing so much more fun, by making the buffer more colorful and
;; providing the following commands:
;;
;; C-c C-c Tell Git to make it happen.
;; C-c C-k Tell Git that you changed your mind, i.e. abort.
;;
;; p Move point to previous line.
;; n Move point to next line.
;;
;; M-p Move the commit at point up.
;; M-n Move the commit at point down.
;;
;; k Drop the commit at point.
;; c Don't drop the commit at point.
;; r Change the message of the commit at point.
;; e Edit the commit at point.
;; s Squash the commit at point, into the one above.
;; f Like "s" but don't also edit the commit message.
;; b Break for editing at this point in the sequence.
;; x Add a script to be run with the commit at point
;; being checked out.
;; z Add noop action at point.
;;
;; SPC Show the commit at point in another buffer.
;; RET Show the commit at point in another buffer and
;; select its window.
;; C-/ Undo last change.
;;
;; Commands for --rebase-merges:
;; l Associate label with current HEAD in sequence.
;; MM Merge specified revisions into HEAD.
;; Mt Toggle whether the merge will invoke an editor
;; before committing.
;; t Reset HEAD to the specified label.
;; You should probably also read the `git-rebase' manpage.
;;; Code:
(require 'magit)
(require 'easymenu)
(require 'server)
(require 'with-editor)
(defvar recentf-exclude)
;;; Options
;;;; Variables
(defgroup git-rebase nil
"Edit Git rebase sequences."
:link '(info-link "(magit)Editing Rebase Sequences")
:group 'tools)
(defcustom git-rebase-auto-advance t
"Whether to move to next line after changing a line."
:group 'git-rebase
:type 'boolean)
(defcustom git-rebase-show-instructions t
"Whether to show usage instructions inside the rebase buffer."
:group 'git-rebase
:type 'boolean)
(defcustom git-rebase-confirm-cancel t
"Whether confirmation is required to cancel."
:group 'git-rebase
:type 'boolean)
;;;; Faces
(defgroup git-rebase-faces nil
"Faces used by Git-Rebase mode."
:group 'faces
:group 'git-rebase)
(defface git-rebase-hash '((t :inherit magit-hash))
"Face for commit hashes."
:group 'git-rebase-faces)
(defface git-rebase-label '((t :inherit magit-refname))
"Face for labels in label, merge, and reset lines."
:group 'git-rebase-faces)
(defface git-rebase-description '((t nil))
"Face for commit descriptions."
:group 'git-rebase-faces)
(defface git-rebase-action
'((t :inherit font-lock-keyword-face))
"Face for action keywords."
:group 'git-rebase-faces)
(defface git-rebase-killed-action
'((t :inherit font-lock-comment-face :strike-through t))
"Face for commented commit action lines."
:group 'git-rebase-faces)
(defface git-rebase-comment-hash
'((t :inherit git-rebase-hash :weight bold))
"Face for commit hashes in commit message comments."
:group 'git-rebase-faces)
(defface git-rebase-comment-heading
'((t :inherit font-lock-keyword-face))
"Face for headings in rebase message comments."
:group 'git-rebase-faces)
;;; Keymaps
(defvar git-rebase-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map special-mode-map)
(define-key map (kbd "C-m") #'git-rebase-show-commit)
(define-key map (kbd "p") #'git-rebase-backward-line)
(define-key map (kbd "n") #'forward-line)
(define-key map (kbd "M-p") #'git-rebase-move-line-up)
(define-key map (kbd "M-n") #'git-rebase-move-line-down)
(define-key map (kbd "c") #'git-rebase-pick)
(define-key map (kbd "k") #'git-rebase-kill-line)
(define-key map (kbd "C-k") #'git-rebase-kill-line)
(define-key map (kbd "b") #'git-rebase-break)
(define-key map (kbd "e") #'git-rebase-edit)
(define-key map (kbd "l") #'git-rebase-label)
(define-key map (kbd "M M") #'git-rebase-merge)
(define-key map (kbd "M t") #'git-rebase-merge-toggle-editmsg)
(define-key map (kbd "m") #'git-rebase-edit)
(define-key map (kbd "f") #'git-rebase-fixup)
(define-key map (kbd "q") #'undefined)
(define-key map (kbd "r") #'git-rebase-reword)
(define-key map (kbd "w") #'git-rebase-reword)
(define-key map (kbd "s") #'git-rebase-squash)
(define-key map (kbd "t") #'git-rebase-reset)
(define-key map (kbd "x") #'git-rebase-exec)
(define-key map (kbd "y") #'git-rebase-insert)
(define-key map (kbd "z") #'git-rebase-noop)
(define-key map (kbd "SPC") #'git-rebase-show-or-scroll-up)
(define-key map (kbd "DEL") #'git-rebase-show-or-scroll-down)
(define-key map (kbd "C-x C-t") #'git-rebase-move-line-up)
(define-key map [M-up] #'git-rebase-move-line-up)
(define-key map [M-down] #'git-rebase-move-line-down)
(define-key map [remap undo] #'git-rebase-undo)
map)
"Keymap for Git-Rebase mode.")
(put 'git-rebase-reword :advertised-binding (kbd "r"))
(put 'git-rebase-move-line-up :advertised-binding (kbd "M-p"))
(put 'git-rebase-kill-line :advertised-binding (kbd "k"))
(easy-menu-define git-rebase-mode-menu git-rebase-mode-map
"Git-Rebase mode menu"
'("Rebase"
["Pick" git-rebase-pick t]
["Reword" git-rebase-reword t]
["Edit" git-rebase-edit t]
["Squash" git-rebase-squash t]
["Fixup" git-rebase-fixup t]
["Kill" git-rebase-kill-line t]
["Noop" git-rebase-noop t]
["Execute" git-rebase-exec t]
["Move Down" git-rebase-move-line-down t]
["Move Up" git-rebase-move-line-up t]
"---"
["Cancel" with-editor-cancel t]
["Finish" with-editor-finish t]))
(defvar git-rebase-command-descriptions
'((with-editor-finish . "tell Git to make it happen")
(with-editor-cancel . "tell Git that you changed your mind, i.e. abort")
(git-rebase-backward-line . "move point to previous line")
(forward-line . "move point to next line")
(git-rebase-move-line-up . "move the commit at point up")
(git-rebase-move-line-down . "move the commit at point down")
(git-rebase-show-or-scroll-up . "show the commit at point in another buffer")
(git-rebase-show-commit
. "show the commit at point in another buffer and select its window")
(undo . "undo last change")
(git-rebase-kill-line . "drop the commit at point")
(git-rebase-insert . "insert a line for an arbitrary commit")
(git-rebase-noop . "add noop action at point")))
;;; Commands
(defun git-rebase-pick ()
"Use commit on current line.
If the region is active, act on all lines touched by the region."
(interactive)
(git-rebase-set-action "pick"))
(defun git-rebase-reword ()
"Edit message of commit on current line.
If the region is active, act on all lines touched by the region."
(interactive)
(git-rebase-set-action "reword"))
(defun git-rebase-edit ()
"Stop at the commit on the current line.
If the region is active, act on all lines touched by the region."
(interactive)
(git-rebase-set-action "edit"))
(defun git-rebase-squash ()
"Meld commit on current line into previous commit, edit message.
If the region is active, act on all lines touched by the region."
(interactive)
(git-rebase-set-action "squash"))
(defun git-rebase-fixup ()
"Meld commit on current line into previous commit, discard its message.
If the region is active, act on all lines touched by the region."
(interactive)
(git-rebase-set-action "fixup"))
(defvar-local git-rebase-comment-re nil)
(defvar git-rebase-short-options
'((?b . "break")
(?e . "edit")
(?f . "fixup")
(?l . "label")
(?m . "merge")
(?p . "pick")
(?r . "reword")
(?s . "squash")
(?t . "reset")
(?x . "exec"))
"Alist mapping single key of an action to the full name.")
(defclass git-rebase-action ()
(;; action-type: commit, exec, bare, label, merge
(action-type :initarg :action-type :initform nil)
;; Examples for each action type:
;; | action | action options | target | trailer |
;; |--------+----------------+---------+---------|
;; | pick | | hash | subject |
;; | exec | | command | |
;; | noop | | | |
;; | reset | | name | subject |
;; | merge | -C hash | name | subject |
(action :initarg :action :initform nil)
(action-options :initarg :action-options :initform nil)
(target :initarg :target :initform nil)
(trailer :initarg :trailer :initform nil)
(comment-p :initarg :comment-p :initform nil)))
(defvar git-rebase-line-regexps
`((commit . ,(concat
(regexp-opt '("e" "edit"
"f" "fixup"
"p" "pick"
"r" "reword"
"s" "squash")
"\\(?1:")
" \\(?3:[^ \n]+\\) ?\\(?4:.*\\)"))
(exec . "\\(?1:x\\|exec\\) \\(?3:.*\\)")
(bare . ,(concat (regexp-opt '("b" "break" "noop") "\\(?1:")
" *$"))
(label . ,(concat (regexp-opt '("l" "label"
"t" "reset")
"\\(?1:")
" \\(?3:[^ \n]+\\) ?\\(?4:.*\\)"))
(merge . ,(concat "\\(?1:m\\|merge\\) "
"\\(?:\\(?2:-[cC] [^ \n]+\\) \\)?"
"\\(?3:[^ \n]+\\)"
" ?\\(?4:.*\\)"))))
;;;###autoload
(defun git-rebase-current-line ()
"Parse current line into a `git-rebase-action' instance.
If the current line isn't recognized as a rebase line, an
instance with all nil values is returned."
(save-excursion
(goto-char (line-beginning-position))
(if-let ((re-start (concat "^\\(?5:" (regexp-quote comment-start)
"\\)? *"))
(type (seq-some (lambda (arg)
(let ((case-fold-search nil))
(and (looking-at (concat re-start (cdr arg)))
(car arg))))
git-rebase-line-regexps)))
(git-rebase-action
:action-type type
:action (and-let* ((action (match-string-no-properties 1)))
(or (cdr (assoc action git-rebase-short-options))
action))
:action-options (match-string-no-properties 2)
:target (match-string-no-properties 3)
:trailer (match-string-no-properties 4)
:comment-p (and (match-string 5) t))
;; Use default empty class rather than nil to ease handling.
(git-rebase-action))))
(defun git-rebase-set-action (action)
"Set action of commit line to ACTION.
If the region is active, operate on all lines that it touches.
Otherwise, operate on the current line. As a special case, an
ACTION of nil comments the rebase line, regardless of its action
type."
(pcase (git-rebase-region-bounds t)
(`(,beg ,end)
(let ((end-marker (copy-marker end))
(pt-below-p (and mark-active (< (mark) (point)))))
(set-marker-insertion-type end-marker t)
(goto-char beg)
(while (< (point) end-marker)
(with-slots (action-type target trailer comment-p)
(git-rebase-current-line)
(cond
((and action (eq action-type 'commit))
(let ((inhibit-read-only t))
(magit-delete-line)
(insert (concat action " " target " " trailer "\n"))))
((and action-type (not (or action comment-p)))
(let ((inhibit-read-only t))
(insert comment-start " "))
(forward-line))
(t
;; In the case of --rebase-merges, commit lines may have
;; other lines with other action types, empty lines, and
;; "Branch" comments interspersed. Move along.
(forward-line)))))
(goto-char
(if git-rebase-auto-advance
end-marker
(if pt-below-p (1- end-marker) beg)))
(goto-char (line-beginning-position))))
(_ (ding))))
(defun git-rebase-line-p (&optional pos)
(save-excursion
(when pos (goto-char pos))
(and (oref (git-rebase-current-line) action-type)
t)))
(defun git-rebase-region-bounds (&optional fallback)
"Return region bounds if both ends touch rebase lines.
Each bound is extended to include the entire line touched by the
point or mark. If the region isn't active and FALLBACK is
non-nil, return the beginning and end of the current rebase line,
if any."
(cond
((use-region-p)
(let ((beg (save-excursion (goto-char (region-beginning))
(line-beginning-position)))
(end (save-excursion (goto-char (region-end))
(line-end-position))))
(when (and (git-rebase-line-p beg)
(git-rebase-line-p end))
(list beg (1+ end)))))
((and fallback (git-rebase-line-p))
(list (line-beginning-position)
(1+ (line-end-position))))))
(defun git-rebase-move-line-down (n)
"Move the current commit (or command) N lines down.
If N is negative, move the commit up instead. With an active
region, move all the lines that the region touches, not just the
current line."
(interactive "p")
(pcase-let* ((`(,beg ,end)
(or (git-rebase-region-bounds)
(list (line-beginning-position)
(1+ (line-end-position)))))
(pt-offset (- (point) beg))
(mark-offset (and mark-active (- (mark) beg))))
(save-restriction
(narrow-to-region
(point-min)
(1-
(if git-rebase-show-instructions
(save-excursion
(goto-char (point-min))
(while (or (git-rebase-line-p)
;; The output for --rebase-merges has empty
;; lines and "Branch" comments interspersed.
(looking-at-p "^$")
(looking-at-p (concat git-rebase-comment-re
" Branch")))
(forward-line))
(line-beginning-position))
(point-max))))
(if (or (and (< n 0) (= beg (point-min)))
(and (> n 0) (= end (point-max)))
(> end (point-max)))
(ding)
(goto-char (if (< n 0) beg end))
(forward-line n)
(atomic-change-group
(let ((inhibit-read-only t))
(insert (delete-and-extract-region beg end)))
(let ((new-beg (- (point) (- end beg))))
(when (use-region-p)
(setq deactivate-mark nil)
(set-mark (+ new-beg mark-offset)))
(goto-char (+ new-beg pt-offset))))))))
(defun git-rebase-move-line-up (n)
"Move the current commit (or command) N lines up.
If N is negative, move the commit down instead. With an active
region, move all the lines that the region touches, not just the
current line."
(interactive "p")
(git-rebase-move-line-down (- n)))
(defun git-rebase-highlight-region (start end window rol)
(let ((inhibit-read-only t)
(deactivate-mark nil)
(bounds (git-rebase-region-bounds)))
(mapc #'delete-overlay magit-section-highlight-overlays)
(when bounds
(magit-section-make-overlay (car bounds) (cadr bounds)
'magit-section-heading-selection))
(if (and bounds (not magit-section-keep-region-overlay))
(funcall (default-value 'redisplay-unhighlight-region-function) rol)
(funcall (default-value 'redisplay-highlight-region-function)
start end window rol))))
(defun git-rebase-unhighlight-region (rol)
(mapc #'delete-overlay magit-section-highlight-overlays)
(funcall (default-value 'redisplay-unhighlight-region-function) rol))
(defun git-rebase-kill-line ()
"Kill the current action line.
If the region is active, act on all lines touched by the region."
(interactive)
(git-rebase-set-action nil))
(defun git-rebase-insert (rev)
"Read an arbitrary commit and insert it below current line."
(interactive (list (magit-read-branch-or-commit "Insert revision")))
(forward-line)
(--if-let (magit-rev-format "%h %s" rev)
(let ((inhibit-read-only t))
(insert "pick " it ?\n))
(user-error "Unknown revision")))
(defun git-rebase-set-noncommit-action (action value-fn arg)
(goto-char (line-beginning-position))
(pcase-let* ((inhibit-read-only t)
(`(,initial ,trailer ,comment-p)
(and (not arg)
(with-slots ((ln-action action)
target trailer comment-p)
(git-rebase-current-line)
(and (equal ln-action action)
(list target trailer comment-p)))))
(value (funcall value-fn initial)))
(pcase (list value initial comment-p)
(`("" nil ,_)
(ding))
(`("" ,_ ,_)
(magit-delete-line))
(_
(if initial
(magit-delete-line)
(forward-line))
(insert (concat action " " value
(and (equal value initial)
trailer
(concat " " trailer))
"\n"))
(unless git-rebase-auto-advance
(forward-line -1))))))
(defun git-rebase-exec (arg)
"Insert a shell command to be run after the current commit.
If there already is such a command on the current line, then edit
that instead. With a prefix argument insert a new command even
when there already is one on the current line. With empty input
remove the command on the current line, if any."
(interactive "P")
(git-rebase-set-noncommit-action
"exec"
(lambda (initial) (read-shell-command "Execute: " initial))
arg))
(defun git-rebase-label (arg)
"Add a label after the current commit.
If there already is a label on the current line, then edit that
instead. With a prefix argument, insert a new label even when
there is already a label on the current line. With empty input,
remove the label on the current line, if any."
(interactive "P")
(git-rebase-set-noncommit-action
"label"
(lambda (initial)
(read-from-minibuffer
"Label: " initial magit-minibuffer-local-ns-map))
arg))
(defun git-rebase-buffer-labels ()
(let (labels)
(save-excursion
(goto-char (point-min))
(while (re-search-forward "^\\(?:l\\|label\\) \\([^ \n]+\\)" nil t)
(push (match-string-no-properties 1) labels)))
(nreverse labels)))
(defun git-rebase-reset (arg)
"Reset the current HEAD to a label.
If there already is a reset command on the current line, then
edit that instead. With a prefix argument, insert a new reset
line even when point is already on a reset line. With empty
input, remove the reset command on the current line, if any."
(interactive "P")
(git-rebase-set-noncommit-action
"reset"
(lambda (initial)
(or (magit-completing-read "Label" (git-rebase-buffer-labels)
nil t initial)
""))
arg))
(defun git-rebase-merge (arg)
"Add a merge command after the current commit.
If there is already a merge command on the current line, then
replace that command instead. With a prefix argument, insert a
new merge command even when there is already one on the current
line. With empty input, remove the merge command on the current
line, if any."
(interactive "P")
(git-rebase-set-noncommit-action
"merge"
(lambda (_)
(or (magit-completing-read "Merge" (git-rebase-buffer-labels))
""))
arg))
(defun git-rebase-merge-toggle-editmsg ()
"Toggle whether an editor is invoked when performing the merge at point.
When a merge command uses a lower-case -c, the message for the
specified commit will be opened in an editor before creating the
commit. For an upper-case -C, the message will be used as is."
(interactive)
(with-slots (action-type target action-options trailer)
(git-rebase-current-line)
(if (eq action-type 'merge)
(let ((inhibit-read-only t))
(magit-delete-line)
(insert
(format "merge %s %s %s\n"
(replace-regexp-in-string
"-[cC]" (lambda (c)
(if (equal c "-c") "-C" "-c"))
action-options t t)
target
trailer)))
(ding))))
(defun git-rebase-set-bare-action (action arg)
(goto-char (line-beginning-position))
(with-slots ((ln-action action) comment-p)
(git-rebase-current-line)
(let ((same-action-p (equal action ln-action))
(inhibit-read-only t))
(when (or arg
(not ln-action)
(not same-action-p)
(and same-action-p comment-p))
(unless (or arg (not same-action-p))
(magit-delete-line))
(insert action ?\n)
(unless git-rebase-auto-advance
(forward-line -1))))))
(defun git-rebase-noop (&optional arg)
"Add noop action at point.
If the current line already contains a noop action, leave it
unchanged. If there is a commented noop action present, remove
the comment. Otherwise add a new noop action. With a prefix
argument insert a new noop action regardless of what is already
present on the current line.
A noop action can be used to make git perform a rebase even if
no commits are selected. Without the noop action present, git
would see an empty file and therefore do nothing."
(interactive "P")
(git-rebase-set-bare-action "noop" arg))
(defun git-rebase-break (&optional arg)
"Add break action at point.
If there is a commented break action present, remove the comment.
If the current line already contains a break action, add another
break action only if a prefix argument is given.
A break action can be used to interrupt the rebase at the
specified point. It is particularly useful for pausing before
the first commit in the sequence. For other cases, the
equivalent behavior can be achieved with `git-rebase-edit'."
(interactive "P")
(git-rebase-set-bare-action "break" arg))
(defun git-rebase-undo (&optional arg)
"Undo some previous changes.
Like `undo' but works in read-only buffers."
(interactive "P")
(let ((inhibit-read-only t))
(undo arg)))
(defun git-rebase--show-commit (&optional scroll)
(let ((magit--disable-save-buffers t))
(save-excursion
(goto-char (line-beginning-position))
(--if-let (with-slots (action-type target) (git-rebase-current-line)
(and (eq action-type 'commit)
target))
(pcase scroll
('up (magit-diff-show-or-scroll-up))
('down (magit-diff-show-or-scroll-down))
(_ (apply #'magit-show-commit it
(magit-diff-arguments 'magit-revision-mode))))
(ding)))))
(defun git-rebase-show-commit ()
"Show the commit on the current line if any."
(interactive)
(git-rebase--show-commit))
(defun git-rebase-show-or-scroll-up ()
"Update the commit buffer for commit on current line.
Either show the commit at point in the appropriate buffer, or if
that buffer is already being displayed in the current frame and
contains information about that commit, then instead scroll the
buffer up."
(interactive)
(git-rebase--show-commit 'up))
(defun git-rebase-show-or-scroll-down ()
"Update the commit buffer for commit on current line.
Either show the commit at point in the appropriate buffer, or if
that buffer is already being displayed in the current frame and
contains information about that commit, then instead scroll the
buffer down."
(interactive)
(git-rebase--show-commit 'down))
(defun git-rebase-backward-line (&optional n)
"Move N lines backward (forward if N is negative).
Like `forward-line' but go into the opposite direction."
(interactive "p")
(forward-line (- (or n 1))))
;;; Mode
;;;###autoload
(define-derived-mode git-rebase-mode special-mode "Git Rebase"
"Major mode for editing of a Git rebase file.
Rebase files are generated when you run \"git rebase -i\" or run
`magit-interactive-rebase'. They describe how Git should perform
the rebase. See the documentation for git-rebase (e.g., by
running \"man git-rebase\" at the command line) for details."
:group 'git-rebase
(setq comment-start (or (magit-get "core.commentChar") "#"))
(setq git-rebase-comment-re (concat "^" (regexp-quote comment-start)))
(setq font-lock-defaults (list (git-rebase-mode-font-lock-keywords) t t))
(unless git-rebase-show-instructions
(let ((inhibit-read-only t))
(flush-lines git-rebase-comment-re)))
(unless with-editor-mode
;; Maybe already enabled when using `shell-command' or an Emacs shell.
(with-editor-mode 1))
(when git-rebase-confirm-cancel
(add-hook 'with-editor-cancel-query-functions
#'git-rebase-cancel-confirm nil t))
(setq-local redisplay-highlight-region-function #'git-rebase-highlight-region)
(setq-local redisplay-unhighlight-region-function #'git-rebase-unhighlight-region)
(add-hook 'with-editor-pre-cancel-hook #'git-rebase-autostash-save nil t)
(add-hook 'with-editor-post-cancel-hook #'git-rebase-autostash-apply nil t)
(setq imenu-prev-index-position-function
#'magit-imenu--rebase-prev-index-position-function)
(setq imenu-extract-index-name-function
#'magit-imenu--rebase-extract-index-name-function)
(when (boundp 'save-place)
(setq save-place nil)))
(defun git-rebase-cancel-confirm (force)
(or (not (buffer-modified-p))
force
(magit-confirm 'abort-rebase "Abort this rebase" nil 'noabort)))
(defun git-rebase-autostash-save ()
(--when-let (magit-file-line (magit-git-dir "rebase-merge/autostash"))
(push (cons 'stash it) with-editor-cancel-alist)))
(defun git-rebase-autostash-apply ()
(--when-let (cdr (assq 'stash with-editor-cancel-alist))
(magit-stash-apply it)))
(defun git-rebase-match-comment-line (limit)
(re-search-forward (concat git-rebase-comment-re ".*") limit t))
(defun git-rebase-mode-font-lock-keywords ()
"Font lock keywords for Git-Rebase mode."
`((,(concat "^" (cdr (assq 'commit git-rebase-line-regexps)))
(1 'git-rebase-action)
(3 'git-rebase-hash)
(4 'git-rebase-description))
(,(concat "^" (cdr (assq 'exec git-rebase-line-regexps)))
(1 'git-rebase-action)
(3 'git-rebase-description))
(,(concat "^" (cdr (assq 'bare git-rebase-line-regexps)))
(1 'git-rebase-action))
(,(concat "^" (cdr (assq 'label git-rebase-line-regexps)))
(1 'git-rebase-action)
(3 'git-rebase-label)
(4 'font-lock-comment-face))
("^\\(m\\(?:erge\\)?\\) -[Cc] \\([^ \n]+\\) \\([^ \n]+\\)\\( #.*\\)?"
(1 'git-rebase-action)
(2 'git-rebase-hash)
(3 'git-rebase-label)
(4 'font-lock-comment-face))
("^\\(m\\(?:erge\\)?\\) \\([^ \n]+\\)"
(1 'git-rebase-action)
(2 'git-rebase-label))
(,(concat git-rebase-comment-re " *"
(cdr (assq 'commit git-rebase-line-regexps)))
0 'git-rebase-killed-action t)
(git-rebase-match-comment-line 0 'font-lock-comment-face)
("\\[[^[]*\\]"
0 'magit-keyword t)
("\\(?:fixup!\\|squash!\\)"
0 'magit-keyword-squash t)
(,(format "^%s Rebase \\([^ ]*\\) onto \\([^ ]*\\)" comment-start)
(1 'git-rebase-comment-hash t)
(2 'git-rebase-comment-hash t))
(,(format "^%s \\(Commands:\\)" comment-start)
(1 'git-rebase-comment-heading t))
(,(format "^%s Branch \\(.*\\)" comment-start)
(1 'git-rebase-label t))))
(defun git-rebase-mode-show-keybindings ()
"Modify the \"Commands:\" section of the comment Git generates
at the bottom of the file so that in place of the one-letter
abbreviation for the command, it shows the command's keybinding.
By default, this is the same except for the \"pick\" command."
(let ((inhibit-read-only t))
(save-excursion
(goto-char (point-min))
(when (and git-rebase-show-instructions
(re-search-forward
(concat git-rebase-comment-re "\\s-+p, pick")
nil t))
(goto-char (line-beginning-position))
(pcase-dolist (`(,cmd . ,desc) git-rebase-command-descriptions)
(insert (format (propertize "%s %s %s\n"
'font-lock-face 'font-lock-comment-face)
comment-start
(string-pad
(substitute-command-keys (format "\\[%s]" cmd)) 8)
desc)))
(while (re-search-forward
(concat git-rebase-comment-re "\\(?:"
"\\( \\.? *\\)\\|"
"\\( +\\)\\([^\n,],\\) \\([^\n ]+\\) \\)")
nil t)
(if (match-string 1)
(replace-match (make-string 10 ?\s) t t nil 1)
(let ((cmd (intern (concat "git-rebase-" (match-string 4)))))
(if (not (fboundp cmd))
(delete-region (line-beginning-position)
(1+ (line-end-position)))
(add-text-properties (line-beginning-position)
(1+ (line-end-position))
'(font-lock-face font-lock-comment-face))
(replace-match " " t t nil 2)
(replace-match
(string-pad
(mapconcat (lambda (key)
(save-match-data
(substitute-command-keys
(format "\\`%s'" (key-description key)))))
(cl-remove-if (lambda (key) (eq (elt key 0) 'menu-bar))
(reverse (where-is-internal
cmd git-rebase-mode-map)))
", ")
8)
t t nil 3)))))))))
(add-hook 'git-rebase-mode-hook #'git-rebase-mode-show-keybindings t)
(defun git-rebase-mode-disable-before-save-hook ()
(set (make-local-variable 'before-save-hook) nil))
(add-hook 'git-rebase-mode-hook #'git-rebase-mode-disable-before-save-hook)
;;;###autoload
(defconst git-rebase-filename-regexp "/git-rebase-todo\\'")
;;;###autoload
(add-to-list 'auto-mode-alist
(cons git-rebase-filename-regexp #'git-rebase-mode))
(add-to-list 'with-editor-server-window-alist
(cons git-rebase-filename-regexp #'switch-to-buffer))
(with-eval-after-load 'recentf
(add-to-list 'recentf-exclude git-rebase-filename-regexp))
(add-to-list 'with-editor-file-name-history-exclude git-rebase-filename-regexp)
;;; Imenu Support
(defun magit-imenu--rebase-prev-index-position-function ()
"Move point to previous commit in git-rebase buffer.
Used as a value for `imenu-prev-index-position-function'."
(catch 'found
(while (not (bobp))
(git-rebase-backward-line)
(when (git-rebase-line-p)
(throw 'found t)))))
(defun magit-imenu--rebase-extract-index-name-function ()
"Return imenu name for line at point.
Point should be at the beginning of the line. This function
is used as a value for `imenu-extract-index-name-function'."
(buffer-substring-no-properties (line-beginning-position)
(line-end-position)))
;;; _
(provide 'git-rebase)
;;; git-rebase.el ends here

813
code/elpa/magit-20220821.1819/magit-apply.el Normal file
View File

@ -0,0 +1,813 @@
;;; magit-apply.el --- Apply Git diffs -*- lexical-binding:t -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library implements commands for applying Git diffs or parts
;; of such a diff. The supported "apply variants" are apply, stage,
;; unstage, discard, and reverse - more than Git itself knows about,
;; at least at the porcelain level.
;;; Code:
(require 'magit-core)
(require 'magit-diff)
(require 'magit-wip)
(require 'transient) ; See #3732.
;; For `magit-apply'
(declare-function magit-am "magit-sequence" () t)
(declare-function magit-patch-apply "magit-patch" () t)
;; For `magit-discard-files'
(declare-function magit-checkout-stage "magit-merge" (file arg))
(declare-function magit-checkout-read-stage "magit-merge" (file))
(defvar auto-revert-verbose)
;; For `magit-stage-untracked'
(declare-function magit-submodule-add-1 "magit-submodule"
(url &optional path name args))
(declare-function magit-submodule-read-name-for-path "magit-submodule"
(path &optional prefer-short))
(defvar borg-user-emacs-directory)
(cl-eval-when (compile load)
(when (< emacs-major-version 26)
(defalias 'smerge-keep-upper 'smerge-keep-mine)
(defalias 'smerge-keep-lower 'smerge-keep-other)))
;;; Options
(defcustom magit-delete-by-moving-to-trash t
"Whether Magit uses the system's trash can.
You should absolutely not disable this and also remove `discard'
from `magit-no-confirm'. You shouldn't do that even if you have
all of the Magit-Wip modes enabled, because those modes do not
track any files that are not tracked in the proper branch."
:package-version '(magit . "2.1.0")
:group 'magit-essentials
:type 'boolean)
(defcustom magit-unstage-committed t
"Whether unstaging a committed change reverts it instead.
A committed change cannot be unstaged, because staging and
unstaging are actions that are concerned with the differences
between the index and the working tree, not with committed
changes.
If this option is non-nil (the default), then typing \"u\"
\(`magit-unstage') on a committed change, causes it to be
reversed in the index but not the working tree. For more
information see command `magit-reverse-in-index'."
:package-version '(magit . "2.4.1")
:group 'magit-commands
:type 'boolean)
(defcustom magit-reverse-atomically nil
"Whether to reverse changes atomically.
If some changes can be reversed while others cannot, then nothing
is reversed if the value of this option is non-nil. But when it
is nil, then the changes that can be reversed are reversed and
for the other changes diff files are created that contain the
rejected reversals."
:package-version '(magit . "2.7.0")
:group 'magit-commands
:type 'boolean)
(defcustom magit-post-stage-hook nil
"Hook run after staging changes.
This hook is run by `magit-refresh' if `this-command'
is a member of `magit-post-stage-hook-commands'."
:package-version '(magit . "2.90.0")
:group 'magit-commands
:type 'hook)
(defcustom magit-post-unstage-hook nil
"Hook run after unstaging changes.
This hook is run by `magit-refresh' if `this-command'
is a member of `magit-post-unstage-hook-commands'."
:package-version '(magit . "2.90.0")
:group 'magit-commands
:type 'hook)
;;; Commands
;;;; Apply
(defun magit-apply (&rest args)
"Apply the change at point to the working tree.
With a prefix argument fallback to a 3-way merge. Doing
so causes the change to be applied to the index as well."
(interactive (and current-prefix-arg (list "--3way")))
(--when-let (magit-apply--get-selection)
(pcase (list (magit-diff-type) (magit-diff-scope))
(`(,(or 'unstaged 'staged) ,_)
(user-error "Change is already in the working tree"))
(`(untracked ,(or 'file 'files))
(call-interactively #'magit-am))
(`(,_ region) (magit-apply-region it args))
(`(,_ hunk) (magit-apply-hunk it args))
(`(,_ hunks) (magit-apply-hunks it args))
(`(rebase-sequence file)
(call-interactively #'magit-patch-apply))
(`(,_ file) (magit-apply-diff it args))
(`(,_ files) (magit-apply-diffs it args)))))
(defun magit-apply--section-content (section)
(buffer-substring-no-properties (if (magit-hunk-section-p section)
(oref section start)
(oref section content))
(oref section end)))
(defun magit-apply-diffs (sections &rest args)
(setq sections (magit-apply--get-diffs sections))
(magit-apply-patch sections args
(mapconcat
(lambda (s)
(concat (magit-diff-file-header s)
(magit-apply--section-content s)))
sections "")))
(defun magit-apply-diff (section &rest args)
(setq section (car (magit-apply--get-diffs (list section))))
(magit-apply-patch section args
(concat (magit-diff-file-header section)
(magit-apply--section-content section))))
(defun magit-apply--adjust-hunk-new-starts (hunks)
"Adjust new line numbers in headers of HUNKS for partial application.
HUNKS should be a list of ordered, contiguous hunks to be applied
from a file. For example, if there is a sequence of hunks with
the headers
@@ -2,6 +2,7 @@
@@ -10,6 +11,7 @@
@@ -18,6 +20,7 @@
and only the second and third are to be applied, they would be
adjusted as \"@@ -10,6 +10,7 @@\" and \"@@ -18,6 +19,7 @@\"."
(let* ((first-hunk (car hunks))
(offset (if (string-match diff-hunk-header-re-unified first-hunk)
(- (string-to-number (match-string 3 first-hunk))
(string-to-number (match-string 1 first-hunk)))
(error "Header hunks have to be applied individually"))))
(if (= offset 0)
hunks
(mapcar (lambda (hunk)
(if (string-match diff-hunk-header-re-unified hunk)
(replace-match (number-to-string
(- (string-to-number (match-string 3 hunk))
offset))
t t hunk 3)
(error "Hunk does not have expected header")))
hunks))))
(defun magit-apply--adjust-hunk-new-start (hunk)
(car (magit-apply--adjust-hunk-new-starts (list hunk))))
(defun magit-apply-hunks (sections &rest args)
(let ((section (oref (car sections) parent)))
(when (string-match "^diff --cc" (oref section value))
(user-error "Cannot un-/stage resolution hunks. Stage the whole file"))
(magit-apply-patch
section args
(concat (oref section header)
(mapconcat #'identity
(magit-apply--adjust-hunk-new-starts
(mapcar #'magit-apply--section-content sections))
"")))))
(defun magit-apply-hunk (section &rest args)
(when (string-match "^diff --cc" (magit-section-parent-value section))
(user-error "Cannot un-/stage resolution hunks. Stage the whole file"))
(let* ((header (car (oref section value)))
(header (and (symbolp header) header))
(content (magit-apply--section-content section)))
(magit-apply-patch
(oref section parent) args
(concat (magit-diff-file-header section (not (eq header 'rename)))
(if header
content
(magit-apply--adjust-hunk-new-start content))))))
(defun magit-apply-region (section &rest args)
(when (string-match "^diff --cc" (magit-section-parent-value section))
(user-error "Cannot un-/stage resolution hunks. Stage the whole file"))
(magit-apply-patch (oref section parent) args
(concat (magit-diff-file-header section)
(magit-apply--adjust-hunk-new-start
(magit-diff-hunk-region-patch section args)))))
(defun magit-apply-patch (section:s args patch)
(let* ((files (if (atom section:s)
(list (oref section:s value))
(--map (oref it value) section:s)))
(command (symbol-name this-command))
(command (if (and command (string-match "^magit-\\([^-]+\\)" command))
(match-string 1 command)
"apply"))
(ignore-context (magit-diff-ignore-any-space-p)))
(unless (magit-diff-context-p)
(user-error "Not enough context to apply patch. Increase the context"))
(when (and magit-wip-before-change-mode (not magit-inhibit-refresh))
(magit-wip-commit-before-change files (concat " before " command)))
(with-temp-buffer
(insert patch)
(magit-run-git-with-input
"apply" args "-p0"
(and ignore-context "-C0")
"--ignore-space-change" "-"))
(unless magit-inhibit-refresh
(when magit-wip-after-apply-mode
(magit-wip-commit-after-apply files (concat " after " command)))
(magit-refresh))))
(defun magit-apply--get-selection ()
(or (magit-region-sections '(hunk file module) t)
(let ((section (magit-current-section)))
(pcase (oref section type)
((or 'hunk 'file 'module) section)
((or 'staged 'unstaged 'untracked
'stashed-index 'stashed-worktree 'stashed-untracked)
(oref section children))
(_ (user-error "Cannot apply this, it's not a change"))))))
(defun magit-apply--get-diffs (sections)
(magit-section-case
([file diffstat]
(--map (or (magit-get-section
(append `((file . ,(oref it value)))
(magit-section-ident magit-root-section)))
(error "Cannot get required diff headers"))
sections))
(t sections)))
(defun magit-apply--diff-ignores-whitespace-p ()
(and (cl-intersection magit-buffer-diff-args
'("--ignore-space-at-eol"
"--ignore-space-change"
"--ignore-all-space"
"--ignore-blank-lines")
:test #'equal)
t))
;;;; Stage
(defun magit-stage (&optional intent)
"Add the change at point to the staging area.
With a prefix argument, INTENT, and an untracked file (or files)
at point, stage the file but not its content."
(interactive "P")
(--if-let (and (derived-mode-p 'magit-mode) (magit-apply--get-selection))
(pcase (list (magit-diff-type)
(magit-diff-scope)
(magit-apply--diff-ignores-whitespace-p))
(`(untracked ,_ ,_) (magit-stage-untracked intent))
(`(unstaged region ,_) (magit-apply-region it "--cached"))
(`(unstaged hunk ,_) (magit-apply-hunk it "--cached"))
(`(unstaged hunks ,_) (magit-apply-hunks it "--cached"))
('(unstaged file t) (magit-apply-diff it "--cached"))
('(unstaged files t) (magit-apply-diffs it "--cached"))
('(unstaged list t) (magit-apply-diffs it "--cached"))
('(unstaged file nil) (magit-stage-1 "-u" (list (oref it value))))
('(unstaged files nil) (magit-stage-1 "-u" (magit-region-values nil t)))
('(unstaged list nil) (magit-stage-modified))
(`(staged ,_ ,_) (user-error "Already staged"))
(`(committed ,_ ,_) (user-error "Cannot stage committed changes"))
(`(undefined ,_ ,_) (user-error "Cannot stage this change")))
(call-interactively #'magit-stage-file)))
;;;###autoload
(defun magit-stage-file (file)
"Stage all changes to FILE.
With a prefix argument or when there is no file at point ask for
the file to be staged. Otherwise stage the file at point without
requiring confirmation."
(interactive
(let* ((atpoint (magit-section-value-if 'file))
(current (magit-file-relative-name))
(choices (nconc (magit-unstaged-files)
(magit-untracked-files)))
(default (car (member (or atpoint current) choices))))
(list (if (or current-prefix-arg (not default))
(magit-completing-read "Stage file" choices
nil t nil nil default)
default))))
(magit-with-toplevel
(magit-stage-1 nil (list file))))
;;;###autoload
(defun magit-stage-modified (&optional all)
"Stage all changes to files modified in the worktree.
Stage all new content of tracked files and remove tracked files
that no longer exist in the working tree from the index also.
With a prefix argument also stage previously untracked (but not
ignored) files."
(interactive "P")
(when (magit-anything-staged-p)
(magit-confirm 'stage-all-changes))
(magit-with-toplevel
(magit-stage-1 (if all "--all" "-u") magit-buffer-diff-files)))
(defun magit-stage-1 (arg &optional files)
(magit-wip-commit-before-change files " before stage")
(magit-run-git "add" arg (if files (cons "--" files) "."))
(when magit-auto-revert-mode
(mapc #'magit-turn-on-auto-revert-mode-if-desired files))
(magit-wip-commit-after-apply files " after stage"))
(defun magit-stage-untracked (&optional intent)
(let* ((section (magit-current-section))
(files (pcase (magit-diff-scope)
('file (list (oref section value)))
('files (magit-region-values nil t))
('list (magit-untracked-files))))
plain repos)
(dolist (file files)
(if (and (not (file-symlink-p file))
(magit-git-repo-p file t))
(push file repos)
(push file plain)))
(magit-wip-commit-before-change files " before stage")
(when plain
(magit-run-git "add" (and intent "--intent-to-add")
"--" plain)
(when magit-auto-revert-mode
(mapc #'magit-turn-on-auto-revert-mode-if-desired plain)))
(dolist (repo repos)
(save-excursion
(goto-char (oref (magit-get-section
`((file . ,repo) (untracked) (status)))
start))
(when (and (fboundp 'borg-assimilate)
(fboundp 'borg--maybe-absorb-gitdir)
(fboundp 'borg--sort-submodule-sections))
(let* ((topdir (magit-toplevel))
(url (let ((default-directory
(file-name-as-directory (expand-file-name repo))))
(or (magit-get "remote" (magit-get-some-remote) "url")
(concat (file-name-as-directory ".") repo))))
(package
(and (equal borg-user-emacs-directory topdir)
(file-name-nondirectory (directory-file-name repo)))))
(if (and package
(y-or-n-p (format "Also assimilate `%s' drone?" package)))
(borg-assimilate package url)
(magit-submodule-add-1
url repo (magit-submodule-read-name-for-path repo package))
(when package
(borg--sort-submodule-sections
(expand-file-name ".gitmodules" topdir))
(let ((default-directory borg-user-emacs-directory))
(borg--maybe-absorb-gitdir package))))))))
(magit-wip-commit-after-apply files " after stage")))
(defvar magit-post-stage-hook-commands
'(magit-stage magit-stage-file magit-stage-modified))
(defun magit-run-post-stage-hook ()
(when (memq this-command magit-post-stage-hook-commands)
(magit-run-hook-with-benchmark 'magit-post-stage-hook)))
;;;; Unstage
(defun magit-unstage ()
"Remove the change at point from the staging area."
(interactive)
(--when-let (magit-apply--get-selection)
(pcase (list (magit-diff-type)
(magit-diff-scope)
(magit-apply--diff-ignores-whitespace-p))
(`(untracked ,_ ,_) (user-error "Cannot unstage untracked changes"))
(`(unstaged file ,_) (magit-unstage-intent (list (oref it value))))
(`(unstaged files ,_) (magit-unstage-intent (magit-region-values nil t)))
(`(unstaged ,_ ,_) (user-error "Already unstaged"))
(`(staged region ,_) (magit-apply-region it "--reverse" "--cached"))
(`(staged hunk ,_) (magit-apply-hunk it "--reverse" "--cached"))
(`(staged hunks ,_) (magit-apply-hunks it "--reverse" "--cached"))
('(staged file t) (magit-apply-diff it "--reverse" "--cached"))
('(staged files t) (magit-apply-diffs it "--reverse" "--cached"))
('(staged list t) (magit-apply-diffs it "--reverse" "--cached"))
('(staged file nil) (magit-unstage-1 (list (oref it value))))
('(staged files nil) (magit-unstage-1 (magit-region-values nil t)))
('(staged list nil) (magit-unstage-all))
(`(committed ,_ ,_) (if magit-unstage-committed
(magit-reverse-in-index)
(user-error "Cannot unstage committed changes")))
(`(undefined ,_ ,_) (user-error "Cannot unstage this change")))))
;;;###autoload
(defun magit-unstage-file (file)
"Unstage all changes to FILE.
With a prefix argument or when there is no file at point ask for
the file to be unstaged. Otherwise unstage the file at point
without requiring confirmation."
(interactive
(let* ((atpoint (magit-section-value-if 'file))
(current (magit-file-relative-name))
(choices (magit-staged-files))
(default (car (member (or atpoint current) choices))))
(list (if (or current-prefix-arg (not default))
(magit-completing-read "Unstage file" choices
nil t nil nil default)
default))))
(magit-with-toplevel
(magit-unstage-1 (list file))))
(defun magit-unstage-1 (files)
(magit-wip-commit-before-change files " before unstage")
(if (magit-no-commit-p)
(magit-run-git "rm" "--cached" "--" files)
(magit-run-git "reset" "HEAD" "--" files))
(magit-wip-commit-after-apply files " after unstage"))
(defun magit-unstage-intent (files)
(if-let ((staged (magit-staged-files))
(intent (--filter (member it staged) files)))
(magit-unstage-1 intent)
(user-error "Already unstaged")))
;;;###autoload
(defun magit-unstage-all ()
"Remove all changes from the staging area."
(interactive)
(unless (magit-anything-staged-p)
(user-error "Nothing to unstage"))
(when (or (magit-anything-unstaged-p)
(magit-untracked-files))
(magit-confirm 'unstage-all-changes))
(magit-wip-commit-before-change nil " before unstage")
(magit-run-git "reset" "HEAD" "--" magit-buffer-diff-files)
(magit-wip-commit-after-apply nil " after unstage"))
(defvar magit-post-unstage-hook-commands
'(magit-unstage magit-unstage-file magit-unstage-all))
(defun magit-run-post-unstage-hook ()
(when (memq this-command magit-post-unstage-hook-commands)
(magit-run-hook-with-benchmark 'magit-post-unstage-hook)))
;;;; Discard
(defun magit-discard ()
"Remove the change at point.
On a hunk or file with unresolved conflicts prompt which side to
keep (while discarding the other). If point is within the text
of a side, then keep that side without prompting."
(interactive)
(--when-let (magit-apply--get-selection)
(pcase (list (magit-diff-type) (magit-diff-scope))
(`(committed ,_) (user-error "Cannot discard committed changes"))
(`(undefined ,_) (user-error "Cannot discard this change"))
(`(,_ region) (magit-discard-region it))
(`(,_ hunk) (magit-discard-hunk it))
(`(,_ hunks) (magit-discard-hunks it))
(`(,_ file) (magit-discard-file it))
(`(,_ files) (magit-discard-files it))
(`(,_ list) (magit-discard-files it)))))
(defun magit-discard-region (section)
(magit-confirm 'discard "Discard region")
(magit-discard-apply section 'magit-apply-region))
(defun magit-discard-hunk (section)
(magit-confirm 'discard "Discard hunk")
(let ((file (magit-section-parent-value section)))
(pcase (cddr (car (magit-file-status file)))
('(?U ?U) (magit-smerge-keep-current))
(_ (magit-discard-apply section #'magit-apply-hunk)))))
(defun magit-discard-apply (section apply)
(if (eq (magit-diff-type section) 'unstaged)
(funcall apply section "--reverse")
(if (magit-anything-unstaged-p
nil (if (magit-file-section-p section)
(oref section value)
(magit-section-parent-value section)))
(progn (let ((magit-inhibit-refresh t))
(funcall apply section "--reverse" "--cached")
(funcall apply section "--reverse" "--reject"))
(magit-refresh))
(funcall apply section "--reverse" "--index"))))
(defun magit-discard-hunks (sections)
(magit-confirm 'discard (format "Discard %s hunks from %s"
(length sections)
(magit-section-parent-value (car sections))))
(magit-discard-apply-n sections #'magit-apply-hunks))
(defun magit-discard-apply-n (sections apply)
(let ((section (car sections)))
(if (eq (magit-diff-type section) 'unstaged)
(funcall apply sections "--reverse")
(if (magit-anything-unstaged-p
nil (if (magit-file-section-p section)
(oref section value)
(magit-section-parent-value section)))
(progn (let ((magit-inhibit-refresh t))
(funcall apply sections "--reverse" "--cached")
(funcall apply sections "--reverse" "--reject"))
(magit-refresh))
(funcall apply sections "--reverse" "--index")))))
(defun magit-discard-file (section)
(magit-discard-files (list section)))
(defun magit-discard-files (sections)
(let ((auto-revert-verbose nil)
(type (magit-diff-type (car sections)))
(status (magit-file-status))
files delete resurrect rename discard discard-new resolve)
(dolist (section sections)
(let ((file (oref section value)))
(push file files)
(pcase (cons (pcase type
(`staged ?X)
(`unstaged ?Y)
(`untracked ?Z))
(cddr (assoc file status)))
('(?Z) (dolist (f (magit-untracked-files nil file))
(push f delete)))
((or '(?Z ?? ??) '(?Z ?! ?!)) (push file delete))
('(?Z ?D ? ) (push file delete))
(`(,_ ?D ?D) (push file resolve))
((or `(,_ ?U ,_) `(,_ ,_ ?U)) (push file resolve))
(`(,_ ?A ?A) (push file resolve))
(`(?X ?M ,(or ? ?M ?D)) (push section discard))
(`(?Y ,_ ?M ) (push section discard))
('(?X ?A ?M ) (push file discard-new))
('(?X ?C ?M ) (push file discard-new))
(`(?X ?A ,(or ? ?D)) (push file delete))
(`(?X ?C ,(or ? ?D)) (push file delete))
(`(?X ?D ,(or ? ?M )) (push file resurrect))
(`(?Y ,_ ?D ) (push file resurrect))
(`(?X ?R ,(or ? ?M ?D)) (push file rename)))))
(unwind-protect
(let ((magit-inhibit-refresh t))
(magit-wip-commit-before-change files " before discard")
(when resolve
(magit-discard-files--resolve (nreverse resolve)))
(when resurrect
(magit-discard-files--resurrect (nreverse resurrect)))
(when delete
(magit-discard-files--delete (nreverse delete) status))
(when rename
(magit-discard-files--rename (nreverse rename) status))
(when (or discard discard-new)
(magit-discard-files--discard (nreverse discard)
(nreverse discard-new)))
(magit-wip-commit-after-apply files " after discard"))
(magit-refresh))))
(defun magit-discard-files--resolve (files)
(if-let ((arg (and (cdr files)
(magit-read-char-case
(format "For these %i files\n%s\ncheckout:\n"
(length files)
(mapconcat (lambda (file)
(concat " " file))
files "\n"))
t
(?o "[o]ur stage" "--ours")
(?t "[t]heir stage" "--theirs")
(?c "[c]onflict" "--merge")
(?i "decide [i]ndividually" nil)))))
(dolist (file files)
(magit-checkout-stage file arg))
(dolist (file files)
(magit-checkout-stage file (magit-checkout-read-stage file)))))
(defun magit-discard-files--resurrect (files)
(magit-confirm-files 'resurrect files)
(if (eq (magit-diff-type) 'staged)
(magit-call-git "reset" "--" files)
(magit-call-git "checkout" "--" files)))
(defun magit-discard-files--delete (files status)
(magit-confirm-files (if magit-delete-by-moving-to-trash 'trash 'delete)
files)
(let ((delete-by-moving-to-trash magit-delete-by-moving-to-trash))
(dolist (file files)
(when (string-match-p "\\`\\\\?~" file)
(error "Refusing to delete %S, too dangerous" file))
(pcase (nth 3 (assoc file status))
((guard (memq (magit-diff-type) '(unstaged untracked)))
(dired-delete-file file dired-recursive-deletes
magit-delete-by-moving-to-trash)
(dired-clean-up-after-deletion file))
(?\s (delete-file file t)
(magit-call-git "rm" "--cached" "--" file))
(?M (let ((temp (magit-git-string "checkout-index" "--temp" file)))
(string-match
(format "\\(.+?\\)\t%s" (regexp-quote file)) temp)
(rename-file (match-string 1 temp)
(setq temp (concat file ".~{index}~")))
(delete-file temp t))
(magit-call-git "rm" "--cached" "--force" "--" file))
(?D (magit-call-git "checkout" "--" file)
(delete-file file t)
(magit-call-git "rm" "--cached" "--force" "--" file))))))
(defun magit-discard-files--rename (files status)
(magit-confirm 'rename "Undo rename %s" "Undo %i renames" nil
(mapcar (lambda (file)
(setq file (assoc file status))
(format "%s -> %s" (cadr file) (car file)))
files))
(dolist (file files)
(let ((orig (cadr (assoc file status))))
(if (file-exists-p file)
(progn
(--when-let (file-name-directory orig)
(make-directory it t))
(magit-call-git "mv" file orig))
(magit-call-git "rm" "--cached" "--" file)
(magit-call-git "reset" "--" orig)))))
(defun magit-discard-files--discard (sections new-files)
(let ((files (--map (oref it value) sections)))
(magit-confirm-files 'discard (append files new-files)
(format "Discard %s changes in" (magit-diff-type)))
(if (eq (magit-diff-type (car sections)) 'unstaged)
(magit-call-git "checkout" "--" files)
(when new-files
(magit-call-git "add" "--" new-files)
(magit-call-git "reset" "--" new-files))
(let ((binaries (magit-binary-files "--cached")))
(when binaries
(setq sections
(--remove (member (oref it value) binaries)
sections)))
(cond ((length= sections 1)
(magit-discard-apply (car sections) 'magit-apply-diff))
(sections
(magit-discard-apply-n sections #'magit-apply-diffs)))
(when binaries
(let ((modified (magit-unstaged-files t)))
(setq binaries (--separate (member it modified) binaries)))
(when (cadr binaries)
(magit-call-git "reset" "--" (cadr binaries)))
(when (car binaries)
(user-error
(concat
"Cannot discard staged changes to binary files, "
"which also have unstaged changes. Unstage instead."))))))))
;;;; Reverse
(defun magit-reverse (&rest args)
"Reverse the change at point in the working tree.
With a prefix argument fallback to a 3-way merge. Doing
so causes the change to be applied to the index as well."
(interactive (and current-prefix-arg (list "--3way")))
(--when-let (magit-apply--get-selection)
(pcase (list (magit-diff-type) (magit-diff-scope))
(`(untracked ,_) (user-error "Cannot reverse untracked changes"))
(`(unstaged ,_) (user-error "Cannot reverse unstaged changes"))
(`(,_ region) (magit-reverse-region it args))
(`(,_ hunk) (magit-reverse-hunk it args))
(`(,_ hunks) (magit-reverse-hunks it args))
(`(,_ file) (magit-reverse-file it args))
(`(,_ files) (magit-reverse-files it args))
(`(,_ list) (magit-reverse-files it args)))))
(defun magit-reverse-region (section args)
(magit-confirm 'reverse "Reverse region")
(magit-reverse-apply section #'magit-apply-region args))
(defun magit-reverse-hunk (section args)
(magit-confirm 'reverse "Reverse hunk")
(magit-reverse-apply section #'magit-apply-hunk args))
(defun magit-reverse-hunks (sections args)
(magit-confirm 'reverse
(format "Reverse %s hunks from %s"
(length sections)
(magit-section-parent-value (car sections))))
(magit-reverse-apply sections #'magit-apply-hunks args))
(defun magit-reverse-file (section args)
(magit-reverse-files (list section) args))
(defun magit-reverse-files (sections args)
(pcase-let ((`(,binaries ,sections)
(let ((bs (magit-binary-files
(cond ((derived-mode-p 'magit-revision-mode)
magit-buffer-range)
((derived-mode-p 'magit-diff-mode)
magit-buffer-range)
(t
"--cached")))))
(--separate (member (oref it value) bs)
sections))))
(magit-confirm-files 'reverse (--map (oref it value) sections))
(cond ((length= sections 1)
(magit-reverse-apply (car sections) #'magit-apply-diff args))
(sections
(magit-reverse-apply sections #'magit-apply-diffs args)))
(when binaries
(user-error "Cannot reverse binary files"))))
(defun magit-reverse-apply (section:s apply args)
(funcall apply section:s "--reverse" args
(and (not magit-reverse-atomically)
(not (member "--3way" args))
"--reject")))
(defun magit-reverse-in-index (&rest args)
"Reverse the change at point in the index but not the working tree.
Use this command to extract a change from `HEAD', while leaving
it in the working tree, so that it can later be committed using
a separate commit. A typical workflow would be:
0. Optionally make sure that there are no uncommitted changes.
1. Visit the `HEAD' commit and navigate to the change that should
not have been included in that commit.
2. Type \"u\" (`magit-unstage') to reverse it in the index.
This assumes that `magit-unstage-committed-changes' is non-nil.
3. Type \"c e\" to extend `HEAD' with the staged changes,
including those that were already staged before.
4. Optionally stage the remaining changes using \"s\" or \"S\"
and then type \"c c\" to create a new commit."
(interactive)
(magit-reverse (cons "--cached" args)))
;;; Smerge Support
(defun magit-smerge-keep-current ()
"Keep the current version of the conflict at point."
(interactive)
(magit-call-smerge #'smerge-keep-current))
(defun magit-smerge-keep-upper ()
"Keep the upper/our version of the conflict at point."
(interactive)
(magit-call-smerge #'smerge-keep-upper))
(defun magit-smerge-keep-base ()
"Keep the base version of the conflict at point."
(interactive)
(magit-call-smerge #'smerge-keep-base))
(defun magit-smerge-keep-lower ()
"Keep the lower/their version of the conflict at point."
(interactive)
(magit-call-smerge #'smerge-keep-lower))
(defun magit-call-smerge (fn)
(pcase-let* ((file (magit-file-at-point t t))
(keep (get-file-buffer file))
(`(,buf ,pos)
(let ((magit-diff-visit-jump-to-change nil))
(magit-diff-visit-file--noselect file))))
(with-current-buffer buf
(save-excursion
(save-restriction
(unless (<= (point-min) pos (point-max))
(widen))
(goto-char pos)
(condition-case nil
(smerge-match-conflict)
(error
(if (eq fn #'smerge-keep-current)
(when (eq this-command #'magit-discard)
(re-search-forward smerge-begin-re nil t)
(setq fn
(magit-read-char-case "Keep side: " t
(?o "[o]urs/upper" #'smerge-keep-upper)
(?b "[b]ase" #'smerge-keep-base)
(?t "[t]heirs/lower" #'smerge-keep-lower))))
(re-search-forward smerge-begin-re nil t))))
(funcall fn)))
(when (and keep (magit-anything-unmerged-p file))
(smerge-start-session))
(save-buffer))
(unless keep
(kill-buffer buf))
(magit-refresh)))
;;; _
(provide 'magit-apply)
;;; magit-apply.el ends here

2583
code/elpa/magit-20220821.1819/magit-autoloads.el Normal file
View File

File diff suppressed because it is too large Load Diff

261
code/elpa/magit-20220821.1819/magit-autorevert.el Normal file
View File

@ -0,0 +1,261 @@
;;; magit-autorevert.el --- Revert buffers when files in repository change -*- lexical-binding:t -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
(require 'magit-git)
(require 'autorevert)
;;; Options
(defgroup magit-auto-revert nil
"Revert buffers when files in repository change."
:link '(custom-group-link auto-revert)
:link '(info-link "(magit)Automatic Reverting of File-Visiting Buffers")
:group 'auto-revert
:group 'magit-essentials
:group 'magit-modes)
(defcustom auto-revert-buffer-list-filter nil
"Filter that determines which buffers `auto-revert-buffers' reverts.
This option is provided by Magit, which also advises
`auto-revert-buffers' to respect it. Magit users who do not turn
on the local mode `auto-revert-mode' themselves, are best served
by setting the value to `magit-auto-revert-repository-buffer-p'.
However the default is nil, so as not to disturb users who do use
the local mode directly. If you experience delays when running
Magit commands, then you should consider using one of the
predicates provided by Magit - especially if you also use Tramp.
Users who do turn on `auto-revert-mode' in buffers in which Magit
doesn't do that for them, should likely not use any filter.
Users who turn on `global-auto-revert-mode', do not have to worry
about this option, because it is disregarded if the global mode
is enabled."
:package-version '(magit . "2.4.2")
:group 'auto-revert
:group 'magit-auto-revert
:group 'magit-related
:type '(radio (const :tag "No filter" nil)
(function-item magit-auto-revert-buffer-p)
(function-item magit-auto-revert-repository-buffer-p)
function))
(defcustom magit-auto-revert-tracked-only t
"Whether `magit-auto-revert-mode' only reverts tracked files."
:package-version '(magit . "2.4.0")
:group 'magit-auto-revert
:type 'boolean
:set (lambda (var val)
(set var val)
(when (and (bound-and-true-p magit-auto-revert-mode)
(featurep 'magit-autorevert))
(magit-auto-revert-mode -1)
(magit-auto-revert-mode))))
(defcustom magit-auto-revert-immediately t
"Whether Magit reverts buffers immediately.
If this is non-nil and either `global-auto-revert-mode' or
`magit-auto-revert-mode' is enabled, then Magit immediately
reverts buffers by explicitly calling `auto-revert-buffers'
after running Git for side-effects.
If `auto-revert-use-notify' is non-nil (and file notifications
are actually supported), then `magit-auto-revert-immediately'
does not have to be non-nil, because the reverts happen
immediately anyway.
If `magit-auto-revert-immediately' and `auto-revert-use-notify'
are both nil, then reverts happen after `auto-revert-interval'
seconds of user inactivity. That is not desirable."
:package-version '(magit . "2.4.0")
:group 'magit-auto-revert
:type 'boolean)
;;; Mode
(defun magit-turn-on-auto-revert-mode-if-desired (&optional file)
(if file
(--when-let (find-buffer-visiting file)
(with-current-buffer it
(magit-turn-on-auto-revert-mode-if-desired)))
(when (and (not auto-revert-mode) ; see #3014
(not global-auto-revert-mode) ; see #3460
buffer-file-name
(file-readable-p buffer-file-name)
(compat-executable-find (magit-git-executable) t)
(magit-toplevel)
(or (not magit-auto-revert-tracked-only)
(magit-file-tracked-p buffer-file-name)))
(auto-revert-mode 1))))
;;;###autoload
(define-globalized-minor-mode magit-auto-revert-mode auto-revert-mode
magit-turn-on-auto-revert-mode-if-desired
:package-version '(magit . "2.4.0")
:link '(info-link "(magit)Automatic Reverting of File-Visiting Buffers")
:group 'magit-auto-revert
:group 'magit-essentials
;; - When `global-auto-revert-mode' is enabled, then this mode is
;; redundant.
;; - In all other cases enable the mode because if buffers are not
;; automatically reverted that would make many very common tasks
;; much more cumbersome.
:init-value (not (or global-auto-revert-mode
noninteractive)))
;; - Unfortunately `:init-value t' only sets the value of the mode
;; variable but does not cause the mode function to be called.
;; - I don't think it works like this on purpose, but since one usually
;; should not enable global modes by default, it is understandable.
;; - If the user has set the variable `magit-auto-revert-mode' to nil
;; after loading magit (instead of doing so before loading magit or
;; by using the function), then we should still respect that setting.
;; - If the user sets one of these variables after loading magit and
;; after `after-init-hook' has run, then that won't have an effect
;; and there is nothing we can do about it.
(defun magit-auto-revert-mode--init-kludge ()
"This is an internal kludge to be used on `after-init-hook'.
Do not use this function elsewhere, and don't remove it from
the `after-init-hook'. For more information see the comments
and code surrounding the definition of this function."
(if magit-auto-revert-mode
(let ((start (current-time)))
(magit-message "Turning on magit-auto-revert-mode...")
(magit-auto-revert-mode 1)
(magit-message
"Turning on magit-auto-revert-mode...done%s"
(let ((elapsed (float-time (time-subtract nil start))))
(if (> elapsed 0.2)
(format " (%.3fs, %s buffers checked)" elapsed
(length (buffer-list)))
""))))
(magit-auto-revert-mode -1)))
(if after-init-time
;; Since `after-init-hook' has already been
;; run, turn the mode on or off right now.
(magit-auto-revert-mode--init-kludge)
;; By the time the init file has been fully loaded the
;; values of the relevant variables might have changed.
(add-hook 'after-init-hook #'magit-auto-revert-mode--init-kludge t))
(put 'magit-auto-revert-mode 'function-documentation
"Toggle Magit Auto Revert mode.
If called interactively, enable Magit Auto Revert mode if ARG is
positive, and disable it if ARG is zero or negative. If called
from Lisp, also enable the mode if ARG is omitted or nil, and
toggle it if ARG is `toggle'; disable the mode otherwise.
Magit Auto Revert mode is a global minor mode that reverts
buffers associated with a file that is located inside a Git
repository when the file changes on disk. Use `auto-revert-mode'
to revert a particular buffer. Or use `global-auto-revert-mode'
to revert all file-visiting buffers, not just those that visit
a file located inside a Git repository.
This global mode works by turning on the buffer-local mode
`auto-revert-mode' at the time a buffer is first created. The
local mode is turned on if the visited file is being tracked in
a Git repository at the time when the buffer is created.
If `magit-auto-revert-tracked-only' is non-nil (the default),
then only tracked files are reverted. But if you stage a
previously untracked file using `magit-stage', then this mode
notices that.
Unlike `global-auto-revert-mode', this mode never reverts any
buffers that are not visiting files.
The behavior of this mode can be customized using the options
in the `autorevert' and `magit-autorevert' groups.
This function calls the hook `magit-auto-revert-mode-hook'.
Like nearly every mode, this mode should be enabled or disabled
by calling the respective mode function, the reason being that
changing the state of a mode involves more than merely toggling
a single switch, so setting the mode variable is not enough.
Also, you should not use `after-init-hook' to disable this mode.")
(defun magit-auto-revert-buffers ()
(when (and magit-auto-revert-immediately
(or global-auto-revert-mode
(and magit-auto-revert-mode auto-revert-buffer-list)))
(let ((auto-revert-buffer-list-filter
(or auto-revert-buffer-list-filter
#'magit-auto-revert-repository-buffer-p)))
(auto-revert-buffers))))
(defvar magit-auto-revert-toplevel nil)
(defvar magit-auto-revert-counter 1
"Incremented each time `auto-revert-buffers' is called.")
(defun magit-auto-revert-buffer-p (buffer)
"Return non-nil if BUFFER visits a file inside the current repository.
The current repository is the one containing `default-directory'.
If there is no current repository, then return t for any BUFFER."
(magit-auto-revert-repository-buffer-p buffer t))
(defun magit-auto-revert-repository-buffer-p (buffer &optional fallback)
"Return non-nil if BUFFER visits a file inside the current repository.
The current repository is the one containing `default-directory'.
If there is no current repository, then return FALLBACK (which
defaults to nil) for any BUFFER."
;; Call `magit-toplevel' just once per cycle.
(unless (and magit-auto-revert-toplevel
(= (cdr magit-auto-revert-toplevel)
magit-auto-revert-counter))
(setq magit-auto-revert-toplevel
(cons (or (magit-toplevel) 'no-repo)
magit-auto-revert-counter)))
(let ((top (car magit-auto-revert-toplevel)))
(if (eq top 'no-repo)
fallback
(let ((dir (buffer-local-value 'default-directory buffer)))
(and (equal (file-remote-p dir)
(file-remote-p top))
;; ^ `tramp-handle-file-in-directory-p' lacks this optimization.
(file-in-directory-p dir top))))))
(defun auto-revert-buffers--buffer-list-filter (fn)
(cl-incf magit-auto-revert-counter)
(if (or global-auto-revert-mode
(not auto-revert-buffer-list)
(not auto-revert-buffer-list-filter))
(funcall fn)
(let ((auto-revert-buffer-list
(-filter auto-revert-buffer-list-filter
auto-revert-buffer-list)))
(funcall fn))
(unless auto-revert-timer
(auto-revert-set-timer))))
(advice-add 'auto-revert-buffers :around
#'auto-revert-buffers--buffer-list-filter)
;;; _
(provide 'magit-autorevert)
;;; magit-autorevert.el ends here

1260
code/elpa/magit-20220821.1819/magit-base.el Normal file
View File

File diff suppressed because it is too large Load Diff

307
code/elpa/magit-20220821.1819/magit-bisect.el Normal file
View File

@ -0,0 +1,307 @@
;;; magit-bisect.el --- Bisect support for Magit -*- lexical-binding:t -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Use a binary search to find the commit that introduced a bug.
;;; Code:
(require 'magit)
;;; Options
(defcustom magit-bisect-show-graph t
"Whether to use `--graph' in the log showing commits yet to be bisected."
:package-version '(magit . "2.8.0")
:group 'magit-status
:type 'boolean)
(defface magit-bisect-good
'((t :foreground "DarkOliveGreen"))
"Face for good bisect revisions."
:group 'magit-faces)
(defface magit-bisect-skip
'((t :foreground "DarkGoldenrod"))
"Face for skipped bisect revisions."
:group 'magit-faces)
(defface magit-bisect-bad
'((t :foreground "IndianRed4"))
"Face for bad bisect revisions."
:group 'magit-faces)
;;; Commands
;;;###autoload (autoload 'magit-bisect "magit-bisect" nil t)
(transient-define-prefix magit-bisect ()
"Narrow in on the commit that introduced a bug."
:man-page "git-bisect"
[:class transient-subgroups
:if-not magit-bisect-in-progress-p
["Arguments"
("-n" "Don't checkout commits" "--no-checkout")
("-p" "Follow only first parent of a merge" "--first-parent"
:if (lambda () (magit-git-version>= "2.29")))
(6 magit-bisect:--term-old
:if (lambda () (magit-git-version>= "2.7")))
(6 magit-bisect:--term-new
:if (lambda () (magit-git-version>= "2.7")))]
["Actions"
("B" "Start" magit-bisect-start)
("s" "Start script" magit-bisect-run)]]
["Actions"
:if magit-bisect-in-progress-p
("B" "Bad" magit-bisect-bad)
("g" "Good" magit-bisect-good)
(6 "m" "Mark" magit-bisect-mark
:if (lambda () (magit-git-version>= "2.7")))
("k" "Skip" magit-bisect-skip)
("r" "Reset" magit-bisect-reset)
("s" "Run script" magit-bisect-run)])
(transient-define-argument magit-bisect:--term-old ()
:description "Old/good term"
:class 'transient-option
:key "=o"
:argument "--term-old=")
(transient-define-argument magit-bisect:--term-new ()
:description "New/bad term"
:class 'transient-option
:key "=n"
:argument "--term-new=")
;;;###autoload
(defun magit-bisect-start (bad good args)
"Start a bisect session.
Bisecting a bug means to find the commit that introduced it.
This command starts such a bisect session by asking for a known
good and a known bad commit. To move the session forward use the
other actions from the bisect transient command (\
\\<magit-status-mode-map>\\[magit-bisect])."
(interactive (if (magit-bisect-in-progress-p)
(user-error "Already bisecting")
(magit-bisect-start-read-args)))
(unless (magit-rev-ancestor-p good bad)
(user-error
"The %s revision (%s) has to be an ancestor of the %s one (%s)"
(or (transient-arg-value "--term-old=" args) "good")
good
(or (transient-arg-value "--term-new=" args) "bad")
bad))
(when (magit-anything-modified-p)
(user-error "Cannot bisect with uncommitted changes"))
(magit-git-bisect "start" (list args bad good) t))
(defun magit-bisect-start-read-args ()
(let* ((args (transient-args 'magit-bisect))
(bad (magit-read-branch-or-commit
(format "Start bisect with %s revision"
(or (transient-arg-value "--term-new=" args)
"bad")))))
(list bad
(magit-read-other-branch-or-commit
(format "%s revision" (or (transient-arg-value "--term-old=" args)
"Good"))
bad)
args)))
;;;###autoload
(defun magit-bisect-reset ()
"After bisecting, cleanup bisection state and return to original `HEAD'."
(interactive)
(magit-confirm 'reset-bisect)
(magit-run-git "bisect" "reset")
(ignore-errors (delete-file (magit-git-dir "BISECT_CMD_OUTPUT"))))
;;;###autoload
(defun magit-bisect-good ()
"While bisecting, mark the current commit as good.
Use this after you have asserted that the commit does not contain
the bug in question."
(interactive)
(magit-git-bisect (or (cadr (magit-bisect-terms))
(user-error "Not bisecting"))))
;;;###autoload
(defun magit-bisect-bad ()
"While bisecting, mark the current commit as bad.
Use this after you have asserted that the commit does contain the
bug in question."
(interactive)
(magit-git-bisect (or (car (magit-bisect-terms))
(user-error "Not bisecting"))))
;;;###autoload
(defun magit-bisect-mark ()
"While bisecting, mark the current commit with a bisect term.
During a bisect using alternate terms, commits can still be
marked with `magit-bisect-good' and `magit-bisect-bad', as those
commands map to the correct term (\"good\" to --term-old's value
and \"bad\" to --term-new's). However, in some cases, it can be
difficult to keep that mapping straight in your head; this
command provides an interface that exposes the underlying terms."
(interactive)
(magit-git-bisect
(pcase-let ((`(,term-new ,term-old) (or (magit-bisect-terms)
(user-error "Not bisecting"))))
(pcase (read-char-choice
(format "Mark HEAD as %s ([n]ew) or %s ([o]ld)"
term-new term-old)
(list ?n ?o))
(?n term-new)
(?o term-old)))))
;;;###autoload
(defun magit-bisect-skip ()
"While bisecting, skip the current commit.
Use this if for some reason the current commit is not a good one
to test. This command lets Git choose a different one."
(interactive)
(magit-git-bisect "skip"))
;;;###autoload
(defun magit-bisect-run (cmdline &optional bad good args)
"Bisect automatically by running commands after each step.
Unlike `git bisect run' this can be used before bisecting has
begun. In that case it behaves like `git bisect start; git
bisect run'."
(interactive (let ((args (and (not (magit-bisect-in-progress-p))
(magit-bisect-start-read-args))))
(cons (read-shell-command "Bisect shell command: ") args)))
(when (and bad good)
;; Avoid `magit-git-bisect' because it's asynchronous, but the
;; next `git bisect run' call requires the bisect to be started.
(magit-with-toplevel
(magit-process-git
(list :file (magit-git-dir "BISECT_CMD_OUTPUT"))
(magit-process-git-arguments
(list "bisect" "start" bad good args)))
(magit-refresh)))
(magit--with-connection-local-variables
(magit-git-bisect "run" (list shell-file-name
shell-command-switch cmdline))))
(defun magit-git-bisect (subcommand &optional args no-assert)
(unless (or no-assert (magit-bisect-in-progress-p))
(user-error "Not bisecting"))
(message "Bisecting...")
(magit-with-toplevel
(magit-run-git-async "bisect" subcommand args))
(set-process-sentinel
magit-this-process
(lambda (process event)
(when (memq (process-status process) '(exit signal))
(if (> (process-exit-status process) 0)
(magit-process-sentinel process event)
(process-put process 'inhibit-refresh t)
(magit-process-sentinel process event)
(when (buffer-live-p (process-buffer process))
(with-current-buffer (process-buffer process)
(when-let* ((section (magit-section-at))
(output (buffer-substring-no-properties
(oref section content)
(oref section end))))
(with-temp-file (magit-git-dir "BISECT_CMD_OUTPUT")
(insert output)))))
(magit-refresh))
(message "Bisecting...done")))))
;;; Sections
(defun magit-bisect-in-progress-p ()
(file-exists-p (magit-git-dir "BISECT_LOG")))
(defun magit-bisect-terms ()
(magit-file-lines (magit-git-dir "BISECT_TERMS")))
(defun magit-insert-bisect-output ()
"While bisecting, insert section with output from `git bisect'."
(when (magit-bisect-in-progress-p)
(let* ((lines
(or (magit-file-lines (magit-git-dir "BISECT_CMD_OUTPUT"))
(list "Bisecting: (no saved bisect output)"
"It appears you have invoked `git bisect' from a shell."
"There is nothing wrong with that, we just cannot display"
"anything useful here. Consult the shell output instead.")))
(done-re "^\\([a-z0-9]\\{40,\\}\\) is the first bad commit$")
(bad-line (or (and (string-match done-re (car lines))
(pop lines))
(--first (string-match done-re it) lines))))
(magit-insert-section ((eval (if bad-line 'commit 'bisect-output))
(and bad-line (match-string 1 bad-line)))
(magit-insert-heading
(propertize (or bad-line (pop lines))
'font-lock-face 'magit-section-heading))
(dolist (line lines)
(insert line "\n"))))
(insert "\n")))
(defun magit-insert-bisect-rest ()
"While bisecting, insert section visualizing the bisect state."
(when (magit-bisect-in-progress-p)
(magit-insert-section (bisect-view)
(magit-insert-heading "Bisect Rest:")
(magit-git-wash (apply-partially #'magit-log-wash-log 'bisect-vis)
"bisect" "visualize" "git" "log"
"--format=%h%x00%D%x00%s" "--decorate=full"
(and magit-bisect-show-graph "--graph")))))
(defun magit-insert-bisect-log ()
"While bisecting, insert section logging bisect progress."
(when (magit-bisect-in-progress-p)
(magit-insert-section (bisect-log)
(magit-insert-heading "Bisect Log:")
(magit-git-wash #'magit-wash-bisect-log "bisect" "log")
(insert ?\n))))
(defun magit-wash-bisect-log (_args)
(let (beg)
(while (progn (setq beg (point-marker))
(re-search-forward "^\\(git bisect [^\n]+\n\\)" nil t))
(magit-bind-match-strings (heading) nil
(magit-delete-match)
(save-restriction
(narrow-to-region beg (point))
(goto-char (point-min))
(magit-insert-section (bisect-item heading t)
(insert (propertize heading 'font-lock-face
'magit-section-secondary-heading))
(magit-insert-heading)
(magit-wash-sequence
(apply-partially #'magit-log-wash-rev 'bisect-log
(magit-abbrev-length)))
(insert ?\n)))))
(when (re-search-forward
"# first bad commit: \\[\\([a-z0-9]\\{40,\\}\\)\\] [^\n]+\n" nil t)
(magit-bind-match-strings (hash) nil
(magit-delete-match)
(magit-insert-section (bisect-item)
(insert hash " is the first bad commit\n"))))))
;;; _
(provide 'magit-bisect)
;;; magit-bisect.el ends here

984
code/elpa/magit-20220821.1819/magit-blame.el Normal file
View File

@ -0,0 +1,984 @@
;;; magit-blame.el --- Blame support for Magit -*- lexical-binding:t -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Annotates each line in file-visiting buffer with information from
;; the revision which last modified the line.
;;; Code:
(require 'magit)
;;; Options
(defgroup magit-blame nil
"Blame support for Magit."
:link '(info-link "(magit)Blaming")
:group 'magit-modes)
(defcustom magit-blame-styles
'((headings
(heading-format . "%-20a %C %s\n"))
(highlight
(highlight-face . magit-blame-highlight))
(lines
(show-lines . t)
(show-message . t)))
"List of styles used to visualize blame information.
The style used in the current buffer can be cycled from the blame
popup. Blame commands (except `magit-blame-echo') use the first
style as the initial style when beginning to blame in a buffer.
Each entry has the form (IDENT (KEY . VALUE)...). IDENT has
to be a symbol uniquely identifying the style. The following
KEYs are recognized:
`show-lines'
Whether to prefix each chunk of lines with a thin line.
This has no effect if `heading-format' is non-nil.
`show-message'
Whether to display a commit's summary line in the echo area
when crossing chunks.
`highlight-face'
Face used to highlight the first line of each chunk.
If this is nil, then those lines are not highlighted.
`heading-format'
String specifying the information to be shown above each
chunk of lines. It must end with a newline character.
`margin-format'
String specifying the information to be shown in the left
buffer margin. It must NOT end with a newline character.
This can also be a list of formats used for the lines at
the same positions within the chunk. If the chunk has
more lines than formats are specified, then the last is
repeated. WARNING: Adding this key affects performance;
see the note at the end of this docstring.
`margin-width'
Width of the margin, provided `margin-format' is non-nil.
`margin-face'
Face used in the margin, provided `margin-format' is
non-nil. This face is used in combination with the faces
that are specific to the used %-specs. If this is nil,
then `magit-blame-margin' is used.
`margin-body-face'
Face used in the margin for all but first line of a chunk.
This face is used in combination with the faces that are
specific to the used %-specs. This can also be a list of
faces (usually one face), in which case only these faces
are used and the %-spec faces are ignored. A good value
might be `(magit-blame-dimmed)'. If this is nil, then
the same face as for the first line is used.
The following %-specs can be used in `heading-format' and
`margin-format':
%H hash using face `magit-blame-hash'
%s summary using face `magit-blame-summary'
%a author using face `magit-blame-name'
%A author time using face `magit-blame-date'
%c committer using face `magit-blame-name'
%C committer time using face `magit-blame-date'
Additionally if `margin-format' ends with %f, then the string
that is displayed in the margin is made at least `margin-width'
characters wide, which may be desirable if the used face sets
the background color.
Blame information is displayed using overlays. Such extensive
use of overlays is known to slow down even basic operations, such
as moving the cursor. To reduce the number of overlays the margin
style had to be removed from the default value of this option.
Note that the margin overlays are created even if another style
is currently active. This can only be prevented by not even
defining a style that uses the margin. If you want to use this
style anyway, you can restore this definition, which used to be
part of the default value:
(margin
(margin-format . (\" %s%f\" \" %C %a\" \" %H\"))
(margin-width . 42)
(margin-face . magit-blame-margin)
(margin-body-face . (magit-blame-dimmed)))"
:package-version '(magit . "2.13.0")
:group 'magit-blame
:type 'string)
(defcustom magit-blame-echo-style 'lines
"The blame visualization style used by `magit-blame-echo'.
A symbol that has to be used as the identifier for one of the
styles defined in `magit-blame-styles'."
:package-version '(magit . "2.13.0")
:group 'magit-blame
:type 'symbol)
(defcustom magit-blame-time-format "%F %H:%M"
"Format for time strings in blame headings."
:group 'magit-blame
:type 'string)
(defcustom magit-blame-read-only t
"Whether to initially make the blamed buffer read-only."
:package-version '(magit . "2.13.0")
:group 'magit-blame
:type 'boolean)
(defcustom magit-blame-disable-modes '(fci-mode yascroll-bar-mode)
"List of modes not compatible with Magit-Blame mode.
This modes are turned off when Magit-Blame mode is turned on,
and then turned on again when turning off the latter."
:group 'magit-blame
:type '(repeat (symbol :tag "Mode")))
(defcustom magit-blame-mode-lighter " Blame"
"The mode-line lighter of the Magit-Blame mode."
:group 'magit-blame
:type '(choice (const :tag "No lighter" "") string))
(defcustom magit-blame-goto-chunk-hook
'(magit-blame-maybe-update-revision-buffer
magit-blame-maybe-show-message)
"Hook run after point entered another chunk."
:package-version '(magit . "2.13.0")
:group 'magit-blame
:type 'hook
:get #'magit-hook-custom-get
:options '(magit-blame-maybe-update-revision-buffer
magit-blame-maybe-show-message))
;;; Faces
(defface magit-blame-highlight
`((((class color) (background light))
,@(and (>= emacs-major-version 27) '(:extend t))
:background "grey80"
:foreground "black")
(((class color) (background dark))
,@(and (>= emacs-major-version 27) '(:extend t))
:background "grey25"
:foreground "white"))
"Face used for highlighting when blaming.
Also see option `magit-blame-styles'."
:group 'magit-faces)
(defface magit-blame-margin
'((t :inherit magit-blame-highlight
:weight normal
:slant normal))
"Face used for the blame margin by default when blaming.
Also see option `magit-blame-styles'."
:group 'magit-faces)
(defface magit-blame-dimmed
'((t :inherit magit-dimmed
:weight normal
:slant normal))
"Face used for the blame margin in some cases when blaming.
Also see option `magit-blame-styles'."
:group 'magit-faces)
(defface magit-blame-heading
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:inherit magit-blame-highlight
:weight normal
:slant normal))
"Face used for blame headings by default when blaming.
Also see option `magit-blame-styles'."
:group 'magit-faces)
(defface magit-blame-summary '((t nil))
"Face used for commit summaries when blaming."
:group 'magit-faces)
(defface magit-blame-hash '((t nil))
"Face used for commit hashes when blaming."
:group 'magit-faces)
(defface magit-blame-name '((t nil))
"Face used for author and committer names when blaming."
:group 'magit-faces)
(defface magit-blame-date '((t nil))
"Face used for dates when blaming."
:group 'magit-faces)
;;; Variables
(defvar-local magit-blame-buffer-read-only nil)
(defvar-local magit-blame-cache nil)
(defvar-local magit-blame-disabled-modes nil)
(defvar-local magit-blame-process nil)
(defvar-local magit-blame-recursive-p nil)
(defvar-local magit-blame-type nil)
(defvar-local magit-blame-separator nil)
(defvar-local magit-blame-previous-chunk nil)
(defvar-local magit-blame--make-margin-overlays nil)
(defvar-local magit-blame--style nil)
;;; Chunks
(defclass magit-blame-chunk ()
(;; <orig-rev> <orig-line> <final-line> <num-lines>
(orig-rev :initarg :orig-rev)
(orig-line :initarg :orig-line)
(final-line :initarg :final-line)
(num-lines :initarg :num-lines)
;; previous <prev-rev> <prev-file>
(prev-rev :initform nil)
(prev-file :initform nil)
;; filename <orig-file>
(orig-file)))
(defun magit-current-blame-chunk (&optional type noerror)
(or (and (not (and type (not (eq type magit-blame-type))))
(magit-blame-chunk-at (point)))
(and type
(let ((rev (or magit-buffer-refname magit-buffer-revision))
(file (and (not (derived-mode-p 'dired-mode))
(magit-file-relative-name
nil (not magit-buffer-file-name))))
(line (format "%i,+1" (line-number-at-pos))))
(cond (file (with-temp-buffer
(magit-with-toplevel
(magit-git-insert
"blame" "--porcelain"
(if (memq magit-blame-type '(final removal))
(cons "--reverse" (magit-blame-arguments))
(magit-blame-arguments))
"-L" line rev "--" file)
(goto-char (point-min))
(if (eobp)
(unless noerror
(error "Cannot get blame chunk at eob"))
(car (magit-blame--parse-chunk type))))))
(noerror nil)
(t (error "Buffer does not visit a tracked file")))))))
(defun magit-blame-chunk-at (pos)
(--some (overlay-get it 'magit-blame-chunk)
(overlays-at pos)))
(defun magit-blame--overlay-at (&optional pos key)
(unless pos
(setq pos (point)))
(--first (overlay-get it (or key 'magit-blame-chunk))
(nconc (overlays-at pos)
(overlays-in pos pos))))
;;; Keymaps
(defvar magit-blame-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "C-c C-q") 'magit-blame-quit)
map)
"Keymap for `magit-blame-mode'.
Note that most blaming key bindings are defined
in `magit-blame-read-only-mode-map' instead.")
(defvar magit-blame-read-only-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "C-m") #'magit-show-commit)
(define-key map (kbd "p") #'magit-blame-previous-chunk)
(define-key map (kbd "P") #'magit-blame-previous-chunk-same-commit)
(define-key map (kbd "n") #'magit-blame-next-chunk)
(define-key map (kbd "N") #'magit-blame-next-chunk-same-commit)
(define-key map (kbd "b") #'magit-blame-addition)
(define-key map (kbd "r") #'magit-blame-removal)
(define-key map (kbd "f") #'magit-blame-reverse)
(define-key map (kbd "B") #'magit-blame)
(define-key map (kbd "c") #'magit-blame-cycle-style)
(define-key map (kbd "q") #'magit-blame-quit)
(define-key map (kbd "M-w") #'magit-blame-copy-hash)
(define-key map (kbd "SPC") #'magit-diff-show-or-scroll-up)
(define-key map (kbd "S-SPC") #'magit-diff-show-or-scroll-down)
(define-key map (kbd "DEL") #'magit-diff-show-or-scroll-down)
map)
"Keymap for `magit-blame-read-only-mode'.")
;;; Modes
;;;; Base Mode
(define-minor-mode magit-blame-mode
"Display blame information inline."
:lighter magit-blame-mode-lighter
(cond (magit-blame-mode
(when (called-interactively-p 'any)
(setq magit-blame-mode nil)
(user-error
(concat "Don't call `magit-blame-mode' directly; "
"instead use `magit-blame'")))
(add-hook 'after-save-hook #'magit-blame--refresh t t)
(add-hook 'post-command-hook #'magit-blame-goto-chunk-hook t t)
(add-hook 'before-revert-hook #'magit-blame--remove-overlays t t)
(add-hook 'after-revert-hook #'magit-blame--refresh t t)
(add-hook 'read-only-mode-hook #'magit-blame-toggle-read-only t t)
(setq magit-blame-buffer-read-only buffer-read-only)
(when (or magit-blame-read-only magit-buffer-file-name)
(read-only-mode 1))
(dolist (mode magit-blame-disable-modes)
(when (and (boundp mode) (symbol-value mode))
(funcall mode -1)
(push mode magit-blame-disabled-modes)))
(setq magit-blame-separator (magit-blame--format-separator))
(unless magit-blame--style
(setq magit-blame--style (car magit-blame-styles)))
(setq magit-blame--make-margin-overlays
(and (cl-find-if (lambda (style)
(assq 'margin-format (cdr style)))
magit-blame-styles)))
(magit-blame--update-margin))
(t
(when (process-live-p magit-blame-process)
(kill-process magit-blame-process)
(while magit-blame-process
(sit-for 0.01))) ; avoid racing the sentinel
(remove-hook 'after-save-hook #'magit-blame--refresh t)
(remove-hook 'post-command-hook #'magit-blame-goto-chunk-hook t)
(remove-hook 'before-revert-hook #'magit-blame--remove-overlays t)
(remove-hook 'after-revert-hook #'magit-blame--refresh t)
(remove-hook 'read-only-mode-hook #'magit-blame-toggle-read-only t)
(unless magit-blame-buffer-read-only
(read-only-mode -1))
(magit-blame-read-only-mode -1)
(dolist (mode magit-blame-disabled-modes)
(funcall mode 1))
(kill-local-variable 'magit-blame-disabled-modes)
(kill-local-variable 'magit-blame-type)
(kill-local-variable 'magit-blame--style)
(magit-blame--update-margin)
(magit-blame--remove-overlays))))
(defun magit-blame--refresh ()
(magit-blame--run (magit-blame-arguments)))
(defun magit-blame-goto-chunk-hook ()
(let ((chunk (magit-blame-chunk-at (point))))
(when (cl-typep chunk 'magit-blame-chunk)
(unless (eq chunk magit-blame-previous-chunk)
(run-hooks 'magit-blame-goto-chunk-hook))
(setq magit-blame-previous-chunk chunk))))
(defun magit-blame-toggle-read-only ()
(magit-blame-read-only-mode (if buffer-read-only 1 -1)))
;;;; Read-Only Mode
(define-minor-mode magit-blame-read-only-mode
"Provide keybindings for Magit-Blame mode.
This minor-mode provides the key bindings for Magit-Blame mode,
but only when Read-Only mode is also enabled because these key
bindings would otherwise conflict badly with regular bindings.
When both Magit-Blame mode and Read-Only mode are enabled, then
this mode gets automatically enabled too and when one of these
modes is toggled, then this mode also gets toggled automatically.
\\{magit-blame-read-only-mode-map}")
;;;; Kludges
(defun magit-blame-put-keymap-before-view-mode ()
"Put `magit-blame-read-only-mode' ahead of `view-mode' in `minor-mode-map-alist'."
(--when-let (assq 'magit-blame-read-only-mode
(cl-member 'view-mode minor-mode-map-alist :key #'car))
(setq minor-mode-map-alist
(cons it (delq it minor-mode-map-alist))))
(remove-hook 'view-mode-hook #'magit-blame-put-keymap-before-view-mode))
(add-hook 'view-mode-hook #'magit-blame-put-keymap-before-view-mode)
;;; Process
(defun magit-blame--run (args)
(magit-with-toplevel
(unless magit-blame-mode
(magit-blame-mode 1))
(message "Blaming...")
(magit-blame-run-process
(or magit-buffer-refname magit-buffer-revision)
(magit-file-relative-name nil (not magit-buffer-file-name))
(if (memq magit-blame-type '(final removal))
(cons "--reverse" args)
args)
(list (line-number-at-pos (window-start))
(line-number-at-pos (1- (window-end nil t)))))
(set-process-sentinel magit-this-process
#'magit-blame-process-quickstart-sentinel)))
(defun magit-blame-run-process (revision file args &optional lines)
(let ((process (magit-parse-git-async
"blame" "--incremental" args
(and lines (list "-L" (apply #'format "%s,%s" lines)))
revision "--" file)))
(set-process-filter process #'magit-blame-process-filter)
(set-process-sentinel process #'magit-blame-process-sentinel)
(process-put process 'arguments (list revision file args))
(setq magit-blame-cache (make-hash-table :test #'equal))
(setq magit-blame-process process)))
(defun magit-blame-process-quickstart-sentinel (process event)
(when (memq (process-status process) '(exit signal))
(magit-blame-process-sentinel process event t)
(magit-blame-assert-buffer process)
(with-current-buffer (process-get process 'command-buf)
(when magit-blame-mode
(let ((default-directory (magit-toplevel)))
(apply #'magit-blame-run-process
(process-get process 'arguments)))))))
(defun magit-blame-process-sentinel (process _event &optional quiet)
(let ((status (process-status process)))
(when (memq status '(exit signal))
(kill-buffer (process-buffer process))
(if (and (eq status 'exit)
(zerop (process-exit-status process)))
(unless quiet
(message "Blaming...done"))
(magit-blame-assert-buffer process)
(with-current-buffer (process-get process 'command-buf)
(if magit-blame-mode
(progn (magit-blame-mode -1)
(message "Blaming...failed"))
(message "Blaming...aborted"))))
(kill-local-variable 'magit-blame-process))))
(defun magit-blame-process-filter (process string)
(internal-default-process-filter process string)
(let ((buf (process-get process 'command-buf))
(pos (process-get process 'parsed))
(mark (process-mark process))
type cache)
(with-current-buffer buf
(setq type magit-blame-type)
(setq cache magit-blame-cache))
(with-current-buffer (process-buffer process)
(goto-char pos)
(while (and (< (point) mark)
(save-excursion (re-search-forward "^filename .+\n" nil t)))
(pcase-let* ((`(,chunk ,revinfo)
(magit-blame--parse-chunk type))
(rev (oref chunk orig-rev)))
(if revinfo
(puthash rev revinfo cache)
(setq revinfo
(or (gethash rev cache)
(puthash rev (magit-blame--commit-alist rev) cache))))
(magit-blame--make-overlays buf chunk revinfo))
(process-put process 'parsed (point))))))
(defun magit-blame--parse-chunk (type)
(let (chunk revinfo)
(unless (looking-at "^\\(.\\{40,\\}\\) \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\)")
(error "Blaming failed due to unexpected output: %s"
(buffer-substring-no-properties (point) (line-end-position))))
(with-slots (orig-rev orig-file prev-rev prev-file)
(setq chunk (magit-blame-chunk
:orig-rev (match-string 1)
:orig-line (string-to-number (match-string 2))
:final-line (string-to-number (match-string 3))
:num-lines (string-to-number (match-string 4))))
(forward-line)
(let (done)
(while (not done)
(cond ((looking-at "^filename \\(.+\\)")
(setq done t)
(setf orig-file (magit-decode-git-path (match-string 1))))
((looking-at "^previous \\(.\\{40,\\}\\) \\(.+\\)")
(setf prev-rev (match-string 1))
(setf prev-file (magit-decode-git-path (match-string 2))))
((looking-at "^\\([^ ]+\\) \\(.+\\)")
(push (cons (match-string 1)
(match-string 2)) revinfo)))
(forward-line)))
(when (and (eq type 'removal) prev-rev)
(cl-rotatef orig-rev prev-rev)
(cl-rotatef orig-file prev-file)
(setq revinfo nil)))
(list chunk revinfo)))
(defun magit-blame--commit-alist (rev)
(cl-mapcar 'cons
'("summary"
"author" "author-time" "author-tz"
"committer" "committer-time" "committer-tz")
(split-string (magit-rev-format "%s\v%an\v%ad\v%cn\v%cd" rev
"--date=format:%s\v%z")
"\v")))
(defun magit-blame-assert-buffer (process)
(unless (buffer-live-p (process-get process 'command-buf))
(kill-process process)
(user-error "Buffer being blamed has been killed")))
;;; Display
(defsubst magit-blame--style-get (key)
(cdr (assoc key (cdr magit-blame--style))))
(defun magit-blame--make-overlays (buf chunk revinfo)
(with-current-buffer buf
(save-excursion
(save-restriction
(widen)
(let* ((line (oref chunk final-line))
(beg (magit-blame--line-beginning-position line))
(end (magit-blame--line-beginning-position
(+ line (oref chunk num-lines))))
(before (magit-blame-chunk-at (1- beg))))
(when (and before
(equal (oref before orig-rev)
(oref chunk orig-rev)))
(setq beg (magit-blame--line-beginning-position
(oset chunk final-line (oref before final-line))))
(cl-incf (oref chunk num-lines)
(oref before num-lines)))
(magit-blame--remove-overlays beg end)
(when magit-blame--make-margin-overlays
(magit-blame--make-margin-overlays chunk revinfo beg end))
(magit-blame--make-heading-overlay chunk revinfo beg end)
(magit-blame--make-highlight-overlay chunk beg))))))
(defun magit-blame--line-beginning-position (line)
(save-excursion
(goto-char (point-min))
(forward-line (1- line))
(point)))
(defun magit-blame--make-margin-overlays (chunk revinfo _beg end)
(save-excursion
(let ((line 0))
(while (< (point) end)
(magit-blame--make-margin-overlay chunk revinfo line)
(forward-line)
(cl-incf line)))))
(defun magit-blame--make-margin-overlay (chunk revinfo line)
(let* ((end (line-end-position))
;; If possible avoid putting this on the first character
;; of the line to avoid a conflict with the line overlay.
(beg (min (1+ (line-beginning-position)) end))
(ov (make-overlay beg end)))
(overlay-put ov 'magit-blame-chunk chunk)
(overlay-put ov 'magit-blame-revinfo revinfo)
(overlay-put ov 'magit-blame-margin line)
(magit-blame--update-margin-overlay ov)))
(defun magit-blame--make-heading-overlay (chunk revinfo beg end)
(let ((ov (make-overlay beg end)))
(overlay-put ov 'magit-blame-chunk chunk)
(overlay-put ov 'magit-blame-revinfo revinfo)
(overlay-put ov 'magit-blame-heading t)
(magit-blame--update-heading-overlay ov)))
(defun magit-blame--make-highlight-overlay (chunk beg)
(let ((ov (make-overlay beg (save-excursion
(goto-char beg)
(1+ (line-end-position))))))
(overlay-put ov 'magit-blame-chunk chunk)
(overlay-put ov 'magit-blame-highlight t)
(magit-blame--update-highlight-overlay ov)))
(defun magit-blame--update-margin ()
(setq left-margin-width (or (magit-blame--style-get 'margin-width) 0))
(set-window-buffer (selected-window) (current-buffer)))
(defun magit-blame--update-overlays ()
(save-restriction
(widen)
(dolist (ov (overlays-in (point-min) (point-max)))
(cond ((overlay-get ov 'magit-blame-heading)
(magit-blame--update-heading-overlay ov))
((overlay-get ov 'magit-blame-margin)
(magit-blame--update-margin-overlay ov))
((overlay-get ov 'magit-blame-highlight)
(magit-blame--update-highlight-overlay ov))))))
(defun magit-blame--update-margin-overlay (ov)
(overlay-put
ov 'before-string
(and (magit-blame--style-get 'margin-width)
(propertize
"o" 'display
(list (list 'margin 'left-margin)
(let ((line (overlay-get ov 'magit-blame-margin))
(format (magit-blame--style-get 'margin-format))
(face (magit-blame--style-get 'margin-face)))
(magit-blame--format-string
ov
(or (and (atom format)
format)
(nth line format)
(car (last format)))
(or (and (not (zerop line))
(magit-blame--style-get 'margin-body-face))
face
'magit-blame-margin))))))))
(defun magit-blame--update-heading-overlay (ov)
(overlay-put
ov 'before-string
(--if-let (magit-blame--style-get 'heading-format)
(magit-blame--format-string ov it 'magit-blame-heading)
(and (magit-blame--style-get 'show-lines)
(or (not (magit-blame--style-get 'margin-format))
(save-excursion
(goto-char (overlay-start ov))
;; Special case of the special case described in
;; `magit-blame--make-margin-overlay'. For empty
;; lines it is not possible to show both overlays
;; without the line being to high.
(not (= (point) (line-end-position)))))
magit-blame-separator))))
(defun magit-blame--update-highlight-overlay (ov)
(overlay-put ov 'font-lock-face (magit-blame--style-get 'highlight-face)))
(defun magit-blame--format-string (ov format face)
(let* ((chunk (overlay-get ov 'magit-blame-chunk))
(revinfo (overlay-get ov 'magit-blame-revinfo))
(key (list format face))
(string (cdr (assoc key revinfo))))
(unless string
(setq string
(and format
(magit-blame--format-string-1 (oref chunk orig-rev)
revinfo format face)))
(nconc revinfo (list (cons key string))))
string))
(defun magit-blame--format-string-1 (rev revinfo format face)
(let ((str
(if (string-match-p "\\`0\\{40,\\}\\'" rev)
(propertize (concat (if (string-prefix-p "\s" format) "\s" "")
"Not Yet Committed"
(if (string-suffix-p "\n" format) "\n" ""))
'font-lock-face face)
(magit--format-spec
(propertize format 'font-lock-face face)
(cl-flet* ((p0 (s f)
(propertize s 'font-lock-face
(if face
(if (listp face)
face
(list f face))
f)))
(p1 (k f)
(p0 (cdr (assoc k revinfo)) f))
(p2 (k1 k2 f)
(p0 (magit-blame--format-time-string
(cdr (assoc k1 revinfo))
(cdr (assoc k2 revinfo)))
f)))
`((?H . ,(p0 rev 'magit-blame-hash))
(?s . ,(p1 "summary" 'magit-blame-summary))
(?a . ,(p1 "author" 'magit-blame-name))
(?c . ,(p1 "committer" 'magit-blame-name))
(?A . ,(p2 "author-time" "author-tz" 'magit-blame-date))
(?C . ,(p2 "committer-time" "committer-tz" 'magit-blame-date))
(?f . "")))))))
(if-let ((width (and (string-suffix-p "%f" format)
(magit-blame--style-get 'margin-width))))
(concat str
(propertize (make-string (max 0 (- width (length str))) ?\s)
'font-lock-face face))
str)))
(defun magit-blame--format-separator ()
(propertize
(concat (propertize "\s" 'display '(space :height (2)))
(propertize "\n" 'line-height t))
'font-lock-face `(:background
,(face-attribute 'magit-blame-heading
:background nil t)
,@(and (>= emacs-major-version 27) '(:extend t)))))
(defun magit-blame--format-time-string (time tz)
(let* ((time-format (or (magit-blame--style-get 'time-format)
magit-blame-time-format))
(tz-in-second (and (string-search "%z" time-format)
(car (last (parse-time-string tz))))))
(format-time-string time-format
(seconds-to-time (string-to-number time))
tz-in-second)))
(defun magit-blame--remove-overlays (&optional beg end)
(save-restriction
(widen)
(dolist (ov (overlays-in (or beg (point-min))
(or end (point-max))))
(when (overlay-get ov 'magit-blame-chunk)
(delete-overlay ov)))))
(defun magit-blame-maybe-show-message ()
(when (magit-blame--style-get 'show-message)
(let ((message-log-max 0))
(if-let ((msg (cdr (assoc "summary"
(gethash (oref (magit-current-blame-chunk)
orig-rev)
magit-blame-cache)))))
(progn (set-text-properties 0 (length msg) nil msg)
(message msg))
(message "Commit data not available yet. Still blaming.")))))
;;; Commands
;;;###autoload (autoload 'magit-blame-echo "magit-blame" nil t)
(transient-define-suffix magit-blame-echo (args)
"For each line show the revision in which it was added.
Show the information about the chunk at point in the echo area
when moving between chunks. Unlike other blaming commands, do
not turn on `read-only-mode'."
:if (lambda ()
(and buffer-file-name
(or (not magit-blame-mode)
buffer-read-only)))
(interactive (list (magit-blame-arguments)))
(when magit-buffer-file-name
(user-error "Blob buffers aren't supported"))
(setq-local magit-blame--style
(assq magit-blame-echo-style magit-blame-styles))
(setq-local magit-blame-disable-modes
(cons 'eldoc-mode magit-blame-disable-modes))
(if (not magit-blame-mode)
(let ((magit-blame-read-only nil))
(magit-blame--pre-blame-assert 'addition)
(magit-blame--pre-blame-setup 'addition)
(magit-blame--run args))
(read-only-mode -1)
(magit-blame--update-overlays)))
;;;###autoload (autoload 'magit-blame-addition "magit-blame" nil t)
(transient-define-suffix magit-blame-addition (args)
"For each line show the revision in which it was added."
(interactive (list (magit-blame-arguments)))
(magit-blame--pre-blame-assert 'addition)
(magit-blame--pre-blame-setup 'addition)
(magit-blame--run args))
;;;###autoload (autoload 'magit-blame-removal "magit-blame" nil t)
(transient-define-suffix magit-blame-removal (args)
"For each line show the revision in which it was removed."
:if-nil 'buffer-file-name
(interactive (list (magit-blame-arguments)))
(unless magit-buffer-file-name
(user-error "Only blob buffers can be blamed in reverse"))
(magit-blame--pre-blame-assert 'removal)
(magit-blame--pre-blame-setup 'removal)
(magit-blame--run args))
;;;###autoload (autoload 'magit-blame-reverse "magit-blame" nil t)
(transient-define-suffix magit-blame-reverse (args)
"For each line show the last revision in which it still exists."
:if-nil 'buffer-file-name
(interactive (list (magit-blame-arguments)))
(unless magit-buffer-file-name
(user-error "Only blob buffers can be blamed in reverse"))
(magit-blame--pre-blame-assert 'final)
(magit-blame--pre-blame-setup 'final)
(magit-blame--run args))
(defun magit-blame--pre-blame-assert (type)
(unless (magit-toplevel)
(magit--not-inside-repository-error))
(if (and magit-blame-mode
(eq type magit-blame-type))
(if-let ((chunk (magit-current-blame-chunk)))
(unless (oref chunk prev-rev)
(user-error "Chunk has no further history"))
(user-error "Commit data not available yet. Still blaming."))
(unless (magit-file-relative-name nil (not magit-buffer-file-name))
(if buffer-file-name
(user-error "Buffer isn't visiting a tracked file")
(user-error "Buffer isn't visiting a file")))))
(defun magit-blame--pre-blame-setup (type)
(when magit-blame-mode
(if (eq type magit-blame-type)
(let ((style magit-blame--style))
(magit-blame-visit-other-file)
(setq-local magit-blame--style style)
(setq-local magit-blame-recursive-p t)
;; Set window-start for the benefit of quickstart.
(redisplay))
(magit-blame--remove-overlays)))
(setq magit-blame-type type))
(defun magit-blame-visit-other-file ()
"Visit another blob related to the current chunk."
(interactive)
(with-slots (prev-rev prev-file orig-line)
(magit-current-blame-chunk)
(unless prev-rev
(user-error "Chunk has no further history"))
(magit-with-toplevel
(magit-find-file prev-rev prev-file))
;; TODO Adjust line like magit-diff-visit-file.
(goto-char (point-min))
(forward-line (1- orig-line))))
(defun magit-blame-visit-file ()
"Visit the blob related to the current chunk."
(interactive)
(with-slots (orig-rev orig-file orig-line)
(magit-current-blame-chunk)
(magit-with-toplevel
(magit-find-file orig-rev orig-file))
(goto-char (point-min))
(forward-line (1- orig-line))))
(transient-define-suffix magit-blame-quit ()
"Turn off Magit-Blame mode.
If the buffer was created during a recursive blame,
then also kill the buffer."
:if-non-nil 'magit-blame-mode
(interactive)
(magit-blame-mode -1)
(when magit-blame-recursive-p
(kill-buffer)))
(defun magit-blame-next-chunk ()
"Move to the next chunk."
(interactive)
(--if-let (next-single-char-property-change (point) 'magit-blame-chunk)
(goto-char it)
(user-error "No more chunks")))
(defun magit-blame-previous-chunk ()
"Move to the previous chunk."
(interactive)
(--if-let (previous-single-char-property-change (point) 'magit-blame-chunk)
(goto-char it)
(user-error "No more chunks")))
(defun magit-blame-next-chunk-same-commit (&optional previous)
"Move to the next chunk from the same commit.\n\n(fn)"
(interactive)
(if-let ((rev (oref (magit-current-blame-chunk) orig-rev)))
(let ((pos (point)) ov)
(save-excursion
(while (and (not ov)
(not (= pos (if previous (point-min) (point-max))))
(setq pos (funcall
(if previous
#'previous-single-char-property-change
#'next-single-char-property-change)
pos 'magit-blame-chunk)))
(--when-let (magit-blame--overlay-at pos)
(when (equal (oref (magit-blame-chunk-at pos) orig-rev) rev)
(setq ov it)))))
(if ov
(goto-char (overlay-start ov))
(user-error "No more chunks from same commit")))
(user-error "This chunk hasn't been blamed yet")))
(defun magit-blame-previous-chunk-same-commit ()
"Move to the previous chunk from the same commit."
(interactive)
(magit-blame-next-chunk-same-commit #'previous-single-char-property-change))
(defun magit-blame-cycle-style ()
"Change how blame information is visualized.
Cycle through the elements of option `magit-blame-styles'."
(interactive)
(setq magit-blame--style
(or (cadr (cl-member (car magit-blame--style)
magit-blame-styles :key #'car))
(car magit-blame-styles)))
(magit-blame--update-margin)
(magit-blame--update-overlays))
(defun magit-blame-copy-hash ()
"Save hash of the current chunk's commit to the kill ring.
When the region is active, then save the region's content
instead of the hash, like `kill-ring-save' would."
(interactive)
(if (use-region-p)
(call-interactively #'copy-region-as-kill)
(kill-new (message "%s" (oref (magit-current-blame-chunk) orig-rev)))))
;;; Popup
;;;###autoload (autoload 'magit-blame "magit-blame" nil t)
(transient-define-prefix magit-blame ()
"Show the commits that added or removed lines in the visited file."
:man-page "git-blame"
:value '("-w")
["Arguments"
("-w" "Ignore whitespace" "-w")
("-r" "Do not treat root commits as boundaries" "--root")
("-P" "Follow only first parent" "--first-parent")
(magit-blame:-M)
(magit-blame:-C)]
["Actions"
("b" "Show commits adding lines" magit-blame-addition)
("r" "Show commits removing lines" magit-blame-removal)
("f" "Show last commits that still have lines" magit-blame-reverse)
("m" "Blame echo" magit-blame-echo)
("q" "Quit blaming" magit-blame-quit)]
["Refresh"
:if-non-nil magit-blame-mode
("c" "Cycle style" magit-blame-cycle-style :transient t)])
(defun magit-blame-arguments ()
(transient-args 'magit-blame))
(transient-define-argument magit-blame:-M ()
:description "Detect lines moved or copied within a file"
:class 'transient-option
:argument "-M"
:allow-empty t
:reader #'transient-read-number-N+)
(transient-define-argument magit-blame:-C ()
:description "Detect lines moved or copied between files"
:class 'transient-option
:argument "-C"
:allow-empty t
:reader #'transient-read-number-N+)
;;; Utilities
(defun magit-blame-maybe-update-revision-buffer ()
(when-let* ((chunk (magit-current-blame-chunk))
(commit (oref chunk orig-rev))
(buffer (magit-get-mode-buffer 'magit-revision-mode nil t)))
(if magit--update-revision-buffer
(setq magit--update-revision-buffer (list commit buffer))
(setq magit--update-revision-buffer (list commit buffer))
(run-with-idle-timer
magit-update-other-window-delay nil
(lambda ()
(pcase-let ((`(,rev ,buf) magit--update-revision-buffer))
(setq magit--update-revision-buffer nil)
(when (buffer-live-p buf)
(let ((magit-display-buffer-noselect t))
(apply #'magit-show-commit rev
(magit-diff-arguments 'magit-revision-mode))))))))))
;;; _
(provide 'magit-blame)
;;; magit-blame.el ends here

131
code/elpa/magit-20220821.1819/magit-bookmark.el Normal file
View File

@ -0,0 +1,131 @@
;;; magit-bookmark.el --- Bookmark support for Magit -*- lexical-binding:t -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Inspired by an earlier implementation by Yuri Khan.
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Support for bookmarks for most Magit buffers.
;;; Code:
(require 'magit)
;;; Diff
;;;; Diff
(put 'magit-diff-mode 'magit-bookmark-variables
'(magit-buffer-range-hashed
magit-buffer-typearg
magit-buffer-diff-args
magit-buffer-diff-files))
(cl-defmethod magit-bookmark-name (&context (major-mode magit-diff-mode))
(format "magit-diff(%s%s)"
(pcase (magit-diff-type)
('staged "staged")
('unstaged "unstaged")
('committed magit-buffer-range)
('undefined
(delq nil (list magit-buffer-typearg magit-buffer-range-hashed))))
(if magit-buffer-diff-files
(concat " -- " (mapconcat #'identity magit-buffer-diff-files " "))
"")))
;;;; Revision
(put 'magit-revision-mode 'magit-bookmark-variables
'(magit-buffer-revision-hash
magit-buffer-diff-args
magit-buffer-diff-files))
(cl-defmethod magit-bookmark-name (&context (major-mode magit-revision-mode))
(format "magit-revision(%s %s)"
(magit-rev-abbrev magit-buffer-revision)
(if magit-buffer-diff-files
(mapconcat #'identity magit-buffer-diff-files " ")
(magit-rev-format "%s" magit-buffer-revision))))
;;;; Stash
(put 'magit-stash-mode 'magit-bookmark-variables
'(magit-buffer-revision-hash
magit-buffer-diff-args
magit-buffer-diff-files))
(cl-defmethod magit-bookmark-name (&context (major-mode magit-stash-mode))
(format "magit-stash(%s %s)"
(magit-rev-abbrev magit-buffer-revision)
(if magit-buffer-diff-files
(mapconcat #'identity magit-buffer-diff-files " ")
(magit-rev-format "%s" magit-buffer-revision))))
;;; Log
;;;; Log
(put 'magit-log-mode 'magit-bookmark-variables
'(magit-buffer-revisions
magit-buffer-log-args
magit-buffer-log-files))
(cl-defmethod magit-bookmark-name (&context (major-mode magit-log-mode))
(format "magit-log(%s%s)"
(mapconcat #'identity magit-buffer-revisions " ")
(if magit-buffer-log-files
(concat " -- " (mapconcat #'identity magit-buffer-log-files " "))
"")))
;;;; Cherry
(put 'magit-cherry-mode 'magit-bookmark-variables
'(magit-buffer-refname
magit-buffer-upstream))
(cl-defmethod magit-bookmark-name (&context (major-mode magit-cherry-mode))
(format "magit-cherry(%s > %s)"
magit-buffer-refname
magit-buffer-upstream))
;;;; Reflog
(put 'magit-reflog-mode 'magit-bookmark-variables
'(magit-buffer-refname))
(cl-defmethod magit-bookmark-name (&context (major-mode magit-reflog-mode))
(format "magit-reflog(%s)" magit-buffer-refname))
;;; Misc
(put 'magit-status-mode 'magit-bookmark-variables nil)
(put 'magit-refs-mode 'magit-bookmark-variables
'(magit-buffer-upstream
magit-buffer-arguments))
(put 'magit-stashes-mode 'magit-bookmark-variables nil)
(cl-defmethod magit-bookmark-name (&context (major-mode magit-stashes-mode))
(format "magit-states(%s)" magit-buffer-refname))
;;; _
(provide 'magit-bookmark)
;;; magit-bookmark.el ends here

934
code/elpa/magit-20220821.1819/magit-branch.el Normal file
View File

@ -0,0 +1,934 @@
;;; magit-branch.el --- Branch support -*- lexical-binding:t -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library implements support for branches. It defines commands
;; for creating, checking out, manipulating, and configuring branches.
;; Commands defined here are mainly concerned with branches as
;; pointers, commands that deal with what a branch points at, are
;; defined elsewhere.
;;; Code:
(require 'magit)
(require 'magit-reset)
;;; Options
(defcustom magit-branch-read-upstream-first t
"Whether to read upstream before name of new branch when creating a branch.
`nil' Read the branch name first.
`t' Read the upstream first.
`fallback' Read the upstream first, but if it turns out that the chosen
value is not a valid upstream (because it cannot be resolved
as an existing revision), then treat it as the name of the
new branch and continue by reading the upstream next."
:package-version '(magit . "2.2.0")
:group 'magit-commands
:type '(choice (const :tag "read branch name first" nil)
(const :tag "read upstream first" t)
(const :tag "read upstream first, with fallback" fallback)))
(defcustom magit-branch-prefer-remote-upstream nil
"Whether to favor remote upstreams when creating new branches.
When a new branch is created, then the branch, commit, or stash
at point is suggested as the default starting point of the new
branch, or if there is no such revision at point the current
branch. In either case the user may choose another starting
point.
If the chosen starting point is a branch, then it may also be set
as the upstream of the new branch, depending on the value of the
Git variable `branch.autoSetupMerge'. By default this is done
for remote branches, but not for local branches.
You might prefer to always use some remote branch as upstream.
If the chosen starting point is (1) a local branch, (2) whose
name matches a member of the value of this option, (3) the
upstream of that local branch is a remote branch with the same
name, and (4) that remote branch can be fast-forwarded to the
local branch, then the chosen branch is used as starting point,
but its own upstream is used as the upstream of the new branch.
Members of this option's value are treated as branch names that
have to match exactly unless they contain a character that makes
them invalid as a branch name. Recommended characters to use
to trigger interpretation as a regexp are \"*\" and \"^\". Some
other characters which you might expect to be invalid, actually
are not, e.g. \".+$\" are all perfectly valid. More precisely,
if `git check-ref-format --branch STRING' exits with a non-zero
status, then treat STRING as a regexp.
Assuming the chosen branch matches these conditions you would end
up with with e.g.:
feature --upstream--> origin/master
instead of
feature --upstream--> master --upstream--> origin/master
Which you prefer is a matter of personal preference. If you do
prefer the former, then you should add branches such as \"master\",
\"next\", and \"maint\" to the value of this options."
:package-version '(magit . "2.4.0")
:group 'magit-commands
:type '(repeat string))
(defcustom magit-branch-adjust-remote-upstream-alist nil
"Alist of upstreams to be used when branching from remote branches.
When creating a local branch from an ephemeral branch located
on a remote, e.g. a feature or hotfix branch, then that remote
branch should usually not be used as the upstream branch, since
the push-remote already allows accessing it and having both the
upstream and the push-remote reference the same related branch
would be wasteful. Instead a branch like \"maint\" or \"master\"
should be used as the upstream.
This option allows specifying the branch that should be used as
the upstream when branching certain remote branches. The value
is an alist of the form ((UPSTREAM . RULE)...). The first
element is used whose UPSTREAM exists and whose RULE matches
the name of the new branch. Subsequent elements are ignored.
UPSTREAM is the branch to be used as the upstream for branches
specified by RULE. It can be a local or a remote branch.
RULE can either be a regular expression, matching branches whose
upstream should be the one specified by UPSTREAM. Or it can be
a list of the only branches that should *not* use UPSTREAM; all
other branches will. Matching is done after stripping the remote
part of the name of the branch that is being branched from.
If you use a finite set of non-ephemeral branches across all your
repositories, then you might use something like:
((\"origin/master\" . (\"master\" \"next\" \"maint\")))
Or if the names of all your ephemeral branches contain a slash,
at least in some repositories, then a good value could be:
((\"origin/master\" . \"/\"))
Of course you can also fine-tune:
((\"origin/maint\" . \"\\\\\\=`hotfix/\")
(\"origin/master\" . \"\\\\\\=`feature/\"))
UPSTREAM can be a local branch:
((\"master\" . (\"master\" \"next\" \"maint\")))
Because the main branch is no longer almost always named \"master\"
you should also account for other common names:
((\"main\" . (\"main\" \"master\" \"next\" \"maint\"))
(\"master\" . (\"main\" \"master\" \"next\" \"maint\")))
If you use remote branches as UPSTREAM, then you might also want
to set `magit-branch-prefer-remote-upstream' to a non-nil value.
However, I recommend that you use local branches as UPSTREAM."
:package-version '(magit . "2.9.0")
:group 'magit-commands
:type '(repeat (cons (string :tag "Use upstream")
(choice :tag "for branches"
(regexp :tag "matching")
(repeat :tag "except"
(string :tag "branch"))))))
(defcustom magit-branch-rename-push-target t
"Whether the push-remote setup is preserved when renaming a branch.
The command `magit-branch-rename' renames a branch named OLD to
NEW. This option controls how much of the push-remote setup is
preserved when doing so.
When nil, then preserve nothing and unset `branch.OLD.pushRemote'.
When `local-only', then first set `branch.NEW.pushRemote' to the
same value as `branch.OLD.pushRemote', provided the latter is
actually set and unless the former already has another value.
When t, then rename the branch named OLD on the remote specified
by `branch.OLD.pushRemote' to NEW, provided OLD exists on that
remote and unless NEW already exists on the remote.
When `forge-only' and the `forge' package is available, then
behave like `t' if the remote points to a repository on a forge
(currently Github or Gitlab), otherwise like `local-only'.
Another supported but obsolete value is `github-only'. It is a
misnomer because it now treated as an alias for `forge-only'."
:package-version '(magit . "2.90.0")
:group 'magit-commands
:type '(choice
(const :tag "Don't preserve push-remote setup" nil)
(const :tag "Preserve push-remote setup" local-only)
(const :tag "... and rename corresponding branch on remote" t)
(const :tag "... but only if remote is on a forge" forge-only)))
(defcustom magit-branch-direct-configure t
"Whether the command `magit-branch' shows Git variables.
When set to nil, no variables are displayed by this transient
command, instead the sub-transient `magit-branch-configure'
has to be used to view and change branch related variables."
:package-version '(magit . "2.7.0")
:group 'magit-commands
:type 'boolean)
(defcustom magit-published-branches '("origin/master")
"List of branches that are considered to be published."
:package-version '(magit . "2.13.0")
:group 'magit-commands
:type '(repeat string))
;;; Commands
;;;###autoload (autoload 'magit-branch "magit" nil t)
(transient-define-prefix magit-branch (branch)
"Add, configure or remove a branch."
:man-page "git-branch"
["Arguments"
(7 "-r" "Recurse submodules when checking out an existing branch"
"--recurse-submodules"
:if (lambda () (magit-git-version>= "2.13")))]
["Variables"
:if (lambda ()
(and magit-branch-direct-configure
(oref transient--prefix scope)))
("d" magit-branch.<branch>.description)
("u" magit-branch.<branch>.merge/remote)
("r" magit-branch.<branch>.rebase)
("p" magit-branch.<branch>.pushRemote)]
[["Checkout"
("b" "branch/revision" magit-checkout)
("l" "local branch" magit-branch-checkout)
(6 "o" "new orphan" magit-branch-orphan)]
[""
("c" "new branch" magit-branch-and-checkout)
("s" "new spin-off" magit-branch-spinoff)
(5 "w" "new worktree" magit-worktree-checkout)]
["Create"
("n" "new branch" magit-branch-create)
("S" "new spin-out" magit-branch-spinout)
(5 "W" "new worktree" magit-worktree-branch)]
["Do"
("C" "configure..." magit-branch-configure)
("m" "rename" magit-branch-rename)
("x" "reset" magit-branch-reset)
("k" "delete" magit-branch-delete)]
[""
(7 "h" "shelve" magit-branch-shelve)
(7 "H" "unshelve" magit-branch-unshelve)]]
(interactive (list (magit-get-current-branch)))
(transient-setup 'magit-branch nil nil :scope branch))
(defun magit-branch-arguments ()
(transient-args 'magit-branch))
;;;###autoload
(defun magit-checkout (revision &optional args)
"Checkout REVISION, updating the index and the working tree.
If REVISION is a local branch, then that becomes the current
branch. If it is something else, then `HEAD' becomes detached.
Checkout fails if the working tree or the staging area contain
changes.
\n(git checkout REVISION)."
(interactive (list (magit-read-other-branch-or-commit "Checkout")
(magit-branch-arguments)))
(when (string-match "\\`heads/\\(.+\\)" revision)
(setq revision (match-string 1 revision)))
(magit-run-git "checkout" args revision))
;;;###autoload
(defun magit-branch-create (branch start-point)
"Create BRANCH at branch or revision START-POINT."
(interactive (magit-branch-read-args "Create branch"))
(magit-call-git "branch" branch start-point)
(magit-branch-maybe-adjust-upstream branch start-point)
(magit-refresh))
;;;###autoload
(defun magit-branch-and-checkout (branch start-point &optional args)
"Create and checkout BRANCH at branch or revision START-POINT."
(interactive (append (magit-branch-read-args "Create and checkout branch")
(list (magit-branch-arguments))))
(if (string-match-p "^stash@{[0-9]+}$" start-point)
(magit-run-git "stash" "branch" branch start-point)
(magit-call-git "checkout" args "-b" branch start-point)
(magit-branch-maybe-adjust-upstream branch start-point)
(magit-refresh)))
;;;###autoload
(defun magit-branch-or-checkout (arg &optional start-point)
"Hybrid between `magit-checkout' and `magit-branch-and-checkout'.
Ask the user for an existing branch or revision. If the user
input actually can be resolved as a branch or revision, then
check that out, just like `magit-checkout' would.
Otherwise create and checkout a new branch using the input as
its name. Before doing so read the starting-point for the new
branch. This is similar to what `magit-branch-and-checkout'
does."
(interactive
(let ((arg (magit-read-other-branch-or-commit "Checkout")))
(list arg
(and (not (magit-commit-p arg))
(magit-read-starting-point "Create and checkout branch" arg)))))
(when (string-match "\\`heads/\\(.+\\)" arg)
(setq arg (match-string 1 arg)))
(if start-point
(magit-branch-and-checkout arg start-point)
(magit-checkout arg)))
;;;###autoload
(defun magit-branch-checkout (branch &optional start-point)
"Checkout an existing or new local branch.
Read a branch name from the user offering all local branches and
a subset of remote branches as candidates. Omit remote branches
for which a local branch by the same name exists from the list
of candidates. The user can also enter a completely new branch
name.
- If the user selects an existing local branch, then check that
out.
- If the user selects a remote branch, then create and checkout
a new local branch with the same name. Configure the selected
remote branch as push target.
- If the user enters a new branch name, then create and check
that out, after also reading the starting-point from the user.
In the latter two cases the upstream is also set. Whether it is
set to the chosen START-POINT or something else depends on the
value of `magit-branch-adjust-remote-upstream-alist', just like
when using `magit-branch-and-checkout'."
(interactive
(let* ((current (magit-get-current-branch))
(local (magit-list-local-branch-names))
(remote (--filter (and (string-match "[^/]+/" it)
(not (member (substring it (match-end 0))
(cons "HEAD" local))))
(magit-list-remote-branch-names)))
(choices (nconc (delete current local) remote))
(atpoint (magit-branch-at-point))
(choice (magit-completing-read
"Checkout branch" choices
nil nil nil 'magit-revision-history
(or (car (member atpoint choices))
(and atpoint
(car (member (and (string-match "[^/]+/" atpoint)
(substring atpoint (match-end 0)))
choices)))))))
(cond ((member choice remote)
(list (and (string-match "[^/]+/" choice)
(substring choice (match-end 0)))
choice))
((member choice local)
(list choice))
(t
(list choice (magit-read-starting-point "Create" choice))))))
(if (not start-point)
(magit-checkout branch (magit-branch-arguments))
(when (magit-anything-modified-p t)
(user-error "Cannot checkout when there are uncommitted changes"))
(let ((magit-inhibit-refresh t))
(magit-branch-and-checkout branch start-point))
(when (magit-remote-branch-p start-point)
(pcase-let ((`(,remote . ,remote-branch)
(magit-split-branch-name start-point)))
(when (and (equal branch remote-branch)
(not (equal remote (magit-get "remote.pushDefault"))))
(magit-set remote "branch" branch "pushRemote"))))
(magit-refresh)))
(defun magit-branch-maybe-adjust-upstream (branch start-point)
(--when-let
(or (and (magit-get-upstream-branch branch)
(magit-get-indirect-upstream-branch start-point))
(and (magit-remote-branch-p start-point)
(let ((name (cdr (magit-split-branch-name start-point))))
(-some (pcase-lambda (`(,upstream . ,rule))
(and (magit-branch-p upstream)
(if (listp rule)
(not (member name rule))
(string-match-p rule name))
upstream))
magit-branch-adjust-remote-upstream-alist))))
(magit-call-git "branch" (concat "--set-upstream-to=" it) branch)))
;;;###autoload
(defun magit-branch-orphan (branch start-point)
"Create and checkout an orphan BRANCH with contents from revision START-POINT."
(interactive (magit-branch-read-args "Create and checkout orphan branch"))
(magit-run-git "checkout" "--orphan" branch start-point))
(defun magit-branch-read-args (prompt &optional default-start)
(if magit-branch-read-upstream-first
(let ((choice (magit-read-starting-point prompt nil default-start)))
(if (magit-rev-verify choice)
(list (magit-read-string-ns
(if magit-completing-read--silent-default
(format "%s (starting at `%s')" prompt choice)
"Name for new branch")
(let ((def (mapconcat #'identity
(cdr (split-string choice "/"))
"/")))
(and (member choice (magit-list-remote-branch-names))
(not (member def (magit-list-local-branch-names)))
def)))
choice)
(if (eq magit-branch-read-upstream-first 'fallback)
(list choice
(magit-read-starting-point prompt choice default-start))
(user-error "Not a valid starting-point: %s" choice))))
(let ((branch (magit-read-string-ns (concat prompt " named"))))
(list branch (magit-read-starting-point prompt branch default-start)))))
;;;###autoload
(defun magit-branch-spinout (branch &optional from)
"Create new branch from the unpushed commits.
Like `magit-branch-spinoff' but remain on the current branch.
If there are any uncommitted changes, then behave exactly like
`magit-branch-spinoff'."
(interactive (list (magit-read-string-ns "Spin out branch")
(car (last (magit-region-values 'commit)))))
(magit--branch-spinoff branch from nil))
;;;###autoload
(defun magit-branch-spinoff (branch &optional from)
"Create new branch from the unpushed commits.
Create and checkout a new branch starting at and tracking the
current branch. That branch in turn is reset to the last commit
it shares with its upstream. If the current branch has no
upstream or no unpushed commits, then the new branch is created
anyway and the previously current branch is not touched.
This is useful to create a feature branch after work has already
began on the old branch (likely but not necessarily \"master\").
If the current branch is a member of the value of option
`magit-branch-prefer-remote-upstream' (which see), then the
current branch will be used as the starting point as usual, but
the upstream of the starting-point may be used as the upstream
of the new branch, instead of the starting-point itself.
If optional FROM is non-nil, then the source branch is reset
to `FROM~', instead of to the last commit it shares with its
upstream. Interactively, FROM is only ever non-nil, if the
region selects some commits, and among those commits, FROM is
the commit that is the fewest commits ahead of the source
branch.
The commit at the other end of the selection actually does not
matter, all commits between FROM and `HEAD' are moved to the new
branch. If FROM is not reachable from `HEAD' or is reachable
from the source branch's upstream, then an error is raised."
(interactive (list (magit-read-string-ns "Spin off branch")
(car (last (magit-region-values 'commit)))))
(magit--branch-spinoff branch from t))
(defun magit--branch-spinoff (branch from checkout)
(when (magit-branch-p branch)
(user-error "Cannot spin off %s. It already exists" branch))
(when (and (not checkout)
(magit-anything-modified-p))
(message "Staying on HEAD due to uncommitted changes")
(setq checkout t))
(if-let ((current (magit-get-current-branch)))
(let ((tracked (magit-get-upstream-branch current))
base)
(when from
(unless (magit-rev-ancestor-p from current)
(user-error "Cannot spin off %s. %s is not reachable from %s"
branch from current))
(when (and tracked
(magit-rev-ancestor-p from tracked))
(user-error "Cannot spin off %s. %s is ancestor of upstream %s"
branch from tracked)))
(let ((magit-process-raise-error t))
(if checkout
(magit-call-git "checkout" "-b" branch current)
(magit-call-git "branch" branch current)))
(--when-let (magit-get-indirect-upstream-branch current)
(magit-call-git "branch" "--set-upstream-to" it branch))
(when (and tracked
(setq base
(if from
(concat from "^")
(magit-git-string "merge-base" current tracked)))
(not (magit-rev-eq base current)))
(if checkout
(magit-call-git "update-ref" "-m"
(format "reset: moving to %s" base)
(concat "refs/heads/" current) base)
(magit-call-git "reset" "--hard" base))))
(if checkout
(magit-call-git "checkout" "-b" branch)
(magit-call-git "branch" branch)))
(magit-refresh))
;;;###autoload
(defun magit-branch-reset (branch to &optional set-upstream)
"Reset a branch to the tip of another branch or any other commit.
When the branch being reset is the current branch, then do a
hard reset. If there are any uncommitted changes, then the user
has to confirm the reset because those changes would be lost.
This is useful when you have started work on a feature branch but
realize it's all crap and want to start over.
When resetting to another branch and a prefix argument is used,
then also set the target branch as the upstream of the branch
that is being reset."
(interactive
(let* ((atpoint (magit-local-branch-at-point))
(branch (magit-read-local-branch "Reset branch" atpoint)))
(list branch
(magit-completing-read (format "Reset %s to" branch)
(delete branch (magit-list-branch-names))
nil nil nil 'magit-revision-history
(or (and (not (equal branch atpoint)) atpoint)
(magit-get-upstream-branch branch)))
current-prefix-arg)))
(let ((magit-inhibit-refresh t))
(if (equal branch (magit-get-current-branch))
(if (and (magit-anything-modified-p)
(not (yes-or-no-p
"Uncommitted changes will be lost. Proceed? ")))
(user-error "Abort")
(magit-reset-hard to))
(magit-call-git "update-ref"
"-m" (format "reset: moving to %s" to)
(magit-git-string "rev-parse" "--symbolic-full-name"
branch)
to))
(when (and set-upstream (magit-branch-p to))
(magit-set-upstream-branch branch to)
(magit-branch-maybe-adjust-upstream branch to)))
(magit-refresh))
(defvar magit-branch-delete-never-verify nil
"Whether `magit-branch-delete' always pushes with \"--no-verify\".")
;;;###autoload
(defun magit-branch-delete (branches &optional force)
"Delete one or multiple branches.
If the region marks multiple branches, then offer to delete
those, otherwise prompt for a single branch to be deleted,
defaulting to the branch at point."
;; One would expect this to be a command as simple as, for example,
;; `magit-branch-rename'; but it turns out everyone wants to squeeze
;; a bit of extra functionality into this one, including myself.
(interactive
(let ((branches (magit-region-values 'branch t))
(force current-prefix-arg))
(if (length> branches 1)
(magit-confirm t nil "Delete %i branches" nil branches)
(setq branches
(list (magit-read-branch-prefer-other
(if force "Force delete branch" "Delete branch")))))
(unless force
(when-let ((unmerged (-remove #'magit-branch-merged-p branches)))
(if (magit-confirm 'delete-unmerged-branch
"Delete unmerged branch %s"
"Delete %i unmerged branches"
'noabort unmerged)
(setq force branches)
(or (setq branches (-difference branches unmerged))
(user-error "Abort")))))
(list branches force)))
(let* ((refs (mapcar #'magit-ref-fullname branches))
(ambiguous (--remove it refs)))
(when ambiguous
(user-error
"%s ambiguous. Please cleanup using git directly."
(let ((len (length ambiguous)))
(cond
((= len 1)
(format "%s is" (-first #'magit-ref-ambiguous-p branches)))
((= len (length refs))
(format "These %s names are" len))
(t
(format "%s of these names are" len))))))
(cond
((string-match "^refs/remotes/\\([^/]+\\)" (car refs))
(let* ((remote (match-string 1 (car refs)))
(offset (1+ (length remote))))
(cond
((magit-confirm 'delete-branch-on-remote
"Delete %s on the remote (not just locally)"
"Delete %i branches on the remote (not just locally)"
'noabort branches)
;; The ref may actually point at another rev on the remote,
;; but this is better than nothing.
(dolist (ref refs)
(message "Delete %s (was %s)" ref
(magit-rev-parse "--short" ref)))
;; Assume the branches actually still exist on the remote.
(magit-run-git-async
"push"
(and (or force magit-branch-delete-never-verify) "--no-verify")
remote
(--map (concat ":" (substring it offset)) branches))
;; If that is not the case, then this deletes the tracking branches.
(set-process-sentinel
magit-this-process
(apply-partially #'magit-delete-remote-branch-sentinel remote refs)))
(t
(dolist (ref refs)
(message "Delete %s (was %s)" ref
(magit-rev-parse "--short" ref))
(magit-call-git "update-ref" "-d" ref))
(magit-refresh)))))
((length> branches 1)
(setq branches (delete (magit-get-current-branch) branches))
(mapc #'magit-branch-maybe-delete-pr-remote branches)
(mapc #'magit-branch-unset-pushRemote branches)
(magit-run-git "branch" (if force "-D" "-d") branches))
(t ; And now for something completely different.
(let* ((branch (car branches))
(prompt (format "Branch %s is checked out. " branch))
(target (magit-get-upstream-branch)))
(when (equal branch (magit-get-current-branch))
(when (or (equal branch target)
(not target))
(setq target (magit-main-branch)))
(pcase (if (or (equal branch target)
(not target))
(magit-read-char-case prompt nil
(?d "[d]etach HEAD & delete" 'detach)
(?a "[a]bort" 'abort))
(magit-read-char-case prompt nil
(?d "[d]etach HEAD & delete" 'detach)
(?c (format "[c]heckout %s & delete" target) 'target)
(?a "[a]bort" 'abort)))
(`detach (unless (or (equal force '(4))
(member branch force)
(magit-branch-merged-p branch t))
(magit-confirm 'delete-unmerged-branch
"Delete unmerged branch %s" ""
nil (list branch)))
(magit-call-git "checkout" "--detach"))
(`target (unless (or (equal force '(4))
(member branch force)
(magit-branch-merged-p branch target))
(magit-confirm 'delete-unmerged-branch
"Delete unmerged branch %s" ""
nil (list branch)))
(magit-call-git "checkout" target))
(`abort (user-error "Abort")))
(setq force t))
(magit-branch-maybe-delete-pr-remote branch)
(magit-branch-unset-pushRemote branch)
(magit-run-git "branch" (if force "-D" "-d") branch))))))
(put 'magit-branch-delete 'interactive-only t)
(defun magit-branch-maybe-delete-pr-remote (branch)
(when-let ((remote (magit-get "branch" branch "pullRequestRemote")))
(let* ((variable (format "remote.%s.fetch" remote))
(refspecs (magit-get-all variable)))
(unless (member (format "+refs/heads/*:refs/remotes/%s/*" remote)
refspecs)
(let ((refspec
(if (equal (magit-get "branch" branch "pushRemote") remote)
(format "+refs/heads/%s:refs/remotes/%s/%s"
branch remote branch)
(let ((merge (magit-get "branch" branch "merge")))
(and merge
(string-prefix-p "refs/heads/" merge)
(setq merge (substring merge 11))
(format "+refs/heads/%s:refs/remotes/%s/%s"
merge remote merge))))))
(when (member refspec refspecs)
(if (and (length= refspecs 1)
(magit-confirm 'delete-pr-remote
(format "Also delete remote %s (%s)" remote
"no pull-request branch remains")
nil t))
(magit-call-git "remote" "rm" remote)
(magit-call-git "config" "--unset-all" variable
(format "^%s$" (regexp-quote refspec))))))))))
(defun magit-branch-unset-pushRemote (branch)
(magit-set nil "branch" branch "pushRemote"))
(defun magit-delete-remote-branch-sentinel (remote refs process event)
(when (memq (process-status process) '(exit signal))
(if (= (process-exit-status process) 1)
(if-let ((on-remote (--map (concat "refs/remotes/" remote "/" it)
(magit-remote-list-branches remote)))
(rest (--filter (and (not (member it on-remote))
(magit-ref-exists-p it))
refs)))
(progn
(process-put process 'inhibit-refresh t)
(magit-process-sentinel process event)
(setq magit-this-error nil)
(message "Some remote branches no longer exist. %s"
"Deleting just the local tracking refs instead...")
(dolist (ref rest)
(magit-call-git "update-ref" "-d" ref))
(magit-refresh)
(message "Deleting local remote-tracking refs...done"))
(magit-process-sentinel process event))
(magit-process-sentinel process event))))
;;;###autoload
(defun magit-branch-rename (old new &optional force)
"Rename the branch named OLD to NEW.
With a prefix argument FORCE, rename even if a branch named NEW
already exists.
If `branch.OLD.pushRemote' is set, then unset it. Depending on
the value of `magit-branch-rename-push-target' (which see) maybe
set `branch.NEW.pushRemote' and maybe rename the push-target on
the remote."
(interactive
(let ((branch (magit-read-local-branch "Rename branch")))
(list branch
(magit-read-string-ns (format "Rename branch '%s' to" branch)
nil 'magit-revision-history)
current-prefix-arg)))
(when (string-match "\\`heads/\\(.+\\)" old)
(setq old (match-string 1 old)))
(when (equal old new)
(user-error "Old and new branch names are the same"))
(magit-call-git "branch" (if force "-M" "-m") old new)
(when magit-branch-rename-push-target
(let ((remote (magit-get-push-remote old))
(old-specified (magit-get "branch" old "pushRemote"))
(new-specified (magit-get "branch" new "pushRemote")))
(when (and old-specified (or force (not new-specified)))
;; Keep the target setting branch specified, even if that is
;; redundant. But if a branch by the same name existed before
;; and the rename isn't forced, then do not change a leftover
;; setting. Such a leftover setting may or may not conform to
;; what we expect here...
(magit-set old-specified "branch" new "pushRemote"))
(when (and (equal (magit-get-push-remote new) remote)
;; ...and if it does not, then we must abort.
(not (eq magit-branch-rename-push-target 'local-only))
(or (not (memq magit-branch-rename-push-target
'(forge-only github-only)))
(and (require (quote forge) nil t)
(fboundp 'forge--forge-remote-p)
(forge--forge-remote-p remote))))
(let ((old-target (magit-get-push-branch old t))
(new-target (magit-get-push-branch new t))
(remote (magit-get-push-remote new)))
(when (and old-target
(not new-target)
(magit-y-or-n-p (format "Also rename %S to %S on \"%s\""
old new remote)))
;; Rename on (i.e. within) the remote, but only if the
;; destination ref doesn't exist yet. If that ref already
;; exists, then it probably is of some value and we better
;; not touch it. Ignore what the local ref points at,
;; i.e. if the local and the remote ref didn't point at
;; the same commit before the rename then keep it that way.
(magit-call-git "push" "-v" remote
(format "%s:refs/heads/%s" old-target new)
(format ":refs/heads/%s" old)))))))
(magit-branch-unset-pushRemote old)
(magit-refresh))
;;;###autoload
(defun magit-branch-shelve (branch)
"Shelve a BRANCH.
Rename \"refs/heads/BRANCH\" to \"refs/shelved/BRANCH\",
and also rename the respective reflog file."
(interactive (list (magit-read-other-local-branch "Shelve branch")))
(let ((old (concat "refs/heads/" branch))
(new (concat "refs/shelved/" branch)))
(magit-git "update-ref" new old "")
(magit--rename-reflog-file old new)
(magit-branch-unset-pushRemote branch)
(magit-run-git "branch" "-D" branch)))
;;;###autoload
(defun magit-branch-unshelve (branch)
"Unshelve a BRANCH
Rename \"refs/shelved/BRANCH\" to \"refs/heads/BRANCH\",
and also rename the respective reflog file."
(interactive
(list (magit-completing-read
"Unshelve branch"
(--map (substring it 8)
(magit-list-refnames "refs/shelved"))
nil t)))
(let ((old (concat "refs/shelved/" branch))
(new (concat "refs/heads/" branch)))
(magit-git "update-ref" new old "")
(magit--rename-reflog-file old new)
(magit-run-git "update-ref" "-d" old)))
(defun magit--rename-reflog-file (old new)
(let ((old (magit-git-dir (concat "logs/" old)))
(new (magit-git-dir (concat "logs/" new))))
(when (file-exists-p old)
(make-directory (file-name-directory new) t)
(rename-file old new t))))
;;; Configure
;;;###autoload (autoload 'magit-branch-configure "magit-branch" nil t)
(transient-define-prefix magit-branch-configure (branch)
"Configure a branch."
:man-page "git-branch"
[:description
(lambda ()
(concat
(propertize "Configure " 'face 'transient-heading)
(propertize (oref transient--prefix scope) 'face 'magit-branch-local)))
("d" magit-branch.<branch>.description)
("u" magit-branch.<branch>.merge/remote)
("r" magit-branch.<branch>.rebase)
("p" magit-branch.<branch>.pushRemote)]
["Configure repository defaults"
("R" magit-pull.rebase)
("P" magit-remote.pushDefault)]
["Configure branch creation"
("a m" magit-branch.autoSetupMerge)
("a r" magit-branch.autoSetupRebase)]
(interactive
(list (or (and (not current-prefix-arg)
(not (and magit-branch-direct-configure
(eq transient-current-command 'magit-branch)))
(magit-get-current-branch))
(magit--read-branch-scope))))
(transient-setup 'magit-branch-configure nil nil :scope branch))
(defun magit--read-branch-scope (&optional obj)
(magit-read-local-branch
(if obj
(format "Set %s for branch"
(format (oref obj variable) "<name>"))
"Configure branch")))
(transient-define-suffix magit-branch.<branch>.description (branch)
"Edit the description of BRANCH."
:class 'magit--git-variable
:transient nil
:variable "branch.%s.description"
(interactive (list (oref transient-current-prefix scope)))
(magit-run-git-with-editor "branch" "--edit-description" branch))
(add-hook 'find-file-hook #'magit-branch-description-check-buffers)
(defun magit-branch-description-check-buffers ()
(and buffer-file-name
(string-match-p "/\\(BRANCH\\|EDIT\\)_DESCRIPTION\\'" buffer-file-name)))
(defclass magit--git-branch:upstream (magit--git-variable)
((format :initform " %k %m %M\n %r %R")))
(transient-define-infix magit-branch.<branch>.merge/remote ()
:class 'magit--git-branch:upstream)
(cl-defmethod transient-init-value ((obj magit--git-branch:upstream))
(when-let* ((branch (oref transient--prefix scope))
(remote (magit-get "branch" branch "remote"))
(merge (magit-get "branch" branch "merge")))
(oset obj value (list remote merge))))
(cl-defmethod transient-infix-read ((obj magit--git-branch:upstream))
(if (oref obj value)
(oset obj value nil)
(magit-read-upstream-branch (oref transient--prefix scope) "Upstream")))
(cl-defmethod transient-infix-set ((obj magit--git-branch:upstream) refname)
(magit-set-upstream-branch (oref transient--prefix scope) refname)
(oset obj value
(and-let* ((branch (oref transient--prefix scope))
(r (magit-get "branch" branch "remote"))
(m (magit-get "branch" branch "merge")))
(list r m)))
(magit-refresh))
(cl-defmethod transient-format ((obj magit--git-branch:upstream))
(let ((branch (oref transient--prefix scope)))
(format-spec
(oref obj format)
`((?k . ,(transient-format-key obj))
(?r . ,(format "branch.%s.remote" branch))
(?m . ,(format "branch.%s.merge" branch))
(?R . ,(transient-format-value obj #'car))
(?M . ,(transient-format-value obj #'cadr))))))
(cl-defmethod transient-format-value ((obj magit--git-branch:upstream) key)
(if-let ((value (funcall key (oref obj value))))
(propertize value 'face 'transient-argument)
(propertize "unset" 'face 'transient-inactive-argument)))
(transient-define-infix magit-branch.<branch>.rebase ()
:class 'magit--git-variable:choices
:scope #'magit--read-branch-scope
:variable "branch.%s.rebase"
:fallback "pull.rebase"
:choices '("true" "false")
:default "false")
(transient-define-infix magit-branch.<branch>.pushRemote ()
:class 'magit--git-variable:choices
:scope #'magit--read-branch-scope
:variable "branch.%s.pushRemote"
:fallback "remote.pushDefault"
:choices #'magit-list-remotes)
(transient-define-infix magit-pull.rebase ()
:class 'magit--git-variable:choices
:variable "pull.rebase"
:choices '("true" "false")
:default "false")
(transient-define-infix magit-remote.pushDefault ()
:class 'magit--git-variable:choices
:variable "remote.pushDefault"
:choices #'magit-list-remotes)
(transient-define-infix magit-branch.autoSetupMerge ()
:class 'magit--git-variable:choices
:variable "branch.autoSetupMerge"
:choices '("always" "true" "false")
:default "true")
(transient-define-infix magit-branch.autoSetupRebase ()
:class 'magit--git-variable:choices
:variable "branch.autoSetupRebase"
:choices '("always" "local" "remote" "never")
:default "never")
;;; _
(provide 'magit-branch)
;;; magit-branch.el ends here

132
code/elpa/magit-20220821.1819/magit-bundle.el Normal file
View File

@ -0,0 +1,132 @@
;;; magit-bundle.el --- Bundle support for Magit -*- lexical-binding:t -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
(require 'magit)
;;; Commands
;;;###autoload (autoload 'magit-bundle "magit-bundle" nil t)
(transient-define-prefix magit-bundle ()
"Create or verify Git bundles."
:man-page "git-bundle"
["Actions"
("c" "create" magit-bundle-create)
("v" "verify" magit-bundle-verify)
("l" "list-heads" magit-bundle-list-heads)])
;;;###autoload (autoload 'magit-bundle-import "magit-bundle" nil t)
(transient-define-prefix magit-bundle-create (&optional file refs args)
"Create a bundle."
:man-page "git-bundle"
["Arguments"
("-a" "Include all refs" "--all")
("-b" "Include branches" "--branches=" :allow-empty t)
("-t" "Include tags" "--tags=" :allow-empty t)
("-r" "Include remotes" "--remotes=" :allow-empty t)
("-g" "Include refs" "--glob=")
("-e" "Exclude refs" "--exclude=")
(magit-log:-n)
(magit-log:--since)
(magit-log:--until)]
["Actions"
("c" "create regular bundle" magit-bundle-create)
("t" "create tracked bundle" magit-bundle-create-tracked)
("u" "update tracked bundle" magit-bundle-update-tracked)]
(interactive
(and (eq transient-current-command 'magit-bundle-create)
(list (read-file-name "Create bundle: " nil nil nil
(concat (file-name-nondirectory
(directory-file-name (magit-toplevel)))
".bundle"))
(magit-completing-read-multiple* "Refnames (zero or more): "
(magit-list-refnames))
(transient-args 'magit-bundle-create))))
(if file
(magit-git-bundle "create" file refs args)
(transient-setup 'magit-bundle-create)))
;;;###autoload
(defun magit-bundle-create-tracked (file tag branch refs args)
"Create and track a new bundle."
(interactive
(let ((tag (magit-read-tag "Track bundle using tag"))
(branch (magit-read-branch "Bundle branch"))
(refs (magit-completing-read-multiple*
"Additional refnames (zero or more): "
(magit-list-refnames))))
(list (read-file-name "File: " nil nil nil (concat tag ".bundle"))
tag branch
(if (equal branch (magit-get-current-branch))
(cons "HEAD" refs)
refs)
(transient-args 'magit-bundle-create))))
(magit-git-bundle "create" file (cons branch refs) args)
(magit-git "tag" "--force" tag branch
"-m" (concat ";; git-bundle tracking\n"
(pp-to-string `((file . ,file)
(branch . ,branch)
(refs . ,refs)
(args . ,args))))))
;;;###autoload
(defun magit-bundle-update-tracked (tag)
"Update a bundle that is being tracked using TAG."
(interactive (list (magit-read-tag "Update bundle tracked by tag" t)))
(let (msg)
(let-alist (magit--with-temp-process-buffer
(save-excursion
(magit-git-insert "for-each-ref" "--format=%(contents)"
(concat "refs/tags/" tag)))
(setq msg (buffer-string))
(ignore-errors (read (current-buffer))))
(unless (and .file .branch)
(error "Tag %s does not appear to track a bundle" tag))
(magit-git-bundle "create" .file
(cons (concat tag ".." .branch) .refs)
.args)
(magit-git "tag" "--force" tag .branch "-m" msg))))
;;;###autoload
(defun magit-bundle-verify (file)
"Check whether FILE is valid and applies to the current repository."
(interactive (list (magit-bundle--read-file-name "Verify bundle: ")))
(magit-process-buffer)
(magit-git-bundle "verify" file))
;;;###autoload
(defun magit-bundle-list-heads (file)
"List the refs in FILE."
(interactive (list (magit-bundle--read-file-name "List heads of bundle: ")))
(magit-process-buffer)
(magit-git-bundle "list-heads" file))
(defun magit-bundle--read-file-name (prompt)
(read-file-name prompt nil nil t (magit-file-at-point) #'file-regular-p))
(defun magit-git-bundle (command file &optional refs args)
(magit-git "bundle" command (magit-convert-filename-for-git file) refs args))
;;; _
(provide 'magit-bundle)
;;; magit-bundle.el ends here

340
code/elpa/magit-20220821.1819/magit-clone.el Normal file
View File

@ -0,0 +1,340 @@
;;; magit-clone.el --- Clone a repository -*- lexical-binding:t -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library implements clone commands.
;;; Code:
(require 'magit)
;;; Options
(defcustom magit-clone-set-remote-head nil
"Whether cloning creates the symbolic-ref `<remote>/HEAD'."
:package-version '(magit . "2.4.2")
:group 'magit-commands
:type 'boolean)
(defcustom magit-clone-set-remote.pushDefault 'ask
"Whether to set the value of `remote.pushDefault' after cloning.
If t, then set without asking. If nil, then don't set. If
`ask', then ask."
:package-version '(magit . "2.4.0")
:group 'magit-commands
:type '(choice (const :tag "set" t)
(const :tag "ask" ask)
(const :tag "don't set" nil)))
(defcustom magit-clone-default-directory nil
"Default directory to use when `magit-clone' reads destination.
If nil (the default), then use the value of `default-directory'.
If a directory, then use that. If a function, then call that
with the remote url as only argument and use the returned value."
:package-version '(magit . "2.90.0")
:group 'magit-commands
:type '(choice (const :tag "value of default-directory")
(directory :tag "constant directory")
(function :tag "function's value")))
(defcustom magit-clone-always-transient nil
"Whether `magit-clone' always acts as a transient prefix command.
If nil, then a prefix argument has to be used to show the transient
popup instead of invoking the default suffix `magit-clone-regular'
directly."
:package-version '(magit . "3.0.0")
:group 'magit-commands
:type 'boolean)
(defcustom magit-clone-name-alist
'(("\\`\\(?:github:\\|gh:\\)?\\([^:]+\\)\\'" "github.com" "github.user")
("\\`\\(?:gitlab:\\|gl:\\)\\([^:]+\\)\\'" "gitlab.com" "gitlab.user"))
"Alist mapping repository names to repository urls.
Each element has the form (REGEXP HOSTNAME USER). When the user
enters a name when a cloning command asks for a name or url, then
that is looked up in this list. The first element whose REGEXP
matches is used.
The format specified by option `magit-clone-url-format' is used
to turn the name into an url, using HOSTNAME and the repository
name. If the provided name contains a slash, then that is used.
Otherwise if the name omits the owner of the repository, then the
default user specified in the matched entry is used.
If USER contains a dot, then it is treated as a Git variable and
the value of that is used as the username. Otherwise it is used
as the username itself."
:package-version '(magit . "3.0.0")
:group 'magit-commands
:type '(repeat (list regexp
(string :tag "hostname")
(string :tag "user name or git variable"))))
(defcustom magit-clone-url-format "git@%h:%n.git"
"Format(s) used when turning repository names into urls.
%h is the hostname and %n is the repository name, including the
name of the owner. The value can be a string (representing a
single static format) or an alist with elements (HOSTNAME
. FORMAT) mapping hostnames to formats. When an alist is used,
the nil key represents the default. Also see
`magit-clone-name-alist'."
:package-version '(magit . "3.0.0")
:group 'magit-commands
:type '(choice (string)
(alist :key-type string :value-type string)))
;;; Commands
;;;###autoload (autoload 'magit-clone "magit-clone" nil t)
(transient-define-prefix magit-clone (&optional transient)
"Clone a repository."
:man-page "git-clone"
["Fetch arguments"
("-B" "Clone a single branch" "--single-branch")
("-n" "Do not clone tags" "--no-tags")
("-S" "Clones submodules" "--recurse-submodules" :level 6)
("-l" "Do not optimize" "--no-local" :level 7)]
["Setup arguments"
("-o" "Set name of remote" ("-o" "--origin="))
("-b" "Set HEAD branch" ("-b" "--branch="))
(magit-clone:--filter
:if (lambda () (magit-git-version>= "2.17.0"))
:level 7)
("-g" "Separate git directory" "--separate-git-dir="
transient-read-directory :level 7)
("-t" "Use template directory" "--template="
transient-read-existing-directory :level 6)]
["Local sharing arguments"
("-s" "Share objects" ("-s" "--shared" :level 7))
("-h" "Do not use hardlinks" "--no-hardlinks")]
["Clone"
("C" "regular" magit-clone-regular)
("s" "shallow" magit-clone-shallow)
("d" "shallow since date" magit-clone-shallow-since :level 7)
("e" "shallow excluding" magit-clone-shallow-exclude :level 7)
(">" "sparse checkout" magit-clone-sparse
:if (lambda () (magit-git-version>= "2.25.0"))
:level 6)
("b" "bare" magit-clone-bare)
("m" "mirror" magit-clone-mirror)]
(interactive (list (or magit-clone-always-transient current-prefix-arg)))
(if transient
(transient-setup 'magit-clone)
(call-interactively #'magit-clone-regular)))
(transient-define-argument magit-clone:--filter ()
:description "Filter some objects"
:class 'transient-option
:key "-f"
:argument "--filter="
:reader #'magit-clone-read-filter)
(defun magit-clone-read-filter (prompt initial-input history)
(magit-completing-read prompt
(list "blob:none" "tree:0")
nil nil initial-input history))
;;;###autoload
(defun magit-clone-regular (repository directory args)
"Create a clone of REPOSITORY in DIRECTORY.
Then show the status buffer for the new repository."
(interactive (magit-clone-read-args))
(magit-clone-internal repository directory args))
;;;###autoload
(defun magit-clone-shallow (repository directory args depth)
"Create a shallow clone of REPOSITORY in DIRECTORY.
Then show the status buffer for the new repository.
With a prefix argument read the DEPTH of the clone;
otherwise use 1."
(interactive (append (magit-clone-read-args)
(list (if current-prefix-arg
(read-number "Depth: " 1)
1))))
(magit-clone-internal repository directory
(cons (format "--depth=%s" depth) args)))
;;;###autoload
(defun magit-clone-shallow-since (repository directory args date)
"Create a shallow clone of REPOSITORY in DIRECTORY.
Then show the status buffer for the new repository.
Exclude commits before DATE, which is read from the
user."
(interactive (append (magit-clone-read-args)
(list (transient-read-date "Exclude commits before: "
nil nil))))
(magit-clone-internal repository directory
(cons (format "--shallow-since=%s" date) args)))
;;;###autoload
(defun magit-clone-shallow-exclude (repository directory args exclude)
"Create a shallow clone of REPOSITORY in DIRECTORY.
Then show the status buffer for the new repository.
Exclude commits reachable from EXCLUDE, which is a
branch or tag read from the user."
(interactive (append (magit-clone-read-args)
(list (read-string "Exclude commits reachable from: "))))
(magit-clone-internal repository directory
(cons (format "--shallow-exclude=%s" exclude) args)))
;;;###autoload
(defun magit-clone-bare (repository directory args)
"Create a bare clone of REPOSITORY in DIRECTORY.
Then show the status buffer for the new repository."
(interactive (magit-clone-read-args))
(magit-clone-internal repository directory (cons "--bare" args)))
;;;###autoload
(defun magit-clone-mirror (repository directory args)
"Create a mirror of REPOSITORY in DIRECTORY.
Then show the status buffer for the new repository."
(interactive (magit-clone-read-args))
(magit-clone-internal repository directory (cons "--mirror" args)))
;;;###autoload
(defun magit-clone-sparse (repository directory args)
"Clone REPOSITORY into DIRECTORY and create a sparse checkout."
(interactive (magit-clone-read-args))
(magit-clone-internal repository directory (cons "--no-checkout" args)
'sparse))
(defun magit-clone-internal (repository directory args &optional sparse)
(let* ((checkout (not (memq (car args) '("--bare" "--mirror"))))
(remote (or (transient-arg-value "--origin" args)
(magit-get "clone.defaultRemote")
"origin"))
(set-push-default
(and checkout
(or (eq magit-clone-set-remote.pushDefault t)
(and magit-clone-set-remote.pushDefault
(y-or-n-p (format "Set `remote.pushDefault' to %S? "
remote)))))))
(run-hooks 'magit-credential-hook)
(setq directory (file-name-as-directory (expand-file-name directory)))
(when (file-exists-p directory)
(if (file-directory-p directory)
(when (length> (directory-files directory) 2)
(let ((name (magit-clone--url-to-name repository)))
(unless (and name
(setq directory (file-name-as-directory
(expand-file-name name directory)))
(not (file-exists-p directory)))
(user-error "%s already exists" directory))))
(user-error "%s already exists and is not a directory" directory)))
(magit-run-git-async "clone" args "--" repository
(magit-convert-filename-for-git directory))
;; Don't refresh the buffer we're calling from.
(process-put magit-this-process 'inhibit-refresh t)
(set-process-sentinel
magit-this-process
(lambda (process event)
(when (memq (process-status process) '(exit signal))
(let ((magit-process-raise-error t))
(magit-process-sentinel process event)))
(when (and (eq (process-status process) 'exit)
(= (process-exit-status process) 0))
(when checkout
(let ((default-directory directory))
(when set-push-default
(setf (magit-get "remote.pushDefault") remote))
(unless magit-clone-set-remote-head
(magit-remote-unset-head remote))))
(when (and sparse checkout)
(when (magit-git-version< "2.25.0")
(user-error
"`git sparse-checkout' not available until Git v2.25"))
(let ((default-directory directory))
(magit-call-git "sparse-checkout" "init" "--cone")
(magit-call-git "checkout" (magit-get-current-branch))))
(with-current-buffer (process-get process 'command-buf)
(magit-status-setup-buffer directory)))))))
(defun magit-clone-read-args ()
(let ((repo (magit-clone-read-repository)))
(list repo
(read-directory-name
"Clone to: "
(if (functionp magit-clone-default-directory)
(funcall magit-clone-default-directory repo)
magit-clone-default-directory)
nil nil
(magit-clone--url-to-name repo))
(transient-args 'magit-clone))))
(defun magit-clone-read-repository ()
(magit-read-char-case "Clone from " nil
(?u "[u]rl or name"
(let ((str (magit-read-string-ns "Clone from url or name")))
(if (string-match-p "\\(://\\|@\\)" str)
str
(magit-clone--name-to-url str))))
(?p "[p]ath"
(magit-convert-filename-for-git
(read-directory-name "Clone repository: ")))
(?l "[l]ocal url"
(concat "file://"
(magit-convert-filename-for-git
(read-directory-name "Clone repository: file://"))))
(?b "or [b]undle"
(magit-convert-filename-for-git
(read-file-name "Clone from bundle: ")))))
(defun magit-clone--url-to-name (url)
(and (string-match "\\([^/:]+?\\)\\(/?\\.git\\)?$" url)
(match-string 1 url)))
(defun magit-clone--name-to-url (name)
(or (seq-some
(pcase-lambda (`(,re ,host ,user))
(and (string-match re name)
(let ((repo (match-string 1 name)))
(magit-clone--format-url host user repo))))
magit-clone-name-alist)
(user-error "Not an url and no matching entry in `%s'"
'magit-clone-name-alist)))
(defun magit-clone--format-url (host user repo)
(if-let ((url-format
(cond ((listp magit-clone-url-format)
(cdr (or (assoc host magit-clone-url-format)
(assoc nil magit-clone-url-format))))
((stringp magit-clone-url-format)
magit-clone-url-format))))
(format-spec
url-format
`((?h . ,host)
(?n . ,(if (string-search "/" repo)
repo
(if (string-search "." user)
(if-let ((user (magit-get user)))
(concat user "/" repo)
(user-error "Set %S or specify owner explicitly" user))
(concat user "/" repo))))))
(user-error
"Bogus `magit-clone-url-format' (bad type or missing default)")))
;;; _
(provide 'magit-clone)
;;; magit-clone.el ends here

700
code/elpa/magit-20220821.1819/magit-commit.el Normal file
View File

@ -0,0 +1,700 @@
;;; magit-commit.el --- Create Git commits -*- lexical-binding:t -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library implements commands for creating Git commits. These
;; commands just initiate the commit, support for writing the commit
;; messages is implemented in `git-commit.el'.
;;; Code:
(require 'magit)
(require 'magit-sequence)
;;; Options
(defcustom magit-commit-ask-to-stage 'verbose
"Whether to ask to stage everything when committing and nothing is staged."
:package-version '(magit . "2.3.0")
:group 'magit-commands
:type '(choice (const :tag "Ask" t)
(const :tag "Ask showing diff" verbose)
(const :tag "Stage without confirmation" stage)
(const :tag "Don't ask" nil)))
(defcustom magit-commit-show-diff t
"Whether the relevant diff is automatically shown when committing."
:package-version '(magit . "2.3.0")
:group 'magit-commands
:type 'boolean)
(defcustom magit-commit-extend-override-date t
"Whether using `magit-commit-extend' changes the committer date."
:package-version '(magit . "2.3.0")
:group 'magit-commands
:type 'boolean)
(defcustom magit-commit-reword-override-date t
"Whether using `magit-commit-reword' changes the committer date."
:package-version '(magit . "2.3.0")
:group 'magit-commands
:type 'boolean)
(defcustom magit-commit-squash-confirm t
"Whether the commit targeted by squash and fixup has to be confirmed.
When non-nil then the commit at point (if any) is used as default
choice, otherwise it has to be confirmed. This option only
affects `magit-commit-squash' and `magit-commit-fixup'. The
\"instant\" variants always require confirmation because making
an error while using those is harder to recover from."
:package-version '(magit . "2.1.0")
:group 'magit-commands
:type 'boolean)
(defcustom magit-post-commit-hook nil
"Hook run after creating a commit without the user editing a message.
This hook is run by `magit-refresh' if `this-command' is a member
of `magit-post-stage-hook-commands'. This only includes commands
named `magit-commit-*' that do *not* require that the user edits
the commit message in a buffer and then finishes by pressing
\\<with-editor-mode-map>\\[with-editor-finish].
Also see `git-commit-post-finish-hook'."
:package-version '(magit . "2.90.0")
:group 'magit-commands
:type 'hook)
(defcustom magit-commit-diff-inhibit-same-window nil
"Whether to inhibit use of same window when showing diff while committing.
When writing a commit, then a diff of the changes to be committed
is automatically shown. The idea is that the diff is shown in a
different window of the same frame and for most users that just
works. In other words most users can completely ignore this
option because its value doesn't make a difference for them.
However for users who configured Emacs to never create a new
window even when the package explicitly tries to do so, then
displaying two new buffers necessarily means that the first is
immediately replaced by the second. In our case the message
buffer is immediately replaced by the diff buffer, which is of
course highly undesirable.
A workaround is to suppress this user configuration in this
particular case. Users have to explicitly opt-in by toggling
this option. We cannot enable the workaround unconditionally
because that again causes issues for other users: if the frame
is too tiny or the relevant settings too aggressive, then the
diff buffer would end up being displayed in a new frame.
Also see https://github.com/magit/magit/issues/4132."
:package-version '(magit . "3.3.0")
:group 'magit-commands
:type 'boolean)
;;; Popup
;;;###autoload (autoload 'magit-commit "magit-commit" nil t)
(transient-define-prefix magit-commit ()
"Create a new commit or replace an existing commit."
:info-manual "(magit)Initiating a Commit"
:man-page "git-commit"
["Arguments"
("-a" "Stage all modified and deleted files" ("-a" "--all"))
("-e" "Allow empty commit" "--allow-empty")
("-v" "Show diff of changes to be committed" ("-v" "--verbose"))
("-n" "Disable hooks" ("-n" "--no-verify"))
("-R" "Claim authorship and reset author date" "--reset-author")
(magit:--author :description "Override the author")
(7 "-D" "Override the author date" "--date=" transient-read-date)
("-s" "Add Signed-off-by line" ("-s" "--signoff"))
(5 magit:--gpg-sign)
(magit-commit:--reuse-message)]
[["Create"
("c" "Commit" magit-commit-create)]
["Edit HEAD"
("e" "Extend" magit-commit-extend)
("w" "Reword" magit-commit-reword)
("a" "Amend" magit-commit-amend)
(6 "n" "Reshelve" magit-commit-reshelve)]
["Edit"
("f" "Fixup" magit-commit-fixup)
("s" "Squash" magit-commit-squash)
("A" "Augment" magit-commit-augment)
(6 "x" "Absorb changes" magit-commit-autofixup)
(6 "X" "Absorb modules" magit-commit-absorb-modules)]
[""
("F" "Instant fixup" magit-commit-instant-fixup)
("S" "Instant squash" magit-commit-instant-squash)]]
(interactive)
(if-let ((buffer (magit-commit-message-buffer)))
(switch-to-buffer buffer)
(transient-setup 'magit-commit)))
(defun magit-commit-arguments nil
(transient-args 'magit-commit))
(transient-define-argument magit-commit:--reuse-message ()
:description "Reuse commit message"
:class 'transient-option
:shortarg "-C"
:argument "--reuse-message="
:reader #'magit-read-reuse-message
:history-key 'magit-revision-history)
(defun magit-read-reuse-message (prompt &optional default history)
(magit-completing-read prompt (magit-list-refnames)
nil nil nil history
(or default
(and (magit-rev-verify "ORIG_HEAD")
"ORIG_HEAD"))))
;;; Commands
;;;###autoload
(defun magit-commit-create (&optional args)
"Create a new commit on `HEAD'.
With a prefix argument, amend to the commit at `HEAD' instead.
\n(git commit [--amend] ARGS)"
(interactive (if current-prefix-arg
(list (cons "--amend" (magit-commit-arguments)))
(list (magit-commit-arguments))))
(when (member "--all" args)
(setq this-command 'magit-commit--all))
(when (setq args (magit-commit-assert args))
(let ((default-directory (magit-toplevel)))
(magit-run-git-with-editor "commit" args))))
;;;###autoload
(defun magit-commit-amend (&optional args)
"Amend the last commit.
\n(git commit --amend ARGS)"
(interactive (list (magit-commit-arguments)))
(magit-commit-amend-assert)
(magit-run-git-with-editor "commit" "--amend" args))
;;;###autoload
(defun magit-commit-extend (&optional args override-date)
"Amend the last commit, without editing the message.
With a prefix argument keep the committer date, otherwise change
it. The option `magit-commit-extend-override-date' can be used
to inverse the meaning of the prefix argument. \n(git commit
--amend --no-edit)"
(interactive (list (magit-commit-arguments)
(if current-prefix-arg
(not magit-commit-extend-override-date)
magit-commit-extend-override-date)))
(when (setq args (magit-commit-assert args))
(magit-commit-amend-assert)
(if override-date
(magit-run-git-with-editor "commit" "--amend" "--no-edit" args)
(with-environment-variables
(("GIT_COMMITTER_DATE" (magit-rev-format "%cD")))
(magit-run-git-with-editor "commit" "--amend" "--no-edit" args)))))
;;;###autoload
(defun magit-commit-reword (&optional args override-date)
"Reword the last commit, ignoring staged changes.
With a prefix argument keep the committer date, otherwise change
it. The option `magit-commit-reword-override-date' can be used
to inverse the meaning of the prefix argument.
Non-interactively respect the optional OVERRIDE-DATE argument
and ignore the option.
\n(git commit --amend --only)"
(interactive (list (magit-commit-arguments)
(if current-prefix-arg
(not magit-commit-reword-override-date)
magit-commit-reword-override-date)))
(magit-commit-amend-assert)
(cl-pushnew "--allow-empty" args :test #'equal)
(if override-date
(magit-run-git-with-editor "commit" "--amend" "--only" args)
(with-environment-variables
(("GIT_COMMITTER_DATE" (magit-rev-format "%cD")))
(magit-run-git-with-editor "commit" "--amend" "--only" args))))
;;;###autoload
(defun magit-commit-fixup (&optional commit args)
"Create a fixup commit.
With a prefix argument the target COMMIT has to be confirmed.
Otherwise the commit at point may be used without confirmation
depending on the value of option `magit-commit-squash-confirm'."
(interactive (list (magit-commit-at-point)
(magit-commit-arguments)))
(magit-commit-squash-internal "--fixup" commit args))
;;;###autoload
(defun magit-commit-squash (&optional commit args)
"Create a squash commit, without editing the squash message.
With a prefix argument the target COMMIT has to be confirmed.
Otherwise the commit at point may be used without confirmation
depending on the value of option `magit-commit-squash-confirm'.
If you want to immediately add a message to the squash commit,
then use `magit-commit-augment' instead of this command."
(interactive (list (magit-commit-at-point)
(magit-commit-arguments)))
(magit-commit-squash-internal "--squash" commit args))
;;;###autoload
(defun magit-commit-augment (&optional commit args)
"Create a squash commit, editing the squash message.
With a prefix argument the target COMMIT has to be confirmed.
Otherwise the commit at point may be used without confirmation
depending on the value of option `magit-commit-squash-confirm'."
(interactive (list (magit-commit-at-point)
(magit-commit-arguments)))
(magit-commit-squash-internal "--squash" commit args nil t))
;;;###autoload
(defun magit-commit-instant-fixup (&optional commit args)
"Create a fixup commit targeting COMMIT and instantly rebase."
(interactive (list (magit-commit-at-point)
(magit-commit-arguments)))
(magit-commit-squash-internal "--fixup" commit args t))
;;;###autoload
(defun magit-commit-instant-squash (&optional commit args)
"Create a squash commit targeting COMMIT and instantly rebase."
(interactive (list (magit-commit-at-point)
(magit-commit-arguments)))
(magit-commit-squash-internal "--squash" commit args t))
(defun magit-commit-squash-internal
(option commit &optional args rebase edit confirmed)
(when-let ((args (magit-commit-assert args (not edit))))
(when commit
(when (and rebase (not (magit-rev-ancestor-p commit "HEAD")))
(magit-read-char-case
(format "%s isn't an ancestor of HEAD. " commit) nil
(?c "[c]reate without rebasing" (setq rebase nil))
(?s "[s]elect other" (setq commit nil))
(?a "[a]bort" (user-error "Quit")))))
(when commit
(setq commit (magit-rebase-interactive-assert commit t)))
(if (and commit
(or confirmed
(not (or rebase
current-prefix-arg
magit-commit-squash-confirm))))
(let ((magit-commit-show-diff nil))
(push (concat option "=" commit) args)
(unless edit
(push "--no-edit" args))
(if rebase
(magit-with-editor
(magit-call-git
"commit" "--no-gpg-sign"
(-remove-first
(apply-partially #'string-prefix-p "--gpg-sign=")
args)))
(magit-run-git-with-editor "commit" args))
t) ; The commit was created; used by below lambda.
(magit-log-select
(lambda (commit)
(when (and (magit-commit-squash-internal option commit args
rebase edit t)
rebase)
(magit-commit-amend-assert commit)
(magit-rebase-interactive-1 commit
(list "--autosquash" "--autostash" "--keep-empty")
"" "true" nil t)))
(format "Type %%p on a commit to %s into it,"
(substring option 2))
nil nil nil commit)
(when magit-commit-show-diff
(let ((magit-display-buffer-noselect t))
(apply #'magit-diff-staged nil (magit-diff-arguments)))))))
(defun magit-commit-amend-assert (&optional commit)
(--when-let (magit-list-publishing-branches commit)
(let ((m1 "This commit has already been published to ")
(m2 ".\nDo you really want to modify it"))
(magit-confirm 'amend-published
(concat m1 "%s" m2)
(concat m1 "%i public branches" m2)
nil it))))
(defun magit-commit-assert (args &optional strict)
(cond
((or (magit-anything-staged-p)
(and (magit-anything-unstaged-p)
;; ^ Everything of nothing is still nothing.
(member "--all" args))
(and (not strict)
;; ^ For amend variants that don't make sense otherwise.
(or (member "--amend" args)
(member "--allow-empty" args)
(member "--reset-author" args)
(member "--signoff" args)
(transient-arg-value "--author=" args)
(transient-arg-value "--date=" args))))
(or args (list "--")))
((and (magit-rebase-in-progress-p)
(not (magit-anything-unstaged-p))
(y-or-n-p "Nothing staged. Continue in-progress rebase? "))
(setq this-command #'magit-rebase-continue)
(magit-run-git-sequencer "rebase" "--continue")
nil)
((and (file-exists-p (magit-git-dir "MERGE_MSG"))
(not (magit-anything-unstaged-p)))
(or args (list "--")))
((not (magit-anything-unstaged-p))
(user-error "Nothing staged (or unstaged)"))
(magit-commit-ask-to-stage
(when (eq magit-commit-ask-to-stage 'verbose)
(magit-diff-unstaged))
(prog1 (when (or (eq magit-commit-ask-to-stage 'stage)
(y-or-n-p
"Nothing staged. Commit all uncommitted changes? "))
(setq this-command 'magit-commit--all)
(cons "--all" (or args (list "--"))))
(when (and (eq magit-commit-ask-to-stage 'verbose)
(derived-mode-p 'magit-diff-mode))
(magit-mode-bury-buffer))))
(t
(user-error "Nothing staged"))))
(defvar magit--reshelve-history nil)
;;;###autoload
(defun magit-commit-reshelve (date update-author &optional args)
"Change the committer date and possibly the author date of `HEAD'.
The current time is used as the initial minibuffer input and the
original author or committer date is available as the previous
history element.
Both the author and the committer dates are changes, unless one
of the following is true, in which case only the committer date
is updated:
- You are not the author of the commit that is being reshelved.
- The command was invoked with a prefix argument.
- Non-interactively if UPDATE-AUTHOR is nil."
(interactive
(let ((update-author (and (magit-rev-author-p "HEAD")
(not current-prefix-arg))))
(push (magit-rev-format (if update-author "%ad" "%cd") "HEAD"
(concat "--date=format:%F %T %z"))
magit--reshelve-history)
(list (read-string (if update-author
"Change author and committer dates to: "
"Change committer date to: ")
(cons (format-time-string "%F %T %z") 17)
'magit--reshelve-history)
update-author
(magit-commit-arguments))))
(with-environment-variables (("GIT_COMMITTER_DATE" date))
(magit-run-git "commit" "--amend" "--no-edit"
(and update-author (concat "--date=" date))
args)))
;;;###autoload
(defun magit-commit-absorb-modules (phase commit)
"Spread modified modules across recent commits."
(interactive (list 'select (magit-get-upstream-branch)))
(let ((modules (magit-list-modified-modules)))
(unless modules
(user-error "There are no modified modules that could be absorbed"))
(when commit
(setq commit (magit-rebase-interactive-assert commit t)))
(if (and commit (eq phase 'run))
(progn
(dolist (module modules)
(when-let ((msg (magit-git-string
"log" "-1" "--format=%s"
(concat commit "..") "--" module)))
(magit-git "commit" "-m" (concat "fixup! " msg)
"--only" "--" module)))
(magit-refresh)
t)
(magit-log-select
(lambda (commit)
(magit-commit-absorb-modules 'run commit))
nil nil nil nil commit))))
;;;###autoload (autoload 'magit-commit-absorb "magit-commit" nil t)
(transient-define-prefix magit-commit-absorb (phase commit args)
"Spread staged changes across recent commits.
With a prefix argument use a transient command to select infix
arguments. This command requires git-absorb executable, which
is available from https://github.com/tummychow/git-absorb.
See `magit-commit-autofixup' for an alternative implementation."
["Arguments"
("-f" "Skip safety checks" ("-f" "--force"))
("-v" "Display more output" ("-v" "--verbose"))]
["Actions"
("x" "Absorb" magit-commit-absorb)]
(interactive (if current-prefix-arg
(list 'transient nil nil)
(list 'select
(magit-get-upstream-branch)
(transient-args 'magit-commit-absorb))))
(if (eq phase 'transient)
(transient-setup 'magit-commit-absorb)
(unless (compat-executable-find "git-absorb" t)
(user-error "This command requires the git-absorb executable, which %s"
"is available from https://github.com/tummychow/git-absorb"))
(unless (magit-anything-staged-p)
(if (magit-anything-unstaged-p)
(if (y-or-n-p "Nothing staged. Absorb all unstaged changes? ")
(magit-with-toplevel
(magit-run-git "add" "-u" "."))
(user-error "Abort"))
(user-error "There are no changes that could be absorbed")))
(when commit
(setq commit (magit-rebase-interactive-assert commit t)))
(if (and commit (eq phase 'run))
(progn (magit-run-git-async "absorb" "-v" args "-b" commit) t)
(magit-log-select
(lambda (commit)
(with-no-warnings ; about non-interactive use
(magit-commit-absorb 'run commit args)))
nil nil nil nil commit))))
;;;###autoload (autoload 'magit-commit-autofixup "magit-commit" nil t)
(transient-define-prefix magit-commit-autofixup (phase commit args)
"Spread staged or unstaged changes across recent commits.
If there are any staged then spread only those, otherwise
spread all unstaged changes. With a prefix argument use a
transient command to select infix arguments.
This command requires the git-autofixup script, which is
available from https://github.com/torbiak/git-autofixup.
See `magit-commit-absorb' for an alternative implementation."
["Arguments"
(magit-autofixup:--context)
(magit-autofixup:--strict)]
["Actions"
("x" "Absorb" magit-commit-autofixup)]
(interactive (if current-prefix-arg
(list 'transient nil nil)
(list 'select
(magit-get-upstream-branch)
(transient-args 'magit-commit-autofixup))))
(if (eq phase 'transient)
(transient-setup 'magit-commit-autofixup)
(unless (compat-executable-find "git-autofixup" t)
(user-error "This command requires the git-autofixup script, which %s"
"is available from https://github.com/torbiak/git-autofixup"))
(unless (magit-anything-modified-p)
(user-error "There are no changes that could be absorbed"))
(when commit
(setq commit (magit-rebase-interactive-assert commit t)))
(if (and commit (eq phase 'run))
(progn (magit-run-git-async "autofixup" "-vv" args commit) t)
(magit-log-select
(lambda (commit)
(with-no-warnings ; about non-interactive use
(magit-commit-autofixup 'run commit args)))
nil nil nil nil commit))))
(transient-define-argument magit-autofixup:--context ()
:description "Diff context lines"
:class 'transient-option
:shortarg "-c"
:argument "--context="
:reader #'transient-read-number-N0)
(transient-define-argument magit-autofixup:--strict ()
:description "Strictness"
:class 'transient-option
:shortarg "-s"
:argument "--strict="
:reader #'transient-read-number-N0)
(defvar magit-post-commit-hook-commands
'(magit-commit-extend
magit-commit-fixup
magit-commit-augment
magit-commit-instant-fixup
magit-commit-instant-squash))
(defun magit-run-post-commit-hook ()
(when (and (not this-command)
(memq last-command magit-post-commit-hook-commands))
(run-hooks 'magit-post-commit-hook)))
;;; Pending Diff
(defun magit-commit-diff ()
(magit-repository-local-set 'this-commit-command
(if (eq this-command 'with-editor-finish)
'magit-commit--rebase
last-command))
(when (and git-commit-mode magit-commit-show-diff)
(when-let ((diff-buffer (magit-get-mode-buffer 'magit-diff-mode)))
;; This window just started displaying the commit message
;; buffer. Without this that buffer would immediately be
;; replaced with the diff buffer. See #2632.
(unrecord-window-buffer nil diff-buffer))
(message "Diffing changes to be committed (C-g to abort diffing)")
(let ((inhibit-quit nil))
(condition-case nil
(magit-commit-diff-1)
(quit)))))
(defun magit-commit-diff-1 ()
(let ((rev nil)
(arg "--cached")
(command (magit-repository-local-get 'this-commit-command))
(staged (magit-anything-staged-p))
(unstaged
;; Escape $GIT_DIR because `magit-anything-unstaged-p'
;; requires a working tree.
(magit-with-toplevel
(magit-anything-unstaged-p)))
(squash (let ((f (magit-git-dir "rebase-merge/rewritten-pending")))
(and (file-exists-p f) (length (magit-file-lines f)))))
(noalt nil))
(pcase (list staged unstaged command)
((and `(,_ ,_ magit-commit--rebase)
(guard (integerp squash)))
(setq rev (format "HEAD~%s" squash)))
(`(,_ ,_ magit-commit-amend)
(setq rev "HEAD^"))
((or `(,_ ,_ magit-commit-reword)
`(nil nil ,_))
(setq rev "HEAD^..HEAD")
(setq arg nil))
(`(,_ t magit-commit--all)
(setq rev "HEAD")
(setq arg nil))
(`(nil t handle-switch-frame)
;; Either --all or --allow-empty. Assume it is the former.
(setq rev "HEAD")
(setq arg nil)))
(cond
((not
(and (eq this-command 'magit-diff-while-committing)
(and-let* ((buf (magit-get-mode-buffer
'magit-diff-mode nil 'selected)))
(and (equal rev (buffer-local-value 'magit-buffer-range buf))
(equal arg (buffer-local-value 'magit-buffer-typearg buf)))))))
((eq command 'magit-commit-amend)
(setq rev nil))
((or squash (file-exists-p (magit-git-dir "rebase-merge/amend")))
(setq rev "HEAD^"))
(t
(message "No alternative diff while committing")
(setq noalt t)))
(unless noalt
(let ((magit-inhibit-save-previous-winconf 'unset)
(magit-display-buffer-noselect t)
(display-buffer-overriding-action
display-buffer-overriding-action))
(when magit-commit-diff-inhibit-same-window
(setq display-buffer-overriding-action
'(nil (inhibit-same-window t))))
(magit-diff-setup-buffer rev arg (car (magit-diff-arguments)) nil)))))
(add-hook 'server-switch-hook #'magit-commit-diff)
(add-hook 'with-editor-filter-visit-hook #'magit-commit-diff)
(add-to-list 'with-editor-server-window-alist
(cons git-commit-filename-regexp #'switch-to-buffer))
(defun magit-commit--reset-command ()
(magit-repository-local-delete 'this-commit-command))
;;; Message Utilities
(defun magit-commit-message-buffer ()
(let* ((find-file-visit-truename t) ; git uses truename of COMMIT_EDITMSG
(topdir (magit-toplevel)))
(--first (equal topdir (with-current-buffer it
(and git-commit-mode (magit-toplevel))))
(append (buffer-list (selected-frame))
(buffer-list)))))
(defvar magit-commit-add-log-insert-function #'magit-commit-add-log-insert
"Used by `magit-commit-add-log' to insert a single entry.")
(defun magit-commit-add-log ()
"Add a stub for the current change into the commit message buffer.
If no commit is in progress, then initiate it. Use the function
specified by variable `magit-commit-add-log-insert-function' to
actually insert the entry."
(interactive)
(pcase-let* ((hunk (and (magit-section-match 'hunk)
(magit-current-section)))
(log (magit-commit-message-buffer))
(`(,buf ,pos) (magit-diff-visit-file--noselect)))
(unless log
(unless (magit-commit-assert nil)
(user-error "Abort"))
(magit-commit-create)
(while (not (setq log (magit-commit-message-buffer)))
(sit-for 0.01)))
(magit--with-temp-position buf pos
(funcall magit-commit-add-log-insert-function log
(magit-file-relative-name)
(and hunk (add-log-current-defun))))))
(defun magit-commit-add-log-insert (buffer file defun)
(with-current-buffer buffer
(undo-boundary)
(goto-char (point-max))
(while (re-search-backward (concat "^" comment-start) nil t))
(save-restriction
(narrow-to-region (point-min) (point))
(cond ((re-search-backward (format "* %s\\(?: (\\([^)]+\\))\\)?: " file)
nil t)
(when (equal (match-string 1) defun)
(setq defun nil))
(re-search-forward ": "))
(t
(when (re-search-backward "^[\\*(].+\n" nil t)
(goto-char (match-end 0)))
(while (re-search-forward "^[^\\*\n].*\n" nil t))
(if defun
(progn (insert (format "* %s (%s): \n" file defun))
(setq defun nil))
(insert (format "* %s: \n" file)))
(backward-char)
(unless (looking-at "\n[\n\\']")
(insert ?\n)
(backward-char))))
(when defun
(forward-line)
(let ((limit (save-excursion
(and (re-search-forward "^\\*" nil t)
(point)))))
(unless (or (looking-back (format "(%s): " defun)
(line-beginning-position))
(re-search-forward (format "^(%s): " defun) limit t))
(while (re-search-forward "^[^\\*\n].*\n" limit t))
(insert (format "(%s): \n" defun))
(backward-char)))))))
;;; _
(provide 'magit-commit)
;;; magit-commit.el ends here

131
code/elpa/magit-20220821.1819/magit-core.el Normal file
View File

@ -0,0 +1,131 @@
;;; magit-core.el --- Core functionality -*- lexical-binding:t -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library requires several other libraries, so that yet other
;; libraries can just require this one, instead of having to require
;; all the other ones. In other words this separates the low-level
;; stuff from the rest. It also defines some Custom groups.
;;; Code:
(require 'magit-base)
(require 'magit-git)
(require 'magit-mode)
(require 'magit-margin)
(require 'magit-process)
(require 'magit-transient)
(require 'magit-autorevert)
(when (magit--libgit-available-p)
(condition-case err
(require 'magit-libgit)
(error
(setq magit-inhibit-libgit 'error)
(message "Error while loading `magit-libgit': %S" err)
(message "That is not fatal. The `libegit2' module just won't be used."))))
;;; Options
(defgroup magit nil
"Controlling Git from Emacs."
:link '(url-link "https://magit.vc")
:link '(info-link "(magit)FAQ")
:link '(info-link "(magit)")
:group 'tools)
(defgroup magit-essentials nil
"Options that every Magit user should briefly think about.
Each of these options falls into one or more of these categories:
* Options that affect Magit's behavior in fundamental ways.
* Options that affect safety.
* Options that affect performance.
* Options that are of a personal nature."
:link '(info-link "(magit)Essential Settings")
:group 'magit)
(defgroup magit-miscellaneous nil
"Miscellaneous Magit options."
:group 'magit)
(defgroup magit-commands nil
"Options controlling behavior of certain commands."
:group 'magit)
(defgroup magit-modes nil
"Modes used or provided by Magit."
:group 'magit)
(defgroup magit-buffers nil
"Options concerning Magit buffers."
:link '(info-link "(magit)Modes and Buffers")
:group 'magit)
(defgroup magit-refresh nil
"Options controlling how Magit buffers are refreshed."
:link '(info-link "(magit)Automatic Refreshing of Magit Buffers")
:group 'magit
:group 'magit-buffers)
(defgroup magit-faces nil
"Faces used by Magit."
:group 'magit
:group 'faces)
(custom-add-to-group 'magit-faces 'diff-refine-added 'custom-face)
(custom-add-to-group 'magit-faces 'diff-refine-removed 'custom-face)
(defgroup magit-extensions nil
"Extensions to Magit."
:group 'magit)
(custom-add-to-group 'magit-modes 'git-commit 'custom-group)
(custom-add-to-group 'magit-faces 'git-commit-faces 'custom-group)
(custom-add-to-group 'magit-modes 'git-rebase 'custom-group)
(custom-add-to-group 'magit-faces 'git-rebase-faces 'custom-group)
(custom-add-to-group 'magit 'magit-section 'custom-group)
(custom-add-to-group 'magit-faces 'magit-section-faces 'custom-group)
(custom-add-to-group 'magit-process 'with-editor 'custom-group)
(defgroup magit-related nil
"Options that are relevant to Magit but that are defined elsewhere."
:link '(custom-group-link vc)
:link '(custom-group-link smerge)
:link '(custom-group-link ediff)
:link '(custom-group-link auto-revert)
:group 'magit
:group 'magit-extensions
:group 'magit-essentials)
(custom-add-to-group 'magit-related 'auto-revert-check-vc-info 'custom-variable)
(custom-add-to-group 'magit-auto-revert 'auto-revert-check-vc-info 'custom-variable)
(custom-add-to-group 'magit-related 'ediff-window-setup-function 'custom-variable)
(custom-add-to-group 'magit-related 'smerge-refine-ignore-whitespace 'custom-variable)
(custom-add-to-group 'magit-related 'vc-follow-symlinks 'custom-variable)
;;; _
(provide 'magit-core)
;;; magit-core.el ends here

3466
code/elpa/magit-20220821.1819/magit-diff.el Normal file
View File

File diff suppressed because it is too large Load Diff

604
code/elpa/magit-20220821.1819/magit-ediff.el Normal file
View File

@ -0,0 +1,604 @@
;;; magit-ediff.el --- Ediff extension for Magit -*- lexical-binding:t -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library provides basic support for Ediff.
;;; Code:
(require 'magit)
(require 'ediff)
(require 'smerge-mode)
(defvar smerge-ediff-buf)
(defvar smerge-ediff-windows)
;;; Options
(defgroup magit-ediff nil
"Ediff support for Magit."
:link '(info-link "(magit)Ediffing")
:group 'magit-extensions)
(defcustom magit-ediff-quit-hook
'(magit-ediff-cleanup-auxiliary-buffers
magit-ediff-restore-previous-winconf)
"Hooks to run after finishing Ediff, when that was invoked using Magit.
The hooks are run in the Ediff control buffer. This is similar
to `ediff-quit-hook' but takes the needs of Magit into account.
The `ediff-quit-hook' is ignored by Ediff sessions which were
invoked using Magit."
:package-version '(magit . "2.2.0")
:group 'magit-ediff
:type 'hook
:get #'magit-hook-custom-get
:options '(magit-ediff-cleanup-auxiliary-buffers
magit-ediff-restore-previous-winconf))
(defcustom magit-ediff-dwim-resolve-function #'magit-ediff-resolve-rest
"The function `magit-ediff-dwim' uses to resolve conflicts."
:package-version '(magit . "3.4.0")
:group 'magit-ediff
:type '(choice (const magit-ediff-resolve-rest)
(const magit-ediff-resolve-all)
(const magit-git-mergetool)))
(defcustom magit-ediff-dwim-show-on-hunks nil
"Whether `magit-ediff-dwim' runs show variants on hunks.
If non-nil, `magit-ediff-show-staged' or
`magit-ediff-show-unstaged' are called based on what section the
hunk is in. Otherwise, `magit-ediff-dwim' runs
`magit-ediff-stage' when point is on an uncommitted hunk."
:package-version '(magit . "2.2.0")
:group 'magit-ediff
:type 'boolean)
(defcustom magit-ediff-show-stash-with-index t
"Whether `magit-ediff-show-stash' shows the state of the index.
If non-nil, use a third Ediff buffer to distinguish which changes
in the stash were staged. In cases where the stash contains no
staged changes, fall back to a two-buffer Ediff.
More specifically, a stash is a merge commit, stash@{N}, with
potentially three parents.
* stash@{N}^1 represents the `HEAD' commit at the time the stash
was created.
* stash@{N}^2 records any changes that were staged when the stash
was made.
* stash@{N}^3, if it exists, contains files that were untracked
when stashing.
If this option is non-nil, `magit-ediff-show-stash' will run
Ediff on a file using three buffers: one for stash@{N}, another
for stash@{N}^1, and a third for stash@{N}^2.
Otherwise, Ediff uses two buffers, comparing
stash@{N}^1..stash@{N}. Along with any unstaged changes, changes
in the index commit, stash@{N}^2, will be shown in this
comparison unless they conflicted with changes in the working
tree at the time of stashing."
:package-version '(magit . "2.6.0")
:group 'magit-ediff
:type 'boolean)
(defvar magit-ediff-use-indirect-buffers nil
"Whether to use indirect buffers.
Ediff already does a lot of buffer and file shuffling and I
recommend you do not further complicate that by enabling this.")
;;; Commands
(defvar magit-ediff-previous-winconf nil)
;;;###autoload (autoload 'magit-ediff "magit-ediff" nil)
(transient-define-prefix magit-ediff ()
"Show differences using the Ediff package."
:info-manual "(ediff)"
["Ediff"
[("E" "Dwim" magit-ediff-dwim)
("s" "Stage" magit-ediff-stage)]
[("m" "Resolve rest" magit-ediff-resolve-rest)
("M" "Resolve all conflicts" magit-ediff-resolve-all)
("t" "Resolve using mergetool" magit-git-mergetool)]
[("u" "Show unstaged" magit-ediff-show-unstaged)
("i" "Show staged" magit-ediff-show-staged)
("w" "Show worktree" magit-ediff-show-working-tree)]
[("c" "Show commit" magit-ediff-show-commit)
("r" "Show range" magit-ediff-compare)
("z" "Show stash" magit-ediff-show-stash)]])
(defmacro magit-ediff-buffers (a b &optional c setup quit file)
"Run Ediff on two or three buffers.
This is a wrapper around `ediff-buffers-internal'.
A, B and C have the form (GET-BUFFER CREATE-BUFFER). If
GET-BUFFER returns a non-nil value, then that buffer is used and
it is not killed when exiting Ediff. Otherwise CREATE-BUFFER
must return a buffer and that is killed when exiting Ediff.
If non-nil, SETUP must be a function. It is called without
arguments after Ediff is done setting up buffers.
If non-nil, QUIT must be a function. It is added to
`ediff-quit-hook' and is called without arguments.
If FILE is non-nil, then perform a merge. The merge result
is put in FILE."
(let (get make kill (char ?A))
(dolist (spec (list a b c))
(if (not spec)
(push nil make)
(pcase-let ((`(,g ,m) spec))
(let ((b (intern (format "buf%c" char))))
(push `(,b ,g) get)
;; This is an unfortunate complication that I have added for
;; the benefit of one user. Pretend we used this instead:
;; (push `(or ,b ,m) make)
(push `(if ,b
(if magit-ediff-use-indirect-buffers
(prog1 (make-indirect-buffer
,b
(generate-new-buffer-name (buffer-name ,b))
t)
(setq ,b nil))
,b)
,m)
make)
(push `(unless ,b
;; For merge jobs Ediff switches buffer names around.
;; See (if ediff-merge-job ...) in `ediff-setup'.
(let ((var ,(if (and file (= char ?C))
'ediff-ancestor-buffer
(intern (format "ediff-buffer-%c" char)))))
(ediff-kill-buffer-carefully var)))
kill))
(cl-incf char))))
(setq get (nreverse get))
(setq make (nreverse make))
(setq kill (nreverse kill))
(let ((mconf (cl-gensym "conf"))
(mfile (cl-gensym "file")))
`(magit-with-toplevel
(let ((,mconf (current-window-configuration))
(,mfile ,file)
,@get)
(ediff-buffers-internal
,@make
(list ,@(and setup (list setup))
(lambda ()
;; We do not want to kill buffers that existed before
;; Ediff was invoked, so we cannot use Ediff's default
;; quit functions. Ediff splits quitting across two
;; hooks for merge jobs but we only ever use one.
(setq-local ediff-quit-merge-hook nil)
(setq-local ediff-quit-hook
(list
,@(and quit (list quit))
(lambda ()
,@kill
(let ((magit-ediff-previous-winconf ,mconf))
(run-hooks 'magit-ediff-quit-hook)))))))
(pcase (list ,(and c t) (and ,mfile t))
('(nil nil) 'ediff-buffers)
('(nil t) 'ediff-merge-buffers)
('(t nil) 'ediff-buffers3)
('(t t) 'ediff-merge-buffers-with-ancestor))
,mfile))))))
;;;###autoload
(defun magit-ediff-resolve-all (file)
"Resolve all conflicts in the FILE at point using Ediff.
If there is no file at point or if it doesn't have any unmerged
changes, then prompt for a file.
See info node `(magit) Ediffing' for more information about this
and alternative commands."
(interactive (list (magit-read-unmerged-file)))
(magit-with-toplevel
(let* ((revA (or (magit-name-branch "HEAD")
(magit-commit-p "HEAD")))
(revB (cl-find-if (lambda (head) (file-exists-p (magit-git-dir head)))
'("MERGE_HEAD" "CHERRY_PICK_HEAD" "REVERT_HEAD")))
(revB (or (magit-name-branch revB)
(magit-commit-p revB)))
(revC (magit-commit-p (magit-git-string "merge-base" revA revB)))
(fileA (magit--rev-file-name file revA revB))
(fileB (magit--rev-file-name file revB revA))
(fileC (or (magit--rev-file-name file revC revA)
(magit--rev-file-name file revC revB))))
;; Ediff assumes that the FILE where it is going to store the merge
;; result does not exist yet, so move the existing file out of the
;; way. If a buffer visits FILE, then we have to kill that upfront.
(when-let ((buffer (find-buffer-visiting file)))
(when (and (buffer-modified-p buffer)
(not (y-or-n-p (format "Save buffer %s %s? "
(buffer-name buffer)
"(cannot continue otherwise)"))))
(user-error "Abort"))
(kill-buffer buffer))
(let ((orig (concat file ".ORIG")))
(when (file-exists-p orig)
(rename-file orig (make-temp-name (concat orig "_"))))
(rename-file file orig))
(let ((setup (lambda ()
;; Use the same conflict marker style as Git uses.
(setq-local ediff-combination-pattern
'("<<<<<<< HEAD" A
,(format "||||||| %s" revC) Ancestor
"=======" B
,(format ">>>>>>> %s" revB)))))
(quit (lambda ()
;; For merge jobs Ediff switches buffer names around.
;; At this point `ediff-buffer-C' no longer refer to
;; the ancestor buffer but to the merge result buffer.
;; See (if ediff-merge-job ...) in `ediff-setup'.
(when (buffer-live-p ediff-buffer-C)
(with-current-buffer ediff-buffer-C
(save-buffer)
(save-excursion
(goto-char (point-min))
(unless (re-search-forward "^<<<<<<< " nil t)
(magit-stage-file file))))))))
(if fileC
(magit-ediff-buffers
((magit-get-revision-buffer revA fileA)
(magit-find-file-noselect revA fileA))
((magit-get-revision-buffer revB fileB)
(magit-find-file-noselect revB fileB))
((magit-get-revision-buffer revC fileC)
(magit-find-file-noselect revC fileC))
setup quit file)
(magit-ediff-buffers
((magit-get-revision-buffer revA fileA)
(magit-find-file-noselect revA fileA))
((magit-get-revision-buffer revB fileB)
(magit-find-file-noselect revB fileB))
nil setup quit file))))))
;;;###autoload
(defun magit-ediff-resolve-rest (file)
"Resolve outstanding conflicts in the FILE at point using Ediff.
If there is no file at point or if it doesn't have any unmerged
changes, then prompt for a file.
See info node `(magit) Ediffing' for more information about this
and alternative commands."
(interactive (list (magit-read-unmerged-file)))
(magit-with-toplevel
(with-current-buffer (find-file-noselect file)
(smerge-ediff)
(setq-local
ediff-quit-hook
(lambda ()
(let ((bufC ediff-buffer-C)
(bufS smerge-ediff-buf))
(with-current-buffer bufS
(when (yes-or-no-p (format "Conflict resolution finished; save %s? "
buffer-file-name))
(erase-buffer)
(insert-buffer-substring bufC)
(save-buffer))))
(when (buffer-live-p ediff-buffer-A) (kill-buffer ediff-buffer-A))
(when (buffer-live-p ediff-buffer-B) (kill-buffer ediff-buffer-B))
(when (buffer-live-p ediff-buffer-C) (kill-buffer ediff-buffer-C))
(when (buffer-live-p ediff-ancestor-buffer)
(kill-buffer ediff-ancestor-buffer))
(let ((magit-ediff-previous-winconf smerge-ediff-windows))
(run-hooks 'magit-ediff-quit-hook)))))))
;;;###autoload
(defun magit-ediff-stage (file)
"Stage and unstage changes to FILE using Ediff.
FILE has to be relative to the top directory of the repository."
(interactive
(let ((files (magit-tracked-files)))
(list (magit-completing-read "Selectively stage file" files nil t nil nil
(car (member (magit-current-file) files))))))
(magit-with-toplevel
(let* ((bufA (magit-get-revision-buffer "HEAD" file))
(bufB (magit-get-revision-buffer "{index}" file))
(lockB (and bufB (buffer-local-value 'buffer-read-only bufB)))
(bufC (get-file-buffer file))
;; Use the same encoding for all three buffers or we
;; may end up changing the file in an unintended way.
(bufC* (or bufC (find-file-noselect file)))
(coding-system-for-read
(buffer-local-value 'buffer-file-coding-system bufC*))
(bufA* (magit-find-file-noselect-1 "HEAD" file t))
(bufB* (magit-find-file-index-noselect file t)))
(setf (buffer-local-value 'buffer-read-only bufB*) nil)
(magit-ediff-buffers
(bufA bufA*)
(bufB bufB*)
(bufC bufC*)
nil
(lambda ()
(when (buffer-live-p ediff-buffer-B)
(when lockB
(setf (buffer-local-value 'buffer-read-only bufB) t))
(when (buffer-modified-p ediff-buffer-B)
(with-current-buffer ediff-buffer-B
(magit-update-index))))
(when (and (buffer-live-p ediff-buffer-C)
(buffer-modified-p ediff-buffer-C))
(with-current-buffer ediff-buffer-C
(when (y-or-n-p (format "Save file %s? " buffer-file-name))
(save-buffer)))))))))
;;;###autoload
(defun magit-ediff-compare (revA revB fileA fileB)
"Compare REVA:FILEA with REVB:FILEB using Ediff.
FILEA and FILEB have to be relative to the top directory of the
repository. If REVA or REVB is nil, then this stands for the
working tree state.
If the region is active, use the revisions on the first and last
line of the region. With a prefix argument, instead of diffing
the revisions, choose a revision to view changes along, starting
at the common ancestor of both revisions (i.e., use a \"...\"
range)."
(interactive
(pcase-let ((`(,revA ,revB) (magit-ediff-compare--read-revisions
nil current-prefix-arg)))
(nconc (list revA revB)
(magit-ediff-read-files revA revB))))
(magit-ediff-buffers
((if revA (magit-get-revision-buffer revA fileA) (get-file-buffer fileA))
(if revA (magit-find-file-noselect revA fileA) (find-file-noselect fileA)))
((if revB (magit-get-revision-buffer revB fileB) (get-file-buffer fileB))
(if revB (magit-find-file-noselect revB fileB) (find-file-noselect fileB)))))
(defun magit-ediff-compare--read-revisions (&optional arg mbase)
(let ((input (or arg (magit-diff-read-range-or-commit
"Compare range or commit"
nil mbase))))
(--if-let (magit-split-range input)
(-cons-to-list it)
(list input nil))))
(defun magit-ediff-read-files (revA revB &optional fileB)
"Read file in REVB, return it and the corresponding file in REVA.
When FILEB is non-nil, use this as REVB's file instead of
prompting for it."
(unless (and fileB (member fileB (magit-revision-files revB)))
(setq fileB
(or (and fileB
magit-buffer-log-files
(derived-mode-p 'magit-log-mode)
(member "--follow" magit-buffer-log-args)
(cdr (assoc fileB
(magit-renamed-files
revB
(oref (car (oref magit-root-section children))
value)))))
(magit-read-file-choice
(format "File to compare between %s and %s"
revA (or revB "the working tree"))
(magit-changed-files revA revB)
(format "No changed files between %s and %s"
revA (or revB "the working tree"))))))
(list (or (car (member fileB (magit-revision-files revA)))
(cdr (assoc fileB (magit-renamed-files revB revA)))
(magit-read-file-choice
(format "File in %s to compare with %s in %s"
revA fileB (or revB "the working tree"))
(magit-changed-files revB revA)
(format "No files have changed between %s and %s"
revA revB)))
fileB))
;;;###autoload
(defun magit-ediff-dwim ()
"Compare, stage, or resolve using Ediff.
This command tries to guess what file, and what commit or range
the user wants to compare, stage, or resolve using Ediff. It
might only be able to guess either the file, or range or commit,
in which case the user is asked about the other. It might not
always guess right, in which case the appropriate `magit-ediff-*'
command has to be used explicitly. If it cannot read the user's
mind at all, then it asks the user for a command to run."
(interactive)
(magit-section-case
(hunk (save-excursion
(goto-char (oref (oref it parent) start))
(magit-ediff-dwim)))
(t
(let ((range (magit-diff--dwim))
(file (magit-current-file))
command revA revB)
(pcase range
((and (guard (not magit-ediff-dwim-show-on-hunks))
(or 'unstaged 'staged))
(setq command (if (magit-anything-unmerged-p)
magit-ediff-dwim-resolve-function
#'magit-ediff-stage)))
('unstaged (setq command #'magit-ediff-show-unstaged))
('staged (setq command #'magit-ediff-show-staged))
(`(commit . ,value)
(setq command #'magit-ediff-show-commit)
(setq revB value))
(`(stash . ,value)
(setq command #'magit-ediff-show-stash)
(setq revB value))
((pred stringp)
(pcase-let ((`(,a ,b) (magit-ediff-compare--read-revisions range)))
(setq command #'magit-ediff-compare)
(setq revA a)
(setq revB b)))
(_
(when (derived-mode-p 'magit-diff-mode)
(pcase (magit-diff-type)
('committed (pcase-let ((`(,a ,b)
(magit-ediff-compare--read-revisions
magit-buffer-range)))
(setq revA a)
(setq revB b)))
((guard (not magit-ediff-dwim-show-on-hunks))
(setq command #'magit-ediff-stage))
('unstaged (setq command #'magit-ediff-show-unstaged))
('staged (setq command #'magit-ediff-show-staged))
('undefined (setq command nil))
(_ (setq command nil))))))
(cond ((not command)
(call-interactively
(magit-read-char-case
"Failed to read your mind; do you want to " t
(?c "[c]ommit" #'magit-ediff-show-commit)
(?r "[r]ange" #'magit-ediff-compare)
(?s "[s]tage" #'magit-ediff-stage)
(?m "[m] resolve remaining conflicts"
#'magit-ediff-resolve-rest)
(?M "[M] resolve all conflicts"
#'magit-ediff-resolve-all))))
((eq command #'magit-ediff-compare)
(apply #'magit-ediff-compare revA revB
(magit-ediff-read-files revA revB file)))
((eq command #'magit-ediff-show-commit)
(magit-ediff-show-commit revB))
((eq command #'magit-ediff-show-stash)
(magit-ediff-show-stash revB))
(file
(funcall command file))
(t
(call-interactively command)))))))
;;;###autoload
(defun magit-ediff-show-staged (file)
"Show staged changes using Ediff.
This only allows looking at the changes; to stage, unstage,
and discard changes using Ediff, use `magit-ediff-stage'.
FILE must be relative to the top directory of the repository."
(interactive
(list (magit-read-file-choice "Show staged changes for file"
(magit-staged-files)
"No staged files")))
(magit-ediff-buffers ((magit-get-revision-buffer "HEAD" file)
(magit-find-file-noselect "HEAD" file))
((get-buffer (concat file ".~{index}~"))
(magit-find-file-index-noselect file t))))
;;;###autoload
(defun magit-ediff-show-unstaged (file)
"Show unstaged changes using Ediff.
This only allows looking at the changes; to stage, unstage,
and discard changes using Ediff, use `magit-ediff-stage'.
FILE must be relative to the top directory of the repository."
(interactive
(list (magit-read-file-choice "Show unstaged changes for file"
(magit-unstaged-files)
"No unstaged files")))
(magit-ediff-buffers ((get-buffer (concat file ".~{index}~"))
(magit-find-file-index-noselect file t))
((get-file-buffer file)
(find-file-noselect file))))
;;;###autoload
(defun magit-ediff-show-working-tree (file)
"Show changes between `HEAD' and working tree using Ediff.
FILE must be relative to the top directory of the repository."
(interactive
(list (magit-read-file-choice "Show changes in file"
(magit-changed-files "HEAD")
"No changed files")))
(magit-ediff-buffers ((magit-get-revision-buffer "HEAD" file)
(magit-find-file-noselect "HEAD" file))
((get-file-buffer file)
(find-file-noselect file))))
;;;###autoload
(defun magit-ediff-show-commit (commit)
"Show changes introduced by COMMIT using Ediff."
(interactive (list (magit-read-branch-or-commit "Revision")))
(let ((revA (concat commit "^"))
(revB commit))
(apply #'magit-ediff-compare
revA revB
(magit-ediff-read-files revA revB (magit-current-file)))))
;;;###autoload
(defun magit-ediff-show-stash (stash)
"Show changes introduced by STASH using Ediff.
`magit-ediff-show-stash-with-index' controls whether a
three-buffer Ediff is used in order to distinguish changes in the
stash that were staged."
(interactive (list (magit-read-stash "Stash")))
(pcase-let* ((revA (concat stash "^1"))
(revB (concat stash "^2"))
(revC stash)
(`(,fileA ,fileC) (magit-ediff-read-files revA revC))
(fileB fileC))
(if (and magit-ediff-show-stash-with-index
(member fileA (magit-changed-files revB revA)))
(magit-ediff-buffers
((magit-get-revision-buffer revA fileA)
(magit-find-file-noselect revA fileA))
((magit-get-revision-buffer revB fileB)
(magit-find-file-noselect revB fileB))
((magit-get-revision-buffer revC fileC)
(magit-find-file-noselect revC fileC)))
(magit-ediff-compare revA revC fileA fileC))))
(defun magit-ediff-cleanup-auxiliary-buffers ()
(let* ((ctl-buf ediff-control-buffer)
(ctl-win (ediff-get-visible-buffer-window ctl-buf))
(ctl-frm ediff-control-frame)
(main-frame (cond ((window-live-p ediff-window-A)
(window-frame ediff-window-A))
((window-live-p ediff-window-B)
(window-frame ediff-window-B)))))
(ediff-kill-buffer-carefully ediff-diff-buffer)
(ediff-kill-buffer-carefully ediff-custom-diff-buffer)
(ediff-kill-buffer-carefully ediff-fine-diff-buffer)
(ediff-kill-buffer-carefully ediff-tmp-buffer)
(ediff-kill-buffer-carefully ediff-error-buffer)
(ediff-kill-buffer-carefully ediff-msg-buffer)
(ediff-kill-buffer-carefully ediff-debug-buffer)
(when (boundp 'ediff-patch-diagnostics)
(ediff-kill-buffer-carefully ediff-patch-diagnostics))
(cond ((and (ediff-window-display-p)
(frame-live-p ctl-frm))
(delete-frame ctl-frm))
((window-live-p ctl-win)
(delete-window ctl-win)))
(ediff-kill-buffer-carefully ctl-buf)
(when (frame-live-p main-frame)
(select-frame main-frame))))
(defun magit-ediff-restore-previous-winconf ()
(set-window-configuration magit-ediff-previous-winconf))
;;; _
(provide 'magit-ediff)
;;; magit-ediff.el ends here

917
code/elpa/magit-20220821.1819/magit-extras.el Normal file
View File

@ -0,0 +1,917 @@
;;; magit-extras.el --- Additional functionality for Magit -*- lexical-binding:t -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Additional functionality for Magit.
;;; Code:
(require 'magit)
;; For `magit-do-async-shell-command'.
(declare-function dired-read-shell-command "dired-aux" (prompt arg files))
;; For `magit-project-status'.
(declare-function vc-git-command "vc-git"
(buffer okstatus file-or-list &rest flags))
(defvar ido-exit)
(defvar ido-fallback)
(defvar project-prefix-map)
(defvar project-switch-commands)
(defgroup magit-extras nil
"Additional functionality for Magit."
:group 'magit-extensions)
;;; Git Tools
;;;; Git-Mergetool
;;;###autoload (autoload 'magit-git-mergetool "magit-extras" nil t)
(transient-define-prefix magit-git-mergetool (file args &optional transient)
"Resolve conflicts in FILE using \"git mergetool --gui\".
With a prefix argument allow changing ARGS using a transient
popup. See info node `(magit) Ediffing' for information about
alternative commands."
:man-page "git-mergetool"
["Settings"
("-t" magit-git-mergetool:--tool)
("=t" magit-merge.guitool)
("=T" magit-merge.tool)
("-r" magit-mergetool.hideResolved)
("-b" magit-mergetool.keepBackup)
("-k" magit-mergetool.keepTemporaries)
("-w" magit-mergetool.writeToTemp)]
["Actions"
(" m" "Invoke mergetool" magit-git-mergetool)]
(interactive
(if (and (not (eq transient-current-prefix 'magit-git-mergetool))
current-prefix-arg)
(list nil nil t)
(list (magit-read-unmerged-file "Resolve")
(transient-args 'magit-git-mergetool))))
(if transient
(transient-setup 'magit-git-mergetool)
(magit-run-git-async "mergetool" "--gui" args "--" file)))
(transient-define-infix magit-git-mergetool:--tool ()
:description "Override mergetool"
:class 'transient-option
:shortarg "-t"
:argument "--tool="
:reader #'magit--read-mergetool)
(transient-define-infix magit-merge.guitool ()
:class 'magit--git-variable
:variable "merge.guitool"
:global t
:reader #'magit--read-mergetool)
(transient-define-infix magit-merge.tool ()
:class 'magit--git-variable
:variable "merge.tool"
:global t
:reader #'magit--read-mergetool)
(defun magit--read-mergetool (prompt _initial-input history)
(let ((choices nil)
(lines (cdr (magit-git-lines "mergetool" "--tool-help"))))
(while (string-prefix-p "\t\t" (car lines))
(push (substring (pop lines) 2) choices))
(setq choices (nreverse choices))
(magit-completing-read (or prompt "Select mergetool")
choices nil t nil history)))
(transient-define-infix magit-mergetool.hideResolved ()
:class 'magit--git-variable:boolean
:variable "mergetool.hideResolved"
:default "false"
:global t)
(transient-define-infix magit-mergetool.keepBackup ()
:class 'magit--git-variable:boolean
:variable "mergetool.keepBackup"
:default "true"
:global t)
(transient-define-infix magit-mergetool.keepTemporaries ()
:class 'magit--git-variable:boolean
:variable "mergetool.keepTemporaries"
:default "false"
:global t)
(transient-define-infix magit-mergetool.writeToTemp ()
:class 'magit--git-variable:boolean
:variable "mergetool.writeToTemp"
:default "false"
:global t)
;;;; Git-Gui
;;;###autoload
(defun magit-run-git-gui-blame (commit filename &optional linenum)
"Run `git gui blame' on the given FILENAME and COMMIT.
Interactively run it for the current file and the `HEAD', with a
prefix or when the current file cannot be determined let the user
choose. When the current buffer is visiting FILENAME instruct
blame to center around the line point is on."
(interactive
(let (revision filename)
(when (or current-prefix-arg
(not (setq revision "HEAD"
filename (magit-file-relative-name nil 'tracked))))
(setq revision (magit-read-branch-or-commit "Blame from revision"))
(setq filename (magit-read-file-from-rev revision "Blame file")))
(list revision filename
(and (equal filename
(ignore-errors
(magit-file-relative-name buffer-file-name)))
(line-number-at-pos)))))
(magit-with-toplevel
(magit-process-git 0 "gui" "blame"
(and linenum (list (format "--line=%d" linenum)))
commit
filename)))
;;;; Gitk
(defcustom magit-gitk-executable
(or (and (eq system-type 'windows-nt)
(let ((exe (magit-git-string
"-c" "alias.X=!x() { which \"$1\" | cygpath -mf -; }; x"
"X" "gitk.exe")))
(and exe (file-executable-p exe) exe)))
(executable-find "gitk") "gitk")
"The Gitk executable."
:group 'magit-extras
:set-after '(magit-git-executable)
:type 'string)
;;;###autoload
(defun magit-run-git-gui ()
"Run `git gui' for the current git repository."
(interactive)
(magit-with-toplevel (magit-process-git 0 "gui")))
;;;###autoload
(defun magit-run-gitk ()
"Run `gitk' in the current repository."
(interactive)
(magit-process-file magit-gitk-executable nil 0))
;;;###autoload
(defun magit-run-gitk-branches ()
"Run `gitk --branches' in the current repository."
(interactive)
(magit-process-file magit-gitk-executable nil 0 nil "--branches"))
;;;###autoload
(defun magit-run-gitk-all ()
"Run `gitk --all' in the current repository."
(interactive)
(magit-process-file magit-gitk-executable nil 0 nil "--all"))
;;; Emacs Tools
;;;###autoload
(defun ido-enter-magit-status ()
"Drop into `magit-status' from file switching.
This command does not work in Emacs 26.1.
See https://github.com/magit/magit/issues/3634
and https://debbugs.gnu.org/cgi/bugreport.cgi?bug=31707.
To make this command available use something like:
(add-hook \\='ido-setup-hook
(lambda ()
(define-key ido-completion-map
(kbd \"C-x g\") \\='ido-enter-magit-status)))
Starting with Emacs 25.1 the Ido keymaps are defined just once
instead of every time Ido is invoked, so now you can modify it
like pretty much every other keymap:
(define-key ido-common-completion-map
(kbd \"C-x g\") \\='ido-enter-magit-status)"
(interactive)
(setq ido-exit 'fallback)
(setq ido-fallback #'magit-status) ; for Emacs >= 26.2
(with-no-warnings (setq fallback #'magit-status)) ; for Emacs 25
(exit-minibuffer))
;;;###autoload
(defun magit-project-status ()
"Run `magit-status' in the current project's root."
(interactive)
(if (fboundp 'project-root)
(magit-status-setup-buffer (project-root (project-current t)))
(user-error "`magit-project-status' requires `project' 0.3.0 or greater")))
(defvar magit-bind-magit-project-status t
"Whether to bind \"m\" to `magit-project-status' in `project-prefix-map'.
If so, then an entry is added to `project-switch-commands' as
well. If you want to use another key, then you must set this
to nil before loading Magit to prevent \"m\" from being bound.")
(with-eval-after-load 'project
;; Only more recent versions of project.el have `project-prefix-map' and
;; `project-switch-commands', though project.el is available in Emacs 25.
(when (and magit-bind-magit-project-status
(boundp 'project-prefix-map)
;; Only modify if it hasn't already been modified.
(equal project-switch-commands
(eval (car (get 'project-switch-commands 'standard-value))
t)))
(define-key project-prefix-map "m" #'magit-project-status)
(add-to-list 'project-switch-commands '(magit-project-status "Magit") t)))
;;;###autoload
(defun magit-dired-jump (&optional other-window)
"Visit file at point using Dired.
With a prefix argument, visit in another window. If there
is no file at point, then instead visit `default-directory'."
(interactive "P")
(dired-jump other-window
(and-let* ((file (magit-file-at-point)))
(expand-file-name (if (file-directory-p file)
(file-name-as-directory file)
file)))))
;;;###autoload
(defun magit-dired-log (&optional follow)
"Show log for all marked files, or the current file."
(interactive "P")
(if-let ((topdir (magit-toplevel default-directory)))
(let ((args (car (magit-log-arguments)))
(files (compat-dired-get-marked-files
nil nil #'magit-file-tracked-p nil
"No marked file is being tracked by Git")))
(when (and follow
(not (member "--follow" args))
(not (cdr files)))
(push "--follow" args))
(magit-log-setup-buffer
(list (or (magit-get-current-branch) "HEAD"))
args
(let ((default-directory topdir))
(mapcar #'file-relative-name files))
magit-log-buffer-file-locked))
(magit--not-inside-repository-error)))
;;;###autoload
(defun magit-dired-am-apply-patches (repo &optional arg)
"In Dired, apply the marked (or next ARG) files as patches.
If inside a repository, then apply in that. Otherwise prompt
for a repository."
(interactive (list (or (magit-toplevel)
(magit-read-repository t))
current-prefix-arg))
(let ((files (compat-dired-get-marked-files nil arg nil nil t)))
(magit-status-setup-buffer repo)
(magit-am-apply-patches files)))
;;;###autoload
(defun magit-do-async-shell-command (file)
"Open FILE with `dired-do-async-shell-command'.
Interactively, open the file at point."
(interactive (list (or (magit-file-at-point)
(completing-read "Act on file: "
(magit-list-files)))))
(require 'dired-aux)
(dired-do-async-shell-command
(dired-read-shell-command "& on %s: " current-prefix-arg (list file))
nil (list file)))
;;; Shift Selection
(defun magit--turn-on-shift-select-mode-p ()
(and shift-select-mode
this-command-keys-shift-translated
(not mark-active)
(not (eq (car-safe transient-mark-mode) 'only))))
;;;###autoload
(defun magit-previous-line (&optional arg try-vscroll)
"Like `previous-line' but with Magit-specific shift-selection.
Magit's selection mechanism is based on the region but selects an
area that is larger than the region. This causes `previous-line'
when invoked while holding the shift key to move up one line and
thereby select two lines. When invoked inside a hunk body this
command does not move point on the first invocation and thereby
it only selects a single line. Which inconsistency you prefer
is a matter of preference."
(declare (interactive-only
"use `forward-line' with negative argument instead."))
(interactive "p\np")
(unless arg (setq arg 1))
(let ((stay (or (magit-diff-inside-hunk-body-p)
(magit-section-position-in-heading-p))))
(if (and stay (= arg 1) (magit--turn-on-shift-select-mode-p))
(push-mark nil nil t)
(with-no-warnings
(handle-shift-selection)
(previous-line (if stay (max (1- arg) 1) arg) try-vscroll)))))
;;;###autoload
(defun magit-next-line (&optional arg try-vscroll)
"Like `next-line' but with Magit-specific shift-selection.
Magit's selection mechanism is based on the region but selects
an area that is larger than the region. This causes `next-line'
when invoked while holding the shift key to move down one line
and thereby select two lines. When invoked inside a hunk body
this command does not move point on the first invocation and
thereby it only selects a single line. Which inconsistency you
prefer is a matter of preference."
(declare (interactive-only forward-line))
(interactive "p\np")
(unless arg (setq arg 1))
(let ((stay (or (magit-diff-inside-hunk-body-p)
(magit-section-position-in-heading-p))))
(if (and stay (= arg 1) (magit--turn-on-shift-select-mode-p))
(push-mark nil nil t)
(with-no-warnings
(handle-shift-selection)
(next-line (if stay (max (1- arg) 1) arg) try-vscroll)))))
;;; Clean
;;;###autoload
(defun magit-clean (&optional arg)
"Remove untracked files from the working tree.
With a prefix argument also remove ignored files,
with two prefix arguments remove ignored files only.
\n(git clean -f -d [-x|-X])"
(interactive "p")
(when (yes-or-no-p (format "Remove %s files? "
(pcase arg
(1 "untracked")
(4 "untracked and ignored")
(_ "ignored"))))
(magit-wip-commit-before-change)
(magit-run-git "clean" "-f" "-d" (pcase arg (4 "-x") (16 "-X")))))
(put 'magit-clean 'disabled t)
;;; ChangeLog
;;;###autoload
(defun magit-generate-changelog (&optional amending)
"Insert ChangeLog entries into the current buffer.
The entries are generated from the diff being committed.
If prefix argument, AMENDING, is non-nil, include changes
in HEAD as well as staged changes in the diff to check."
(interactive "P")
(unless (magit-commit-message-buffer)
(user-error "No commit in progress"))
(require 'diff-mode) ; `diff-add-log-current-defuns'.
(require 'vc-git) ; `vc-git-diff'.
(require 'add-log) ; `change-log-insert-entries'.
(cond
((and (fboundp 'change-log-insert-entries)
(fboundp 'diff-add-log-current-defuns))
(setq default-directory
(if (and (file-regular-p "gitdir")
(not (magit-git-true "rev-parse" "--is-inside-work-tree"))
(magit-git-true "rev-parse" "--is-inside-git-dir"))
(file-name-directory (magit-file-line "gitdir"))
(magit-toplevel)))
(let ((rev1 (if amending "HEAD^1" "HEAD"))
(rev2 nil))
;; Magit may have updated the files without notifying vc, but
;; `diff-add-log-current-defuns' relies on vc being up-to-date.
(mapc #'vc-file-clearprops (magit-staged-files))
(change-log-insert-entries
(with-temp-buffer
(vc-git-command (current-buffer) 1 nil
"diff-index" "--exit-code" "--patch"
(and (magit-anything-staged-p) "--cached")
rev1 "--")
;; `diff-find-source-location' consults these vars.
(defvar diff-vc-revisions)
(setq-local diff-vc-revisions (list rev1 rev2))
(setq-local diff-vc-backend 'Git)
(diff-add-log-current-defuns)))))
(t (user-error "`magit-generate-changelog' requires Emacs 27 or greater"))))
;;;###autoload
(defun magit-add-change-log-entry (&optional whoami file-name other-window)
"Find change log file and add date entry and item for current change.
This differs from `add-change-log-entry' (which see) in that
it acts on the current hunk in a Magit buffer instead of on
a position in a file-visiting buffer."
(interactive (list current-prefix-arg
(prompt-for-change-log-name)))
(pcase-let ((`(,buf ,pos) (magit-diff-visit-file--noselect)))
(magit--with-temp-position buf pos
(let ((add-log-buffer-file-name-function
(lambda ()
(or magit-buffer-file-name
(buffer-file-name)))))
(add-change-log-entry whoami file-name other-window)))))
;;;###autoload
(defun magit-add-change-log-entry-other-window (&optional whoami file-name)
"Find change log file in other window and add entry and item.
This differs from `add-change-log-entry-other-window' (which see)
in that it acts on the current hunk in a Magit buffer instead of
on a position in a file-visiting buffer."
(interactive (and current-prefix-arg
(list current-prefix-arg
(prompt-for-change-log-name))))
(magit-add-change-log-entry whoami file-name t))
;;; Edit Line Commit
;;;###autoload
(defun magit-edit-line-commit (&optional type)
"Edit the commit that added the current line.
With a prefix argument edit the commit that removes the line,
if any. The commit is determined using `git blame' and made
editable using `git rebase --interactive' if it is reachable
from `HEAD', or by checking out the commit (or a branch that
points at it) otherwise."
(interactive (list (and current-prefix-arg 'removal)))
(let* ((chunk (magit-current-blame-chunk (or type 'addition)))
(rev (oref chunk orig-rev)))
(if (string-match-p "\\`0\\{40,\\}\\'" rev)
(message "This line has not been committed yet")
(let ((rebase (magit-rev-ancestor-p rev "HEAD"))
(file (expand-file-name (oref chunk orig-file)
(magit-toplevel))))
(if rebase
(let ((magit--rebase-published-symbol 'edit-published))
(magit-rebase-edit-commit rev (magit-rebase-arguments)))
(magit-checkout (or (magit-rev-branch rev) rev)))
(unless (and buffer-file-name
(file-equal-p file buffer-file-name))
(let ((blame-type (and magit-blame-mode magit-blame-type)))
(if rebase
(set-process-sentinel
magit-this-process
(lambda (process event)
(magit-sequencer-process-sentinel process event)
(when (eq (process-status process) 'exit)
(find-file file)
(when blame-type
(magit-blame--pre-blame-setup blame-type)
(magit-blame--run (magit-blame-arguments))))))
(find-file file)
(when blame-type
(magit-blame--pre-blame-setup blame-type)
(magit-blame--run (magit-blame-arguments))))))))))
(put 'magit-edit-line-commit 'disabled t)
;;;###autoload
(defun magit-diff-edit-hunk-commit (file)
"From a hunk, edit the respective commit and visit the file.
First visit the file being modified by the hunk at the correct
location using `magit-diff-visit-file'. This actually visits a
blob. When point is on a diff header, not within an individual
hunk, then this visits the blob the first hunk is about.
Then invoke `magit-edit-line-commit', which uses an interactive
rebase to make the commit editable, or if that is not possible
because the commit is not reachable from `HEAD' by checking out
that commit directly. This also causes the actual worktree file
to be visited.
Neither the blob nor the file buffer are killed when finishing
the rebase. If that is undesirable, then it might be better to
use `magit-rebase-edit-command' instead of this command."
(interactive (list (magit-file-at-point t t)))
(let ((magit-diff-visit-previous-blob nil))
(with-current-buffer
(magit-diff-visit-file--internal file nil #'pop-to-buffer-same-window)
(magit-edit-line-commit))))
(put 'magit-diff-edit-hunk-commit 'disabled t)
;;; Reshelve
(defcustom magit-reshelve-since-committer-only nil
"Whether `magit-reshelve-since' changes only the committer dates.
Otherwise the author dates are also changed."
:package-version '(magit . "3.0.0")
:group 'magit-commands
:type 'boolean)
;;;###autoload
(defun magit-reshelve-since (rev keyid)
"Change the author and committer dates of the commits since REV.
Ask the user for the first reachable commit whose dates should
be changed. Then read the new date for that commit. The initial
minibuffer input and the previous history element offer good
values. The next commit will be created one minute later and so
on.
This command is only intended for interactive use and should only
be used on highly rearranged and unpublished history.
If KEYID is non-nil, then use that to sign all reshelved commits.
Interactively use the value of the \"--gpg-sign\" option in the
list returned by `magit-rebase-arguments'."
(interactive (list nil
(transient-arg-value "--gpg-sign="
(magit-rebase-arguments))))
(let* ((current (or (magit-get-current-branch)
(user-error "Refusing to reshelve detached head")))
(backup (concat "refs/original/refs/heads/" current)))
(cond
((not rev)
(when (and (magit-ref-p backup)
(not (magit-y-or-n-p
(format "Backup ref %s already exists. Override? " backup))))
(user-error "Abort"))
(magit-log-select
(lambda (rev)
(magit-reshelve-since rev keyid))
"Type %p on a commit to reshelve it and the commits above it,"))
(t
(cl-flet ((adjust (time offset)
(format-time-string
"%F %T %z"
(+ (floor time)
(* offset 60)
(- (car (decode-time time)))))))
(let* ((start (concat rev "^"))
(range (concat start ".." current))
(time-rev (adjust (float-time (string-to-number
(magit-rev-format "%at" start)))
1))
(time-now (adjust (float-time)
(- (string-to-number
(magit-git-string "rev-list" "--count"
range))))))
(push time-rev magit--reshelve-history)
(let ((date (floor
(float-time
(date-to-time
(read-string "Date for first commit: "
time-now 'magit--reshelve-history))))))
(with-environment-variables (("FILTER_BRANCH_SQUELCH_WARNING" "1"))
(magit-with-toplevel
(magit-run-git-async
"filter-branch" "--force" "--env-filter"
(format
"case $GIT_COMMIT in %s\nesac"
(mapconcat
(lambda (rev)
(prog1
(concat
(format "%s) " rev)
(and (not magit-reshelve-since-committer-only)
(format "export GIT_AUTHOR_DATE=\"%s\"; " date))
(format "export GIT_COMMITTER_DATE=\"%s\";;" date))
(cl-incf date 60)))
(magit-git-lines "rev-list" "--reverse" range)
" "))
(and keyid
(list "--commit-filter"
(format "git commit-tree --gpg-sign=%s \"$@\";"
keyid)))
range "--"))
(set-process-sentinel
magit-this-process
(lambda (process event)
(when (memq (process-status process) '(exit signal))
(if (> (process-exit-status process) 0)
(magit-process-sentinel process event)
(process-put process 'inhibit-refresh t)
(magit-process-sentinel process event)
(magit-run-git "update-ref" "-d" backup)))))))))))))
;;; Revision Stack
(defvar magit-revision-stack nil)
(defcustom magit-pop-revision-stack-format
'("[%N: %h] "
"%N: %cs %H\n %s\n"
"\\[\\([0-9]+\\)[]:]")
"Control how `magit-pop-revision-stack' inserts a revision.
The command `magit-pop-revision-stack' inserts a representation
of the revision last pushed to the `magit-revision-stack' into
the current buffer. It inserts text at point and/or near the end
of the buffer, and removes the consumed revision from the stack.
The entries on the stack have the format (HASH TOPLEVEL) and this
option has the format (POINT-FORMAT EOB-FORMAT INDEX-REGEXP), all
of which may be nil or a string (though either one of EOB-FORMAT
or POINT-FORMAT should be a string, and if INDEX-REGEXP is
non-nil, then the two formats should be too).
First INDEX-REGEXP is used to find the previously inserted entry,
by searching backward from point. The first submatch must match
the index number. That number is incremented by one, and becomes
the index number of the entry to be inserted. If you don't want
to number the inserted revisions, then use nil for INDEX-REGEXP.
If INDEX-REGEXP is non-nil, then both POINT-FORMAT and EOB-FORMAT
should contain \"%N\", which is replaced with the number that was
determined in the previous step.
Both formats, if non-nil and after removing %N, are then expanded
using `git show --format=FORMAT ...' inside TOPLEVEL.
The expansion of POINT-FORMAT is inserted at point, and the
expansion of EOB-FORMAT is inserted at the end of the buffer (if
the buffer ends with a comment, then it is inserted right before
that)."
:package-version '(magit . "3.2.0")
:group 'magit-commands
:type '(list (choice (string :tag "Insert at point format")
(cons (string :tag "Insert at point format")
(repeat (string :tag "Argument to git show")))
(const :tag "Don't insert at point" nil))
(choice (string :tag "Insert at eob format")
(cons (string :tag "Insert at eob format")
(repeat (string :tag "Argument to git show")))
(const :tag "Don't insert at eob" nil))
(choice (regexp :tag "Find index regexp")
(const :tag "Don't number entries" nil))))
(defcustom magit-copy-revision-abbreviated nil
"Whether to save abbreviated revision to `kill-ring' and `magit-revision-stack'."
:package-version '(magit . "3.0.0")
:group 'magit-miscellaneous
:type 'boolean)
;;;###autoload
(defun magit-pop-revision-stack (rev toplevel)
"Insert a representation of a revision into the current buffer.
Pop a revision from the `magit-revision-stack' and insert it into
the current buffer according to `magit-pop-revision-stack-format'.
Revisions can be put on the stack using `magit-copy-section-value'
and `magit-copy-buffer-revision'.
If the stack is empty or with a prefix argument, instead read a
revision in the minibuffer. By using the minibuffer history this
allows selecting an item which was popped earlier or to insert an
arbitrary reference or revision without first pushing it onto the
stack.
When reading the revision from the minibuffer, then it might not
be possible to guess the correct repository. When this command
is called inside a repository (e.g. while composing a commit
message), then that repository is used. Otherwise (e.g. while
composing an email) then the repository recorded for the top
element of the stack is used (even though we insert another
revision). If not called inside a repository and with an empty
stack, or with two prefix arguments, then read the repository in
the minibuffer too."
(interactive
(if (or current-prefix-arg (not magit-revision-stack))
(let ((default-directory
(or (and (not (= (prefix-numeric-value current-prefix-arg) 16))
(or (magit-toplevel)
(cadr (car magit-revision-stack))))
(magit-read-repository))))
(list (magit-read-branch-or-commit "Insert revision")
default-directory))
(push (caar magit-revision-stack) magit-revision-history)
(pop magit-revision-stack)))
(if rev
(pcase-let ((`(,pnt-format ,eob-format ,idx-format)
magit-pop-revision-stack-format))
(let ((default-directory toplevel)
(idx (and idx-format
(save-excursion
(if (re-search-backward idx-format nil t)
(number-to-string
(1+ (string-to-number (match-string 1))))
"1"))))
pnt-args eob-args)
(when (listp pnt-format)
(setq pnt-args (cdr pnt-format))
(setq pnt-format (car pnt-format)))
(when (listp eob-format)
(setq eob-args (cdr eob-format))
(setq eob-format (car eob-format)))
(when pnt-format
(when idx-format
(setq pnt-format
(string-replace "%N" idx pnt-format)))
(magit-rev-insert-format pnt-format rev pnt-args)
(backward-delete-char 1))
(when eob-format
(when idx-format
(setq eob-format
(string-replace "%N" idx eob-format)))
(save-excursion
(goto-char (point-max))
(skip-syntax-backward ">s-")
(beginning-of-line)
(if (and comment-start (looking-at comment-start))
(while (looking-at comment-start)
(forward-line -1))
(forward-line)
(unless (= (current-column) 0)
(insert ?\n)))
(insert ?\n)
(magit-rev-insert-format eob-format rev eob-args)
(backward-delete-char 1)))))
(user-error "Revision stack is empty")))
(define-key git-commit-mode-map
(kbd "C-c C-w") #'magit-pop-revision-stack)
;;;###autoload
(defun magit-copy-section-value (arg)
"Save the value of the current section for later use.
Save the section value to the `kill-ring', and, provided that
the current section is a commit, branch, or tag section, push
the (referenced) revision to the `magit-revision-stack' for use
with `magit-pop-revision-stack'.
When `magit-copy-revision-abbreviated' is non-nil, save the
abbreviated revision to the `kill-ring' and the
`magit-revision-stack'.
When the current section is a branch or a tag, and a prefix
argument is used, then save the revision at its tip to the
`kill-ring' instead of the reference name.
When the region is active, then save that to the `kill-ring',
like `kill-ring-save' would, instead of behaving as described
above. If a prefix argument is used and the region is within
a hunk, then strip the diff marker column and keep only either
the added or removed lines, depending on the sign of the prefix
argument."
(interactive "P")
(cond
((and arg
(magit-section-internal-region-p)
(magit-section-match 'hunk))
(kill-new
(thread-last (buffer-substring-no-properties
(region-beginning)
(region-end))
(replace-regexp-in-string
(format "^\\%c.*\n?" (if (< (prefix-numeric-value arg) 0) ?+ ?-))
"")
(replace-regexp-in-string "^[ \\+\\-]" "")))
(deactivate-mark))
((use-region-p)
(call-interactively #'copy-region-as-kill))
(t
(when-let* ((section (magit-current-section))
(value (oref section value)))
(magit-section-case
((branch commit module-commit tag)
(let ((default-directory default-directory) ref)
(magit-section-case
((branch tag)
(setq ref value))
(module-commit
(setq default-directory
(file-name-as-directory
(expand-file-name (magit-section-parent-value section)
(magit-toplevel))))))
(setq value (magit-rev-parse
(and magit-copy-revision-abbreviated "--short")
value))
(push (list value default-directory) magit-revision-stack)
(kill-new (message "%s" (or (and current-prefix-arg ref)
value)))))
(t (kill-new (message "%s" value))))))))
;;;###autoload
(defun magit-copy-buffer-revision ()
"Save the revision of the current buffer for later use.
Save the revision shown in the current buffer to the `kill-ring'
and push it to the `magit-revision-stack'.
This command is mainly intended for use in `magit-revision-mode'
buffers, the only buffers where it is always unambiguous exactly
which revision should be saved.
Most other Magit buffers usually show more than one revision, in
some way or another, so this command has to select one of them,
and that choice might not always be the one you think would have
been the best pick.
In such buffers it is often more useful to save the value of
the current section instead, using `magit-copy-section-value'.
When the region is active, then save that to the `kill-ring',
like `kill-ring-save' would, instead of behaving as described
above.
When `magit-copy-revision-abbreviated' is non-nil, save the
abbreviated revision to the `kill-ring' and the
`magit-revision-stack'."
(interactive)
(if (use-region-p)
(call-interactively #'copy-region-as-kill)
(when-let ((rev (or magit-buffer-revision
(cl-case major-mode
(magit-diff-mode
(if (string-match "\\.\\.\\.?\\(.+\\)"
magit-buffer-range)
(match-string 1 magit-buffer-range)
magit-buffer-range))
(magit-status-mode "HEAD")))))
(when (magit-commit-p rev)
(setq rev (magit-rev-parse
(and magit-copy-revision-abbreviated "--short")
rev))
(push (list rev default-directory) magit-revision-stack)
(kill-new (message "%s" rev))))))
;;; Buffer Switching
;;;###autoload
(defun magit-display-repository-buffer (buffer)
"Display a Magit buffer belonging to the current Git repository.
The buffer is displayed using `magit-display-buffer', which see."
(interactive (list (magit--read-repository-buffer
"Display magit buffer: ")))
(magit-display-buffer buffer))
;;;###autoload
(defun magit-switch-to-repository-buffer (buffer)
"Switch to a Magit buffer belonging to the current Git repository."
(interactive (list (magit--read-repository-buffer
"Switch to magit buffer: ")))
(switch-to-buffer buffer))
;;;###autoload
(defun magit-switch-to-repository-buffer-other-window (buffer)
"Switch to a Magit buffer belonging to the current Git repository."
(interactive (list (magit--read-repository-buffer
"Switch to magit buffer in another window: ")))
(switch-to-buffer-other-window buffer))
;;;###autoload
(defun magit-switch-to-repository-buffer-other-frame (buffer)
"Switch to a Magit buffer belonging to the current Git repository."
(interactive (list (magit--read-repository-buffer
"Switch to magit buffer in another frame: ")))
(switch-to-buffer-other-frame buffer))
(defun magit--read-repository-buffer (prompt)
(if-let ((topdir (magit-rev-parse-safe "--show-toplevel")))
(read-buffer
prompt (magit-get-mode-buffer 'magit-status-mode) t
(pcase-lambda (`(,_ . ,buf))
(and buf
(with-current-buffer buf
(and (or (derived-mode-p 'magit-mode
'magit-repolist-mode
'magit-submodule-list-mode
'git-rebase-mode)
(and buffer-file-name
(string-match-p git-commit-filename-regexp
buffer-file-name)))
(equal (magit-rev-parse-safe "--show-toplevel")
topdir))))))
(user-error "Not inside a Git repository")))
;;; Miscellaneous
;;;###autoload
(defun magit-abort-dwim ()
"Abort current operation.
Depending on the context, this will abort a merge, a rebase, a
patch application, a cherry-pick, a revert, or a bisect."
(interactive)
(cond ((magit-merge-in-progress-p) (magit-merge-abort))
((magit-rebase-in-progress-p) (magit-rebase-abort))
((magit-am-in-progress-p) (magit-am-abort))
((magit-sequencer-in-progress-p) (magit-sequencer-abort))
((magit-bisect-in-progress-p) (magit-bisect-reset))))
;;; _
(provide 'magit-extras)
;;; magit-extras.el ends here

199
code/elpa/magit-20220821.1819/magit-fetch.el Normal file
View File

@ -0,0 +1,199 @@
;;; magit-fetch.el --- Download objects and refs -*- lexical-binding:t -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library implements fetch commands.
;;; Code:
(require 'magit)
(defvar magit-fetch-modules-jobs nil)
(make-obsolete-variable
'magit-fetch-modules-jobs
"invoke `magit-fetch-modules' with a prefix argument instead."
"Magit 3.0.0")
;;; Commands
;;;###autoload (autoload 'magit-fetch "magit-fetch" nil t)
(transient-define-prefix magit-fetch ()
"Fetch from another repository."
:man-page "git-fetch"
["Arguments"
("-p" "Prune deleted branches" ("-p" "--prune"))
("-t" "Fetch all tags" ("-t" "--tags"))
(7 "-u" "Fetch full history" "--unshallow")]
["Fetch from"
("p" magit-fetch-from-pushremote)
("u" magit-fetch-from-upstream)
("e" "elsewhere" magit-fetch-other)
("a" "all remotes" magit-fetch-all)]
["Fetch"
("o" "another branch" magit-fetch-branch)
("r" "explicit refspec" magit-fetch-refspec)
("m" "submodules" magit-fetch-modules)]
["Configure"
("C" "variables..." magit-branch-configure)])
(defun magit-fetch-arguments ()
(transient-args 'magit-fetch))
(defun magit-git-fetch (remote args)
(run-hooks 'magit-credential-hook)
(magit-run-git-async "fetch" remote args))
;;;###autoload (autoload 'magit-fetch-from-pushremote "magit-fetch" nil t)
(transient-define-suffix magit-fetch-from-pushremote (args)
"Fetch from the current push-remote.
With a prefix argument or when the push-remote is either not
configured or unusable, then let the user first configure the
push-remote."
:description #'magit-fetch--pushremote-description
(interactive (list (magit-fetch-arguments)))
(let ((remote (magit-get-push-remote)))
(when (or current-prefix-arg
(not (member remote (magit-list-remotes))))
(let ((var (magit--push-remote-variable)))
(setq remote
(magit-read-remote (format "Set %s and fetch from there" var)))
(magit-set remote var)))
(magit-git-fetch remote args)))
(defun magit-fetch--pushremote-description ()
(let* ((branch (magit-get-current-branch))
(remote (magit-get-push-remote branch))
(v (magit--push-remote-variable branch t)))
(cond
((member remote (magit-list-remotes)) remote)
(remote
(format "%s, replacing invalid" v))
(t
(format "%s, setting that" v)))))
;;;###autoload (autoload 'magit-fetch-from-upstream "magit-fetch" nil t)
(transient-define-suffix magit-fetch-from-upstream (remote args)
"Fetch from the \"current\" remote, usually the upstream.
If the upstream is configured for the current branch and names
an existing remote, then use that. Otherwise try to use another
remote: If only a single remote is configured, then use that.
Otherwise if a remote named \"origin\" exists, then use that.
If no remote can be determined, then this command is not available
from the `magit-fetch' transient prefix and invoking it directly
results in an error."
:if (lambda () (magit-get-current-remote t))
:description (lambda () (magit-get-current-remote t))
(interactive (list (magit-get-current-remote t)
(magit-fetch-arguments)))
(unless remote
(error "The \"current\" remote could not be determined"))
(magit-git-fetch remote args))
;;;###autoload
(defun magit-fetch-other (remote args)
"Fetch from another repository."
(interactive (list (magit-read-remote "Fetch remote")
(magit-fetch-arguments)))
(magit-git-fetch remote args))
;;;###autoload
(defun magit-fetch-branch (remote branch args)
"Fetch a BRANCH from a REMOTE."
(interactive
(let ((remote (magit-read-remote-or-url "Fetch from remote or url")))
(list remote
(magit-read-remote-branch "Fetch branch" remote)
(magit-fetch-arguments))))
(magit-git-fetch remote (cons branch args)))
;;;###autoload
(defun magit-fetch-refspec (remote refspec args)
"Fetch a REFSPEC from a REMOTE."
(interactive
(let ((remote (magit-read-remote-or-url "Fetch from remote or url")))
(list remote
(magit-read-refspec "Fetch using refspec" remote)
(magit-fetch-arguments))))
(magit-git-fetch remote (cons refspec args)))
;;;###autoload
(defun magit-fetch-all (args)
"Fetch from all remotes."
(interactive (list (magit-fetch-arguments)))
(magit-git-fetch nil (cons "--all" args)))
;;;###autoload
(defun magit-fetch-all-prune ()
"Fetch from all remotes, and prune.
Prune remote tracking branches for branches that have been
removed on the respective remote."
(interactive)
(run-hooks 'magit-credential-hook)
(magit-run-git-async "remote" "update" "--prune"))
;;;###autoload
(defun magit-fetch-all-no-prune ()
"Fetch from all remotes."
(interactive)
(run-hooks 'magit-credential-hook)
(magit-run-git-async "remote" "update"))
;;;###autoload (autoload 'magit-fetch-modules "magit-fetch" nil t)
(transient-define-prefix magit-fetch-modules (&optional transient args)
"Fetch all submodules.
Fetching is done using \"git fetch --recurse-submodules\", which
means that the super-repository and recursively all submodules
are also fetched.
To set and potentially save other arguments invoke this command
with a prefix argument."
:man-page "git-fetch"
:value (list "--verbose"
(cond (magit-fetch-modules-jobs
(format "--jobs=%s" magit-fetch-modules-jobs))
(t "--jobs=4")))
["Arguments"
("-v" "verbose" "--verbose")
("-j" "number of jobs" "--jobs=" :reader transient-read-number-N+)]
["Action"
("m" "fetch modules" magit-fetch-modules)]
(interactive (if current-prefix-arg
(list t)
(list nil (transient-args 'magit-fetch-modules))))
(if transient
(transient-setup 'magit-fetch-modules)
(when (magit-git-version< "2.8.0")
(when-let ((value (transient-arg-value "--jobs=" args)))
(message "Dropping --jobs; not supported by Git v%s"
(magit-git-version))
(setq args (remove (format "--jobs=%s" value) args))))
(magit-with-toplevel
(magit-run-git-async "fetch" "--recurse-submodules" args))))
;;; _
(provide 'magit-fetch)
;;; magit-fetch.el ends here

536
code/elpa/magit-20220821.1819/magit-files.el Normal file
View File

@ -0,0 +1,536 @@
;;; magit-files.el --- Finding files -*- lexical-binding:t -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library implements support for finding blobs, staged files,
;; and Git configuration files. It also implements modes useful in
;; buffers visiting files and blobs, and the commands used by those
;; modes.
;;; Code:
(require 'magit)
;;; Find Blob
(defvar magit-find-file-hook nil)
(add-hook 'magit-find-file-hook #'magit-blob-mode)
;;;###autoload
(defun magit-find-file (rev file)
"View FILE from REV.
Switch to a buffer visiting blob REV:FILE, creating one if none
already exists. If prior to calling this command the current
buffer and/or cursor position is about the same file, then go
to the line and column corresponding to that location."
(interactive (magit-find-file-read-args "Find file"))
(magit-find-file--internal rev file #'pop-to-buffer-same-window))
;;;###autoload
(defun magit-find-file-other-window (rev file)
"View FILE from REV, in another window.
Switch to a buffer visiting blob REV:FILE, creating one if none
already exists. If prior to calling this command the current
buffer and/or cursor position is about the same file, then go to
the line and column corresponding to that location."
(interactive (magit-find-file-read-args "Find file in other window"))
(magit-find-file--internal rev file #'switch-to-buffer-other-window))
;;;###autoload
(defun magit-find-file-other-frame (rev file)
"View FILE from REV, in another frame.
Switch to a buffer visiting blob REV:FILE, creating one if none
already exists. If prior to calling this command the current
buffer and/or cursor position is about the same file, then go to
the line and column corresponding to that location."
(interactive (magit-find-file-read-args "Find file in other frame"))
(magit-find-file--internal rev file #'switch-to-buffer-other-frame))
(defun magit-find-file-read-args (prompt)
(let ((pseudo-revs '("{worktree}" "{index}")))
(if-let ((rev (magit-completing-read "Find file from revision"
(append pseudo-revs
(magit-list-refnames nil t))
nil nil nil 'magit-revision-history
(or (magit-branch-or-commit-at-point)
(magit-get-current-branch)))))
(list rev (magit-read-file-from-rev (if (member rev pseudo-revs)
"HEAD"
rev)
prompt))
(user-error "Nothing selected"))))
(defun magit-find-file--internal (rev file fn)
(let ((buf (magit-find-file-noselect rev file))
line col)
(when-let ((visited-file (magit-file-relative-name)))
(setq line (line-number-at-pos))
(setq col (current-column))
(cond
((not (equal visited-file file)))
((equal magit-buffer-revision rev))
((equal rev "{worktree}")
(setq line (magit-diff-visit--offset file magit-buffer-revision line)))
((equal rev "{index}")
(setq line (magit-diff-visit--offset file nil line)))
(magit-buffer-revision
(setq line (magit-diff-visit--offset
file (concat magit-buffer-revision ".." rev) line)))
(t
(setq line (magit-diff-visit--offset file (list "-R" rev) line)))))
(funcall fn buf)
(when line
(with-current-buffer buf
(widen)
(goto-char (point-min))
(forward-line (1- line))
(move-to-column col)))
buf))
(defun magit-find-file-noselect (rev file)
"Read FILE from REV into a buffer and return the buffer.
REV is a revision or one of \"{worktree}\" or \"{index}\".
FILE must be relative to the top directory of the repository."
(magit-find-file-noselect-1 rev file))
(defun magit-find-file-noselect-1 (rev file &optional revert)
"Read FILE from REV into a buffer and return the buffer.
REV is a revision or one of \"{worktree}\" or \"{index}\".
FILE must be relative to the top directory of the repository.
Non-nil REVERT means to revert the buffer. If `ask-revert',
then only after asking. A non-nil value for REVERT is ignored if REV is
\"{worktree}\"."
(if (equal rev "{worktree}")
(find-file-noselect (expand-file-name file (magit-toplevel)))
(let ((topdir (magit-toplevel)))
(when (file-name-absolute-p file)
(setq file (file-relative-name file topdir)))
(with-current-buffer (magit-get-revision-buffer-create rev file)
(when (or (not magit-buffer-file-name)
(if (eq revert 'ask-revert)
(y-or-n-p (format "%s already exists; revert it? "
(buffer-name))))
revert)
(setq magit-buffer-revision
(if (equal rev "{index}")
"{index}"
(magit-rev-format "%H" rev)))
(setq magit-buffer-refname rev)
(setq magit-buffer-file-name (expand-file-name file topdir))
(setq default-directory
(let ((dir (file-name-directory magit-buffer-file-name)))
(if (file-exists-p dir) dir topdir)))
(setq-local revert-buffer-function #'magit-revert-rev-file-buffer)
(revert-buffer t t)
(run-hooks (if (equal rev "{index}")
'magit-find-index-hook
'magit-find-file-hook)))
(current-buffer)))))
(defun magit-get-revision-buffer-create (rev file)
(magit-get-revision-buffer rev file t))
(defun magit-get-revision-buffer (rev file &optional create)
(funcall (if create #'get-buffer-create #'get-buffer)
(format "%s.~%s~" file (subst-char-in-string ?/ ?_ rev))))
(defun magit-revert-rev-file-buffer (_ignore-auto noconfirm)
(when (or noconfirm
(and (not (buffer-modified-p))
(catch 'found
(dolist (regexp revert-without-query)
(when (string-match regexp magit-buffer-file-name)
(throw 'found t)))))
(yes-or-no-p (format "Revert buffer from Git %s? "
(if (equal magit-buffer-refname "{index}")
"index"
(concat "revision " magit-buffer-refname)))))
(let* ((inhibit-read-only t)
(default-directory (magit-toplevel))
(file (file-relative-name magit-buffer-file-name))
(coding-system-for-read (or coding-system-for-read 'undecided)))
(erase-buffer)
(magit-git-insert "cat-file" "-p"
(if (equal magit-buffer-refname "{index}")
(concat ":" file)
(concat magit-buffer-refname ":" file)))
(setq buffer-file-coding-system last-coding-system-used))
(let ((buffer-file-name magit-buffer-file-name)
(after-change-major-mode-hook
(remq 'global-diff-hl-mode-enable-in-buffers
after-change-major-mode-hook)))
(delay-mode-hooks
(normal-mode t)))
(setq buffer-read-only t)
(set-buffer-modified-p nil)
(goto-char (point-min))))
;;; Find Index
(defvar magit-find-index-hook nil)
(defun magit-find-file-index-noselect (file &optional revert)
"Read FILE from the index into a buffer and return the buffer.
FILE must to be relative to the top directory of the repository."
(magit-find-file-noselect-1 "{index}" file (or revert 'ask-revert)))
(defun magit-update-index ()
"Update the index with the contents of the current buffer.
The current buffer has to be visiting a file in the index, which
is done using `magit-find-index-noselect'."
(interactive)
(let ((file (magit-file-relative-name)))
(unless (equal magit-buffer-refname "{index}")
(user-error "%s isn't visiting the index" file))
(if (y-or-n-p (format "Update index with contents of %s" (buffer-name)))
(let ((index (make-temp-name (magit-git-dir "magit-update-index-")))
(buffer (current-buffer)))
(when magit-wip-before-change-mode
(magit-wip-commit-before-change (list file) " before un-/stage"))
(unwind-protect
(progn
(let ((coding-system-for-write buffer-file-coding-system))
(with-temp-file index
(insert-buffer-substring buffer)))
(magit-with-toplevel
(magit-call-git
"update-index" "--cacheinfo"
(substring (magit-git-string "ls-files" "-s" file)
0 6)
(magit-git-string "hash-object" "-t" "blob" "-w"
(concat "--path=" file)
"--" (magit-convert-filename-for-git index))
file)))
(ignore-errors (delete-file index)))
(set-buffer-modified-p nil)
(when magit-wip-after-apply-mode
(magit-wip-commit-after-apply (list file) " after un-/stage")))
(message "Abort")))
(--when-let (magit-get-mode-buffer 'magit-status-mode)
(with-current-buffer it (magit-refresh)))
t)
;;; Find Config File
(defun magit-find-git-config-file (filename &optional wildcards)
"Edit a file located in the current repository's git directory.
When \".git\", located at the root of the working tree, is a
regular file, then that makes it cumbersome to open a file
located in the actual git directory.
This command is like `find-file', except that it temporarily
binds `default-directory' to the actual git directory, while
reading the FILENAME."
(interactive
(let ((default-directory (magit-git-dir)))
(find-file-read-args "Find file: "
(confirm-nonexistent-file-or-buffer))))
(find-file filename wildcards))
(defun magit-find-git-config-file-other-window (filename &optional wildcards)
"Edit a file located in the current repo's git directory, in another window.
When \".git\", located at the root of the working tree, is a
regular file, then that makes it cumbersome to open a file
located in the actual git directory.
This command is like `find-file-other-window', except that it
temporarily binds `default-directory' to the actual git
directory, while reading the FILENAME."
(interactive
(let ((default-directory (magit-git-dir)))
(find-file-read-args "Find file in other window: "
(confirm-nonexistent-file-or-buffer))))
(find-file-other-window filename wildcards))
(defun magit-find-git-config-file-other-frame (filename &optional wildcards)
"Edit a file located in the current repo's git directory, in another frame.
When \".git\", located at the root of the working tree, is a
regular file, then that makes it cumbersome to open a file
located in the actual git directory.
This command is like `find-file-other-frame', except that it
temporarily binds `default-directory' to the actual git
directory, while reading the FILENAME."
(interactive
(let ((default-directory (magit-git-dir)))
(find-file-read-args "Find file in other frame: "
(confirm-nonexistent-file-or-buffer))))
(find-file-other-frame filename wildcards))
;;; File Dispatch
;;;###autoload (autoload 'magit-file-dispatch "magit" nil t)
(transient-define-prefix magit-file-dispatch ()
"Invoke a Magit command that acts on the visited file.
When invoked outside a file-visiting buffer, then fall back
to `magit-dispatch'."
:info-manual "(magit) Minor Mode for Buffers Visiting Files"
["Actions"
[("s" "Stage" magit-stage-file)
("u" "Unstage" magit-unstage-file)
("c" "Commit" magit-commit)
("e" "Edit line" magit-edit-line-commit)]
[("D" "Diff..." magit-diff)
("d" "Diff" magit-diff-buffer-file)
("g" "Status" magit-status-here)]
[("L" "Log..." magit-log)
("l" "Log" magit-log-buffer-file)
("t" "Trace" magit-log-trace-definition)
(7 "M" "Merged" magit-log-merged)]
[("B" "Blame..." magit-blame)
("b" "Blame" magit-blame-addition)
("r" "...removal" magit-blame-removal)
("f" "...reverse" magit-blame-reverse)
("m" "Blame echo" magit-blame-echo)
("q" "Quit blame" magit-blame-quit)]
[("p" "Prev blob" magit-blob-previous)
("n" "Next blob" magit-blob-next)
("v" "Goto blob" magit-find-file)
("V" "Goto file" magit-blob-visit-file)]
[(5 "C-c r" "Rename file" magit-file-rename)
(5 "C-c d" "Delete file" magit-file-delete)
(5 "C-c u" "Untrack file" magit-file-untrack)
(5 "C-c c" "Checkout file" magit-file-checkout)]]
(interactive)
(transient-setup
(if (magit-file-relative-name)
'magit-file-dispatch
'magit-dispatch)))
;;; Blob Mode
(defvar magit-blob-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "p" #'magit-blob-previous)
(define-key map "n" #'magit-blob-next)
(define-key map "b" #'magit-blame-addition)
(define-key map "r" #'magit-blame-removal)
(define-key map "f" #'magit-blame-reverse)
(define-key map "q" #'magit-kill-this-buffer)
map)
"Keymap for `magit-blob-mode'.")
(define-minor-mode magit-blob-mode
"Enable some Magit features in blob-visiting buffers.
Currently this only adds the following key bindings.
\n\\{magit-blob-mode-map}"
:package-version '(magit . "2.3.0"))
(defun magit-blob-next ()
"Visit the next blob which modified the current file."
(interactive)
(if magit-buffer-file-name
(magit-blob-visit (or (magit-blob-successor magit-buffer-revision
magit-buffer-file-name)
magit-buffer-file-name))
(if (buffer-file-name (buffer-base-buffer))
(user-error "You have reached the end of time")
(user-error "Buffer isn't visiting a file or blob"))))
(defun magit-blob-previous ()
"Visit the previous blob which modified the current file."
(interactive)
(if-let ((file (or magit-buffer-file-name
(buffer-file-name (buffer-base-buffer)))))
(--if-let (magit-blob-ancestor magit-buffer-revision file)
(magit-blob-visit it)
(user-error "You have reached the beginning of time"))
(user-error "Buffer isn't visiting a file or blob")))
;;;###autoload
(defun magit-blob-visit-file ()
"View the file from the worktree corresponding to the current blob.
When visiting a blob or the version from the index, then go to
the same location in the respective file in the working tree."
(interactive)
(if-let ((file (magit-file-relative-name)))
(magit-find-file--internal "{worktree}" file #'pop-to-buffer-same-window)
(user-error "Not visiting a blob")))
(defun magit-blob-visit (blob-or-file)
(if (stringp blob-or-file)
(find-file blob-or-file)
(pcase-let ((`(,rev ,file) blob-or-file))
(magit-find-file rev file)
(apply #'message "%s (%s %s ago)"
(magit-rev-format "%s" rev)
(magit--age (magit-rev-format "%ct" rev))))))
(defun magit-blob-ancestor (rev file)
(let ((lines (magit-with-toplevel
(magit-git-lines "log" "-2" "--format=%H" "--name-only"
"--follow" (or rev "HEAD") "--" file))))
(if rev (cddr lines) (butlast lines 2))))
(defun magit-blob-successor (rev file)
(let ((lines (magit-with-toplevel
(magit-git-lines "log" "--format=%H" "--name-only" "--follow"
"HEAD" "--" file))))
(catch 'found
(while lines
(if (equal (nth 2 lines) rev)
(throw 'found (list (nth 0 lines) (nth 1 lines)))
(setq lines (nthcdr 2 lines)))))))
;;; File Commands
(defun magit-file-rename (file newname)
"Rename or move FILE to NEWNAME.
NEWNAME may be a file or directory name. If FILE isn't tracked in
Git, fallback to using `rename-file'."
(interactive
(let* ((file (magit-read-file "Rename file"))
(dir (file-name-directory file))
(newname (read-file-name (format "Move %s to destination: " file)
(and dir (expand-file-name dir)))))
(list (expand-file-name file (magit-toplevel))
(expand-file-name newname))))
(let ((oldbuf (get-file-buffer file))
(dstdir (file-name-directory newname))
(dstfile (if (directory-name-p newname)
(concat newname (file-name-nondirectory file))
newname)))
(when (and oldbuf (buffer-modified-p oldbuf))
(user-error "Save %s before moving it" file))
(when (file-exists-p dstfile)
(user-error "%s already exists" dstfile))
(unless (file-exists-p dstdir)
(user-error "Destination directory %s does not exist" dstdir))
(if (magit-file-tracked-p (magit-convert-filename-for-git file))
(magit-call-git "mv"
(magit-convert-filename-for-git file)
(magit-convert-filename-for-git newname))
(rename-file file newname current-prefix-arg))
(when oldbuf
(with-current-buffer oldbuf
(let ((buffer-read-only buffer-read-only))
(set-visited-file-name dstfile nil t))
(if (fboundp 'vc-refresh-state)
(vc-refresh-state)
(with-no-warnings
(vc-find-file-hook))))))
(magit-refresh))
(defun magit-file-untrack (files &optional force)
"Untrack the selected FILES or one file read in the minibuffer.
With a prefix argument FORCE do so even when the files have
staged as well as unstaged changes."
(interactive (list (or (--if-let (magit-region-values 'file t)
(progn
(unless (magit-file-tracked-p (car it))
(user-error "Already untracked"))
(magit-confirm-files 'untrack it "Untrack"))
(list (magit-read-tracked-file "Untrack file"))))
current-prefix-arg))
(magit-with-toplevel
(magit-run-git "rm" "--cached" (and force "--force") "--" files)))
(defun magit-file-delete (files &optional force)
"Delete the selected FILES or one file read in the minibuffer.
With a prefix argument FORCE do so even when the files have
uncommitted changes. When the files aren't being tracked in
Git, then fallback to using `delete-file'."
(interactive (list (--if-let (magit-region-values 'file t)
(magit-confirm-files 'delete it "Delete")
(list (magit-read-file "Delete file")))
current-prefix-arg))
(if (magit-file-tracked-p (car files))
(magit-call-git "rm" (and force "--force") "--" files)
(let ((topdir (magit-toplevel)))
(dolist (file files)
(delete-file (expand-file-name file topdir) t))))
(magit-refresh))
;;;###autoload
(defun magit-file-checkout (rev file)
"Checkout FILE from REV."
(interactive
(let ((rev (magit-read-branch-or-commit
"Checkout from revision" magit-buffer-revision)))
(list rev (magit-read-file-from-rev rev "Checkout file"))))
(magit-with-toplevel
(magit-run-git "checkout" rev "--" file)))
;;; Read File
(defvar magit-read-file-hist nil)
(defun magit-read-file-from-rev (rev prompt &optional default)
(let ((files (magit-revision-files rev)))
(magit-completing-read
prompt files nil t nil 'magit-read-file-hist
(car (member (or default (magit-current-file)) files)))))
(defun magit-read-file (prompt &optional tracked-only)
(let ((choices (nconc (magit-list-files)
(unless tracked-only (magit-untracked-files)))))
(magit-completing-read
prompt choices nil t nil nil
(car (member (or (magit-section-value-if '(file submodule))
(magit-file-relative-name nil tracked-only))
choices)))))
(defun magit-read-tracked-file (prompt)
(magit-read-file prompt t))
(defun magit-read-unmerged-file (&optional prompt)
(let ((current (magit-current-file))
(unmerged (magit-unmerged-files)))
(unless unmerged
(user-error "There are no unresolved conflicts"))
(magit-completing-read (or prompt "Resolve file")
unmerged nil t nil nil
(car (member current unmerged)))))
(defun magit-read-file-choice (prompt files &optional error default)
"Read file from FILES.
If FILES has only one member, return that instead of prompting.
If FILES has no members, give a user error. ERROR can be given
to provide a more informative error.
If DEFAULT is non-nil, use this as the default value instead of
`magit-current-file'."
(pcase (length files)
(0 (user-error (or error "No file choices")))
(1 (car files))
(_ (magit-completing-read
prompt files nil t nil 'magit-read-file-hist
(car (member (or default (magit-current-file)) files))))))
(defun magit-read-changed-file (rev-or-range prompt &optional default)
(magit-read-file-choice
prompt
(magit-changed-files rev-or-range)
default
(concat "No file changed in " rev-or-range)))
;;; _
(provide 'magit-files)
;;; magit-files.el ends here

2691
code/elpa/magit-20220821.1819/magit-git.el Normal file
View File

File diff suppressed because it is too large Load Diff

195
code/elpa/magit-20220821.1819/magit-gitignore.el Normal file
View File

@ -0,0 +1,195 @@
;;; magit-gitignore.el --- Intentionally untracked files -*- lexical-binding:t -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library implements gitignore commands.
;;; Code:
(require 'magit)
;;; Transient
;;;###autoload (autoload 'magit-gitignore "magit-gitignore" nil t)
(transient-define-prefix magit-gitignore ()
"Instruct Git to ignore a file or pattern."
:man-page "gitignore"
["Gitignore"
("t" "shared at toplevel (.gitignore)"
magit-gitignore-in-topdir)
("s" "shared in subdirectory (path/to/.gitignore)"
magit-gitignore-in-subdir)
("p" "privately (.git/info/exclude)"
magit-gitignore-in-gitdir)
("g" magit-gitignore-on-system
:if (lambda () (magit-get "core.excludesfile"))
:description (lambda ()
(format "privately for all repositories (%s)"
(magit-get "core.excludesfile"))))]
["Skip worktree"
(7 "w" "do skip worktree" magit-skip-worktree)
(7 "W" "do not skip worktree" magit-no-skip-worktree)]
["Assume unchanged"
(7 "u" "do assume unchanged" magit-assume-unchanged)
(7 "U" "do not assume unchanged" magit-no-assume-unchanged)])
;;; Gitignore Commands
;;;###autoload
(defun magit-gitignore-in-topdir (rule)
"Add the Git ignore RULE to the top-level \".gitignore\" file.
Since this file is tracked, it is shared with other clones of the
repository. Also stage the file."
(interactive (list (magit-gitignore-read-pattern)))
(magit-with-toplevel
(magit--gitignore rule ".gitignore")
(magit-run-git "add" ".gitignore")))
;;;###autoload
(defun magit-gitignore-in-subdir (rule directory)
"Add the Git ignore RULE to a \".gitignore\" file in DIRECTORY.
Prompt the user for a directory and add the rule to the
\".gitignore\" file in that directory. Since such files are
tracked, they are shared with other clones of the repository.
Also stage the file."
(interactive (list (magit-gitignore-read-pattern)
(read-directory-name "Limit rule to files in: ")))
(magit-with-toplevel
(let ((file (expand-file-name ".gitignore" directory)))
(magit--gitignore rule file)
(magit-run-git "add" (magit-convert-filename-for-git file)))))
;;;###autoload
(defun magit-gitignore-in-gitdir (rule)
"Add the Git ignore RULE to \"$GIT_DIR/info/exclude\".
Rules in that file only affects this clone of the repository."
(interactive (list (magit-gitignore-read-pattern)))
(magit--gitignore rule (magit-git-dir "info/exclude"))
(magit-refresh))
;;;###autoload
(defun magit-gitignore-on-system (rule)
"Add the Git ignore RULE to the file specified by `core.excludesFile'.
Rules that are defined in that file affect all local repositories."
(interactive (list (magit-gitignore-read-pattern)))
(magit--gitignore rule
(or (magit-get "core.excludesFile")
(error "Variable `core.excludesFile' isn't set")))
(magit-refresh))
(defun magit--gitignore (rule file)
(when-let ((directory (file-name-directory file)))
(make-directory directory t))
(with-temp-buffer
(when (file-exists-p file)
(insert-file-contents file))
(goto-char (point-max))
(unless (bolp)
(insert "\n"))
(insert (replace-regexp-in-string "\\(\\\\*\\)" "\\1\\1" rule))
(insert "\n")
(write-region nil nil file)))
(defun magit-gitignore-read-pattern ()
(let* ((default (magit-current-file))
(base (car magit-buffer-diff-files))
(base (and base (file-directory-p base) base))
(choices
(delete-dups
(--mapcat
(cons (concat "/" it)
(and-let* ((ext (file-name-extension it)))
(list (concat "/" (file-name-directory it) "*." ext)
(concat "*." ext))))
(sort (nconc
(magit-untracked-files nil base)
;; The untracked section of the status buffer lists
;; directories containing only untracked files.
;; Add those as candidates.
(-filter #'directory-name-p
(magit-list-files
"--other" "--exclude-standard" "--directory"
"--no-empty-directory" "--" base)))
#'string-lessp)))))
(when default
(setq default (concat "/" default))
(unless (member default choices)
(setq default (concat "*." (file-name-extension default)))
(unless (member default choices)
(setq default nil))))
(magit-completing-read "File or pattern to ignore"
choices nil nil nil nil default)))
;;; Skip Worktree Commands
;;;###autoload
(defun magit-skip-worktree (file)
"Call \"git update-index --skip-worktree -- FILE\"."
(interactive
(list (magit-read-file-choice "Skip worktree for"
(magit-with-toplevel
(cl-set-difference
(magit-list-files)
(magit-skip-worktree-files)
:test #'equal)))))
(magit-with-toplevel
(magit-run-git "update-index" "--skip-worktree" "--" file)))
;;;###autoload
(defun magit-no-skip-worktree (file)
"Call \"git update-index --no-skip-worktree -- FILE\"."
(interactive
(list (magit-read-file-choice "Do not skip worktree for"
(magit-with-toplevel
(magit-skip-worktree-files)))))
(magit-with-toplevel
(magit-run-git "update-index" "--no-skip-worktree" "--" file)))
;;; Assume Unchanged Commands
;;;###autoload
(defun magit-assume-unchanged (file)
"Call \"git update-index --assume-unchanged -- FILE\"."
(interactive
(list (magit-read-file-choice "Assume file to be unchanged"
(magit-with-toplevel
(cl-set-difference
(magit-list-files)
(magit-assume-unchanged-files)
:test #'equal)))))
(magit-with-toplevel
(magit-run-git "update-index" "--assume-unchanged" "--" file)))
;;;###autoload
(defun magit-no-assume-unchanged (file)
"Call \"git update-index --no-assume-unchanged -- FILE\"."
(interactive
(list (magit-read-file-choice "Do not assume file to be unchanged"
(magit-with-toplevel
(magit-assume-unchanged-files)))))
(magit-with-toplevel
(magit-run-git "update-index" "--no-assume-unchanged" "--" file)))
;;; _
(provide 'magit-gitignore)
;;; magit-gitignore.el ends here

1950
code/elpa/magit-20220821.1819/magit-log.el Normal file
View File

File diff suppressed because it is too large Load Diff

241
code/elpa/magit-20220821.1819/magit-margin.el Normal file
View File

@ -0,0 +1,241 @@
;;; magit-margin.el --- Margins in Magit buffers -*- lexical-binding:t -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library implements support for showing additional information
;; in the margins of Magit buffers. Currently this is only used for
;; commits, for which the committer date or age, and optionally the
;; author name are shown.
;;; Code:
(require 'magit-base)
(require 'magit-transient)
(require 'magit-mode)
;;; Options
(defgroup magit-margin nil
"Information Magit displays in the margin.
You can change the STYLE and AUTHOR-WIDTH of all `magit-*-margin'
options to the same values by customizing `magit-log-margin'
*before* `magit' is loaded. If you do that, then the respective
values for the other options will default to what you have set
for that variable. Likewise if you set `magit-log-margin's INIT
to nil, then that is used in the default of all other options. But
setting it to t, i.e. re-enforcing the default for that option,
does not carry to other options."
:link '(info-link "(magit)Log Margin")
:group 'magit-log)
(defvar-local magit-buffer-margin nil)
(put 'magit-buffer-margin 'permanent-local t)
(defvar-local magit-set-buffer-margin-refresh nil)
(defvar magit--age-spec)
;;; Commands
(transient-define-prefix magit-margin-settings ()
"Change what information is displayed in the margin."
:info-manual "(magit) Log Margin"
["Margin"
("L" "Toggle visibility" magit-toggle-margin :transient t)
("l" "Cycle style" magit-cycle-margin-style :transient t)
("d" "Toggle details" magit-toggle-margin-details)
("v" "Change verbosity" magit-refs-set-show-commit-count
:if-derived magit-refs-mode)])
(defun magit-toggle-margin ()
"Show or hide the Magit margin."
(interactive)
(unless (magit-margin-option)
(user-error "Magit margin isn't supported in this buffer"))
(setcar magit-buffer-margin (not (magit-buffer-margin-p)))
(magit-set-buffer-margin))
(defvar magit-margin-default-time-format nil
"See https://github.com/magit/magit/pull/4605.")
(defun magit-cycle-margin-style ()
"Cycle style used for the Magit margin."
(interactive)
(unless (magit-margin-option)
(user-error "Magit margin isn't supported in this buffer"))
;; This is only suitable for commit margins (there are not others).
(setf (cadr magit-buffer-margin)
(pcase (cadr magit-buffer-margin)
('age 'age-abbreviated)
('age-abbreviated
(let ((default (or magit-margin-default-time-format
(cadr (symbol-value (magit-margin-option))))))
(if (stringp default) default "%Y-%m-%d %H:%M ")))
(_ 'age)))
(magit-set-buffer-margin nil t))
(defun magit-toggle-margin-details ()
"Show or hide details in the Magit margin."
(interactive)
(unless (magit-margin-option)
(user-error "Magit margin isn't supported in this buffer"))
(setf (nth 3 magit-buffer-margin)
(not (nth 3 magit-buffer-margin)))
(magit-set-buffer-margin nil t))
;;; Core
(defun magit-buffer-margin-p ()
(car magit-buffer-margin))
(defun magit-margin-option ()
(pcase major-mode
('magit-cherry-mode 'magit-cherry-margin)
('magit-log-mode 'magit-log-margin)
('magit-log-select-mode 'magit-log-select-margin)
('magit-reflog-mode 'magit-reflog-margin)
('magit-refs-mode 'magit-refs-margin)
('magit-stashes-mode 'magit-stashes-margin)
('magit-status-mode 'magit-status-margin)
('forge-notifications-mode 'magit-status-margin)))
(defun magit-set-buffer-margin (&optional reset refresh)
(when-let ((option (magit-margin-option)))
(let* ((default (symbol-value option))
(default-width (nth 2 default)))
(when (or reset (not magit-buffer-margin))
(setq magit-buffer-margin (copy-sequence default)))
(pcase-let ((`(,enable ,style ,_width ,details ,details-width)
magit-buffer-margin))
(when (functionp default-width)
(setf (nth 2 magit-buffer-margin)
(funcall default-width style details details-width)))
(dolist (window (get-buffer-window-list nil nil 0))
(with-selected-window window
(magit-set-window-margin window)
(if enable
(add-hook 'window-configuration-change-hook
#'magit-set-window-margin nil t)
(remove-hook 'window-configuration-change-hook
#'magit-set-window-margin t))))
(when (and enable (or refresh magit-set-buffer-margin-refresh))
(magit-refresh-buffer))))))
(defun magit-set-window-margin (&optional window)
(when (or window (setq window (get-buffer-window)))
(with-selected-window window
(set-window-margins
nil (car (window-margins))
(and (magit-buffer-margin-p)
(nth 2 magit-buffer-margin))))))
(defun magit-make-margin-overlay (&optional string previous-line)
(if previous-line
(save-excursion
(forward-line -1)
(magit-make-margin-overlay string))
;; Don't put the overlay on the complete line to work around #1880.
(let ((o (make-overlay (1+ (line-beginning-position))
(line-end-position)
nil t)))
(overlay-put o 'evaporate t)
(overlay-put o 'before-string
(propertize "o" 'display
(list (list 'margin 'right-margin)
(or string " ")))))))
(defun magit-maybe-make-margin-overlay ()
(when (or (magit-section-match
'(unpulled unpushed recent stashes local cherries)
magit-insert-section--current)
(and (eq major-mode 'magit-refs-mode)
(magit-section-match
'(remote commit tags)
magit-insert-section--current)))
(magit-make-margin-overlay nil t)))
;;; Custom Support
(defun magit-margin-set-variable (mode symbol value)
(set-default symbol value)
(message "Updating margins in %s buffers..." mode)
(dolist (buffer (buffer-list))
(with-current-buffer buffer
(when (eq major-mode mode)
(magit-set-buffer-margin t)
(magit-refresh))))
(message "Updating margins in %s buffers...done" mode))
(defconst magit-log-margin--custom-type
'(list (boolean :tag "Show margin initially")
(choice :tag "Show committer"
(string :tag "date using time-format" "%Y-%m-%d %H:%M ")
(const :tag "date's age" age)
(const :tag "date's age (abbreviated)" age-abbreviated))
(const :tag "Calculate width using magit-log-margin-width"
magit-log-margin-width)
(boolean :tag "Show author name by default")
(integer :tag "Show author name using width")))
;;; Time Utilities
(defvar magit--age-spec
`((?Y "year" "years" ,(round (* 60 60 24 365.2425)))
(?M "month" "months" ,(round (* 60 60 24 30.436875)))
(?w "week" "weeks" ,(* 60 60 24 7))
(?d "day" "days" ,(* 60 60 24))
(?h "hour" "hours" ,(* 60 60))
(?m "minute" "minutes" 60)
(?s "second" "seconds" 1))
"Time units used when formatting relative commit ages.
The value is a list of time units, beginning with the longest.
Each element has the form (CHAR UNIT UNITS SECONDS). UNIT is the
time unit, UNITS is the plural of that unit. CHAR is a character
abbreviation. And SECONDS is the number of seconds in one UNIT.
This is defined as a variable to make it possible to use time
units for a language other than English. It is not defined
as an option, because most other parts of Magit are always in
English.")
(defun magit--age (date &optional abbreviate)
(cl-labels ((fn (age spec)
(pcase-let ((`(,char ,unit ,units ,weight) (car spec)))
(let ((cnt (round (/ age weight 1.0))))
(if (or (not (cdr spec))
(>= (/ age weight) 1))
(list cnt (cond (abbreviate char)
((= cnt 1) unit)
(t units)))
(fn age (cdr spec)))))))
(fn (abs (- (float-time)
(if (stringp date)
(string-to-number date)
date)))
magit--age-spec)))
;;; _
(provide 'magit-margin)
;;; magit-margin.el ends here

318
code/elpa/magit-20220821.1819/magit-merge.el Normal file
View File

@ -0,0 +1,318 @@
;;; magit-merge.el --- Merge functionality -*- lexical-binding:t -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library implements merge commands.
;;; Code:
(require 'magit)
(require 'magit-diff)
(declare-function magit-git-push "magit-push" (branch target args))
;;; Commands
;;;###autoload (autoload 'magit-merge "magit" nil t)
(transient-define-prefix magit-merge ()
"Merge branches."
:man-page "git-merge"
:incompatible '(("--ff-only" "--no-ff"))
["Arguments"
:if-not magit-merge-in-progress-p
("-f" "Fast-forward only" "--ff-only")
("-n" "No fast-forward" "--no-ff")
(magit-merge:--strategy)
(5 magit-merge:--strategy-option)
(5 "-b" "Ignore changes in amount of whitespace" "-Xignore-space-change")
(5 "-w" "Ignore whitespace when comparing lines" "-Xignore-all-space")
(5 magit-diff:--diff-algorithm :argument "-Xdiff-algorithm=")
(5 magit:--gpg-sign)]
["Actions"
:if-not magit-merge-in-progress-p
[("m" "Merge" magit-merge-plain)
("e" "Merge and edit message" magit-merge-editmsg)
("n" "Merge but don't commit" magit-merge-nocommit)
("a" "Absorb" magit-merge-absorb)]
[("p" "Preview merge" magit-merge-preview)
""
("s" "Squash merge" magit-merge-squash)
("i" "Dissolve" magit-merge-into)]]
["Actions"
:if magit-merge-in-progress-p
("m" "Commit merge" magit-commit-create)
("a" "Abort merge" magit-merge-abort)])
(defun magit-merge-arguments ()
(transient-args 'magit-merge))
(transient-define-argument magit-merge:--strategy ()
:description "Strategy"
:class 'transient-option
;; key for merge and rebase: "-s"
;; key for cherry-pick and revert: "=s"
;; shortarg for merge and rebase: "-s"
;; shortarg for cherry-pick and revert: none
:key "-s"
:argument "--strategy="
:choices '("resolve" "recursive" "octopus" "ours" "subtree"))
(transient-define-argument magit-merge:--strategy-option ()
:description "Strategy Option"
:class 'transient-option
:key "-X"
:argument "--strategy-option="
:choices '("ours" "theirs" "patience"))
;;;###autoload
(defun magit-merge-plain (rev &optional args nocommit)
"Merge commit REV into the current branch; using default message.
Unless there are conflicts or a prefix argument is used create a
merge commit using a generic commit message and without letting
the user inspect the result. With a prefix argument pretend the
merge failed to give the user the opportunity to inspect the
merge.
\(git merge --no-edit|--no-commit [ARGS] REV)"
(interactive (list (magit-read-other-branch-or-commit "Merge")
(magit-merge-arguments)
current-prefix-arg))
(magit-merge-assert)
(magit-run-git-async "merge" (if nocommit "--no-commit" "--no-edit") args rev))
;;;###autoload
(defun magit-merge-editmsg (rev &optional args)
"Merge commit REV into the current branch; and edit message.
Perform the merge and prepare a commit message but let the user
edit it.
\n(git merge --edit --no-ff [ARGS] REV)"
(interactive (list (magit-read-other-branch-or-commit "Merge")
(magit-merge-arguments)))
(magit-merge-assert)
(cl-pushnew "--no-ff" args :test #'equal)
(apply #'magit-run-git-with-editor "merge" "--edit"
(append (delete "--ff-only" args)
(list rev))))
;;;###autoload
(defun magit-merge-nocommit (rev &optional args)
"Merge commit REV into the current branch; pretending it failed.
Pretend the merge failed to give the user the opportunity to
inspect the merge and change the commit message.
\n(git merge --no-commit --no-ff [ARGS] REV)"
(interactive (list (magit-read-other-branch-or-commit "Merge")
(magit-merge-arguments)))
(magit-merge-assert)
(cl-pushnew "--no-ff" args :test #'equal)
(magit-run-git-async "merge" "--no-commit" args rev))
;;;###autoload
(defun magit-merge-into (branch &optional args)
"Merge the current branch into BRANCH and remove the former.
Before merging, force push the source branch to its push-remote,
provided the respective remote branch already exists, ensuring
that the respective pull-request (if any) won't get stuck on some
obsolete version of the commits that are being merged. Finally
if `forge-branch-pullreq' was used to create the merged branch,
then also remove the respective remote branch."
(interactive
(list (magit-read-other-local-branch
(format "Merge `%s' into"
(or (magit-get-current-branch)
(magit-rev-parse "HEAD")))
nil
(and-let* ((upstream (magit-get-upstream-branch))
(upstream (cdr (magit-split-branch-name upstream))))
(and (magit-branch-p upstream) upstream)))
(magit-merge-arguments)))
(let ((current (magit-get-current-branch))
(head (magit-rev-parse "HEAD")))
(when (zerop (magit-call-git "checkout" branch))
(if current
(magit--merge-absorb current args)
(magit-run-git-with-editor "merge" args head)))))
;;;###autoload
(defun magit-merge-absorb (branch &optional args)
"Merge BRANCH into the current branch and remove the former.
Before merging, force push the source branch to its push-remote,
provided the respective remote branch already exists, ensuring
that the respective pull-request (if any) won't get stuck on some
obsolete version of the commits that are being merged. Finally
if `forge-branch-pullreq' was used to create the merged branch,
then also remove the respective remote branch."
(interactive (list (magit-read-other-local-branch "Absorb branch")
(magit-merge-arguments)))
(magit--merge-absorb branch args))
(defun magit--merge-absorb (branch args)
(when (equal branch (magit-main-branch))
(unless (yes-or-no-p
(format "Do you really want to merge `%s' into another branch? "
branch))
(user-error "Abort")))
(if-let ((target (magit-get-push-branch branch t)))
(progn
(magit-git-push branch target (list "--force-with-lease"))
(set-process-sentinel
magit-this-process
(lambda (process event)
(when (memq (process-status process) '(exit signal))
(if (not (zerop (process-exit-status process)))
(magit-process-sentinel process event)
(process-put process 'inhibit-refresh t)
(magit-process-sentinel process event)
(magit--merge-absorb-1 branch args))))))
(magit--merge-absorb-1 branch args)))
(defun magit--merge-absorb-1 (branch args)
(if-let ((pr (magit-get "branch" branch "pullRequest")))
(magit-run-git-async
"merge" args "-m"
(format "Merge branch '%s'%s [#%s]"
branch
(let ((current (magit-get-current-branch)))
(if (equal current (magit-main-branch))
""
(format " into %s" current)))
pr)
branch)
(magit-run-git-async "merge" args "--no-edit" branch))
(set-process-sentinel
magit-this-process
(lambda (process event)
(when (memq (process-status process) '(exit signal))
(if (> (process-exit-status process) 0)
(magit-process-sentinel process event)
(process-put process 'inhibit-refresh t)
(magit-process-sentinel process event)
(magit-branch-maybe-delete-pr-remote branch)
(magit-branch-unset-pushRemote branch)
(magit-run-git "branch" "-D" branch))))))
;;;###autoload
(defun magit-merge-squash (rev)
"Squash commit REV into the current branch; don't create a commit.
\n(git merge --squash REV)"
(interactive (list (magit-read-other-branch-or-commit "Squash")))
(magit-merge-assert)
(magit-run-git-async "merge" "--squash" rev))
;;;###autoload
(defun magit-merge-preview (rev)
"Preview result of merging REV into the current branch."
(interactive (list (magit-read-other-branch-or-commit "Preview merge")))
(magit-merge-preview-setup-buffer rev))
;;;###autoload
(defun magit-merge-abort ()
"Abort the current merge operation.
\n(git merge --abort)"
(interactive)
(unless (file-exists-p (magit-git-dir "MERGE_HEAD"))
(user-error "No merge in progress"))
(magit-confirm 'abort-merge)
(magit-run-git-async "merge" "--abort"))
(defun magit-checkout-stage (file arg)
"During a conflict checkout and stage side, or restore conflict."
(interactive
(let ((file (magit-completing-read "Checkout file"
(magit-tracked-files) nil nil nil
'magit-read-file-hist
(magit-current-file))))
(cond ((member file (magit-unmerged-files))
(list file (magit-checkout-read-stage file)))
((yes-or-no-p (format "Restore conflicts in %s? " file))
(list file "--merge"))
(t
(user-error "Quit")))))
(pcase (cons arg (cddr (car (magit-file-status file))))
((or `("--ours" ?D ,_)
'("--ours" ?U ?A)
`("--theirs" ,_ ?D)
'("--theirs" ?A ?U))
(magit-run-git "rm" "--" file))
(_ (if (equal arg "--merge")
;; This fails if the file was deleted on one
;; side. And we cannot do anything about it.
(magit-run-git "checkout" "--merge" "--" file)
(magit-call-git "checkout" arg "--" file)
(magit-run-git "add" "-u" "--" file)))))
;;; Utilities
(defun magit-merge-in-progress-p ()
(file-exists-p (magit-git-dir "MERGE_HEAD")))
(defun magit--merge-range (&optional head)
(unless head
(setq head (magit-get-shortname
(car (magit-file-lines (magit-git-dir "MERGE_HEAD"))))))
(and head
(concat (magit-git-string "merge-base" "--octopus" "HEAD" head)
".." head)))
(defun magit-merge-assert ()
(or (not (magit-anything-modified-p t))
(magit-confirm 'merge-dirty
"Merging with dirty worktree is risky. Continue")))
(defun magit-checkout-read-stage (file)
(magit-read-char-case (format "For %s checkout: " file) t
(?o "[o]ur stage" "--ours")
(?t "[t]heir stage" "--theirs")
(?c "[c]onflict" "--merge")))
;;; Sections
(defvar magit-unmerged-section-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map magit-log-section-map)
map)
"Keymap for `unmerged' sections.")
(defun magit-insert-merge-log ()
"Insert section for the on-going merge.
Display the heads that are being merged.
If no merge is in progress, do nothing."
(when (magit-merge-in-progress-p)
(let* ((heads (mapcar #'magit-get-shortname
(magit-file-lines (magit-git-dir "MERGE_HEAD"))))
(range (magit--merge-range (car heads))))
(magit-insert-section (unmerged range)
(magit-insert-heading
(format "Merging %s:" (mapconcat #'identity heads ", ")))
(magit-insert-log
range
(let ((args magit-buffer-log-args))
(unless (member "--decorate=full" magit-buffer-log-args)
(push "--decorate=full" args))
args))))))
;;; _
(provide 'magit-merge)
;;; magit-merge.el ends here

1581
code/elpa/magit-20220821.1819/magit-mode.el Normal file
View File

File diff suppressed because it is too large Load Diff

201
code/elpa/magit-20220821.1819/magit-notes.el Normal file
View File

@ -0,0 +1,201 @@
;;; magit-notes.el --- Notes support -*- lexical-binding:t -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library implements support for `git-notes'.
;;; Code:
(require 'magit)
;;; Commands
;;;###autoload (autoload 'magit-notes "magit" nil t)
(transient-define-prefix magit-notes ()
"Edit notes attached to commits."
:man-page "git-notes"
["Configure local settings"
("c" magit-core.notesRef)
("d" magit-notes.displayRef)]
["Configure global settings"
("C" magit-global-core.notesRef)
("D" magit-global-notes.displayRef)]
["Arguments for prune"
:if-not magit-notes-merging-p
("-n" "Dry run" ("-n" "--dry-run"))]
["Arguments for edit and remove"
:if-not magit-notes-merging-p
(magit-notes:--ref)]
["Arguments for merge"
:if-not magit-notes-merging-p
(magit-notes:--strategy)]
["Actions"
:if-not magit-notes-merging-p
("T" "Edit" magit-notes-edit)
("r" "Remove" magit-notes-remove)
("m" "Merge" magit-notes-merge)
("p" "Prune" magit-notes-prune)]
["Actions"
:if magit-notes-merging-p
("c" "Commit merge" magit-notes-merge-commit)
("a" "Abort merge" magit-notes-merge-abort)])
(defun magit-notes-merging-p ()
(let ((dir (magit-git-dir "NOTES_MERGE_WORKTREE")))
(and (file-directory-p dir)
(directory-files dir nil "^[^.]"))))
(transient-define-infix magit-core.notesRef ()
:class 'magit--git-variable
:variable "core.notesRef"
:reader #'magit-notes-read-ref
:prompt "Set local core.notesRef")
(transient-define-infix magit-notes.displayRef ()
:class 'magit--git-variable
:variable "notes.displayRef"
:multi-value t
:reader #'magit-notes-read-refs
:prompt "Set local notes.displayRef")
(transient-define-infix magit-global-core.notesRef ()
:class 'magit--git-variable
:variable "core.notesRef"
:global t
:reader #'magit-notes-read-ref
:prompt "Set global core.notesRef")
(transient-define-infix magit-global-notes.displayRef ()
:class 'magit--git-variable
:variable "notes.displayRef"
:global t
:multi-value t
:reader #'magit-notes-read-refs
:prompt "Set global notes.displayRef")
(transient-define-argument magit-notes:--ref ()
:description "Manipulate ref"
:class 'transient-option
:key "-r"
:argument "--ref="
:reader #'magit-notes-read-ref)
(transient-define-argument magit-notes:--strategy ()
:description "Merge strategy"
:class 'transient-option
:shortarg "-s"
:argument "--strategy="
:choices '("manual" "ours" "theirs" "union" "cat_sort_uniq"))
(defun magit-notes-edit (commit &optional ref)
"Edit the note attached to COMMIT.
REF is the notes ref used to store the notes.
Interactively or when optional REF is nil use the value of Git
variable `core.notesRef' or \"refs/notes/commits\" if that is
undefined."
(interactive (magit-notes-read-args "Edit notes"))
(magit-run-git-with-editor "notes" (and ref (concat "--ref=" ref))
"edit" commit))
(defun magit-notes-remove (commit &optional ref)
"Remove the note attached to COMMIT.
REF is the notes ref from which the note is removed.
Interactively or when optional REF is nil use the value of Git
variable `core.notesRef' or \"refs/notes/commits\" if that is
undefined."
(interactive (magit-notes-read-args "Remove notes"))
(magit-run-git-with-editor "notes" (and ref (concat "--ref=" ref))
"remove" commit))
(defun magit-notes-merge (ref)
"Merge the notes ref REF into the current notes ref.
The current notes ref is the value of Git variable
`core.notesRef' or \"refs/notes/commits\" if that is undefined.
When there are conflicts, then they have to be resolved in the
temporary worktree \".git/NOTES_MERGE_WORKTREE\". When
done use `magit-notes-merge-commit' to finish. To abort
use `magit-notes-merge-abort'."
(interactive (list (magit-read-string-ns "Merge reference")))
(magit-run-git-with-editor "notes" "merge" ref))
(defun magit-notes-merge-commit ()
"Commit the current notes ref merge.
Also see `magit-notes-merge'."
(interactive)
(magit-run-git-with-editor "notes" "merge" "--commit"))
(defun magit-notes-merge-abort ()
"Abort the current notes ref merge.
Also see `magit-notes-merge'."
(interactive)
(magit-run-git-with-editor "notes" "merge" "--abort"))
(defun magit-notes-prune (&optional dry-run)
"Remove notes about unreachable commits."
(interactive (list (and (member "--dry-run" (transient-args 'magit-notes)) t)))
(when dry-run
(magit-process-buffer))
(magit-run-git-with-editor "notes" "prune" (and dry-run "--dry-run")))
;;; Readers
(defun magit-notes-read-ref (prompt _initial-input history)
(and-let* ((ref (magit-completing-read
prompt (magit-list-notes-refnames) nil nil
(and-let* ((def (magit-get "core.notesRef")))
(if (string-prefix-p "refs/notes/" def)
(substring def 11)
def))
history)))
(if (string-prefix-p "refs/" ref)
ref
(concat "refs/notes/" ref))))
(defun magit-notes-read-refs (prompt &optional _initial-input _history)
(mapcar (lambda (ref)
(if (string-prefix-p "refs/" ref)
ref
(concat "refs/notes/" ref)))
(completing-read-multiple
(concat prompt ": ")
(magit-list-notes-refnames) nil nil
(mapconcat (lambda (ref)
(if (string-prefix-p "refs/notes/" ref)
(substring ref 11)
ref))
(magit-get-all "notes.displayRef")
","))))
(defun magit-notes-read-args (prompt)
(list (magit-read-branch-or-commit prompt (magit-stash-at-point))
(and-let* ((str (--first (string-match "^--ref=\\(.+\\)" it)
(transient-args 'magit-notes))))
(match-string 1 str))))
;;; _
(provide 'magit-notes)
;;; magit-notes.el ends here

111
code/elpa/magit-20220821.1819/magit-obsolete.el Normal file
View File

@ -0,0 +1,111 @@
;;; magit-obsolete.el --- Obsolete definitions -*- lexical-binding:t -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library defines aliases for obsolete variables and functions.
;;; Code:
(require 'magit)
;;; Obsolete since v3.0.0
(define-obsolete-function-alias 'magit-diff-visit-file-worktree
#'magit-diff-visit-worktree-file "Magit 3.0.0")
(define-obsolete-function-alias 'magit-status-internal
#'magit-status-setup-buffer "Magit 3.0.0")
(define-obsolete-variable-alias 'magit-mode-setup-hook
'magit-setup-buffer-hook "Magit 3.0.0")
(define-obsolete-variable-alias 'magit-branch-popup-show-variables
'magit-branch-direct-configure "Magit 3.0.0")
(define-obsolete-function-alias 'magit-dispatch-popup
#'magit-dispatch "Magit 3.0.0")
(define-obsolete-function-alias 'magit-repolist-column-dirty
#'magit-repolist-column-flag "Magit 3.0.0")
(define-obsolete-variable-alias 'magit-disable-line-numbers
'magit-section-disable-line-numbers "Magit 3.0.0")
(define-obsolete-variable-alias 'inhibit-magit-refresh
'magit-inhibit-refresh "Magit 3.0.0")
(defun magit--magit-popup-warning ()
(display-warning 'magit "\
Magit no longer uses Magit-Popup.
It now uses Transient.
See https://emacsair.me/2019/02/14/transient-0.1.
However your configuration and/or some third-party package that
you use still depends on the `magit-popup' package. But because
`magit' no longer depends on that, `package' has removed it from
your system.
If some package that you use still depends on `magit-popup' but
does not declare it as a dependency, then please contact its
maintainer about that and install `magit-popup' explicitly.
If you yourself use functions that are defined in `magit-popup'
in your configuration, then the next step depends on what you use
that for.
* If you use `magit-popup' to define your own popups but do not
modify any of Magit's old popups, then you have to install
`magit-popup' explicitly. (You can also migrate to Transient,
but there is no need to rush that.)
* If you add additional arguments and/or actions to Magit's popups,
then you have to port that to modify the new \"transients\" instead.
See https://github.com/magit/magit/wiki/\
Converting-popup-modifications-to-transient-modifications
To find installed packages that still use `magit-popup' you can
use e.g. \"M-x rgrep RET magit-popup RET RET ~/.emacs.d/ RET\"."))
(cl-eval-when (eval load)
(unless (require (quote magit-popup) nil t)
(defun magit-define-popup-switch (&rest _)
(magit--magit-popup-warning))
(defun magit-define-popup-option (&rest _)
(magit--magit-popup-warning))
(defun magit-define-popup-variable (&rest _)
(magit--magit-popup-warning))
(defun magit-define-popup-action (&rest _)
(magit--magit-popup-warning))
(defun magit-define-popup-sequence-action (&rest _)
(magit--magit-popup-warning))
(defun magit-define-popup-key (&rest _)
(magit--magit-popup-warning))
(defun magit-define-popup-keys-deferred (&rest _)
(magit--magit-popup-warning))
(defun magit-change-popup-key (&rest _)
(magit--magit-popup-warning))
(defun magit-remove-popup-key (&rest _)
(magit--magit-popup-warning))))
;;; _
(provide 'magit-obsolete)
;;; magit-obsolete.el ends here

326
code/elpa/magit-20220821.1819/magit-patch.el Normal file
View File

@ -0,0 +1,326 @@
;;; magit-patch.el --- Creating and applying patches -*- lexical-binding:t -*-
;; Copyright (C) 2008-2022 The Magit Project Contributors
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Magit 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.
;;
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library implements patch commands.
;;; Code:
(require 'magit)
;;; Options
(defcustom magit-patch-save-arguments '(exclude "--stat")
"Control arguments used by the command `magit-patch-save'.
`magit-patch-save' (which see) saves a diff for the changes
shown in the current buffer in a patch file. It may use the
same arguments as used in the buffer or a subset thereof, or
a constant list of arguments, depending on this option and
the prefix argument."
:package-version '(magit . "2.12.0")
:group 'magit-diff
:type '(choice (const :tag "use buffer arguments" buffer)
(cons :tag "use buffer arguments except"
(const :format "" exclude)
(repeat :format "%v%i\n"
(string :tag "Argument")))
(repeat :tag "use constant arguments"
(string :tag "Argument"))))
;;; Commands
;;;###autoload (autoload 'magit-patch "magit-patch" nil t)
(transient-define-prefix magit-patch ()
"Create or apply patches."
["Actions"
[("c" "Create patches" magit-patch-create)
("w" "Apply patches" magit-am)]
[("a" "Apply plain patch" magit-patch-apply)
("s" "Save diff as patch" magit-patch-save)]
[("r" "Request pull" magit-request-pull)]])
;;;###autoload (autoload 'magit-patch-create "magit-patch" nil t)
(transient-define-prefix magit-patch-create (range args files)
"Create patches for the commits in RANGE.
When a single commit is given for RANGE, create a patch for the
changes introduced by that commit (unlike 'git format-patch'
which creates patches for all commits that are reachable from
`HEAD' but not from the specified commit)."
:man-page "git-format-patch"
:incompatible '(("--subject-prefix=" "--rfc"))
["Mail arguments"
(6 magit-format-patch:--in-reply-to)
(6 magit-format-patch:--thread)
(6 magit-format-patch:--from)
(6 magit-format-patch:--to)
(6 magit-format-patch:--cc)]
["Patch arguments"
(magit-format-patch:--base)
(magit-format-patch:--reroll-count)
(5 magit-format-patch:--interdiff)
(magit-format-patch:--range-diff)
(magit-format-patch:--subject-prefix)
("C-m r " "RFC subject prefix" "--rfc")
("C-m l " "Add cover letter" "--cover-letter")
(5 magit-format-patch:--cover-from-description)
(5 magit-format-patch:--notes)
(magit-format-patch:--output-directory)]
["Diff arguments"
(magit-diff:-U)
(magit-diff:-M)
(magit-diff:-C)
(magit-diff:--diff-algorithm)
(magit:--)
(7 "-b" "Ignore whitespace changes" ("-b" "--ignore-space-change"))
(7 "-w" "Ignore all whitespace" ("-w" "--ignore-all-space"))]
["Actions"
("c" "Create patches" magit-patch-create)]
(interactive
(if (not (eq transient-current-command 'magit-patch-create))
(list nil nil nil)
(cons (if-let ((revs (magit-region-values 'commit t)))
(concat (car (last revs)) "^.." (car revs))
(let ((range (magit-read-range-or-commit
"Format range or commit")))
(if (string-search ".." range)
range
(format "%s~..%s" range range))))
(let ((args (transient-args 'magit-patch-create)))
(list (-filter #'stringp args)
(cdr (assoc "--" args)))))))
(if (not range)
(transient-setup 'magit-patch-create)
(magit-run-git "format-patch" range args "--" files)
(when (member "--cover-letter" args)
(save-match-data
(find-file
(expand-file-name
(concat (and-let* ((v (transient-arg-value "--reroll-count=" args)))
(format "v%s-" v))
"0000-cover-letter.patch")
(let ((topdir (magit-toplevel)))
(if-let ((dir (transient-arg-value "--output-directory=" args)))
(expand-file-name dir topdir)
topdir))))))))
(transient-define-argument magit-format-patch:--in-reply-to ()
:description "In reply to"
:class 'transient-option
:key "C-m C-r"
:argument "--in-reply-to=")
(transient-define-argument magit-format-patch:--thread ()
:description "Thread style"
:class 'transient-option
:key "C-m s "
:argument "--thread="
:reader #'magit-format-patch-select-thread-style)
(defun magit-format-patch-select-thread-style (&rest _ignore)
(magit-read-char-case "Thread style " t
(?d "[d]eep" "deep")
(?s "[s]hallow" "shallow")))
(transient-define-argument magit-format-patch:--base ()
:description "Insert base commit"
:class 'transient-option
:key "C-m b "
:argument "--base="
:reader #'magit-format-patch-select-base)
(defun magit-format-patch-select-base (prompt initial-input history)
(or (magit-completing-read prompt (cons "auto" (magit-list-refnames))
nil nil initial-input history "auto")
(user-error "Nothing selected")))
(transient-define-argument magit-format-patch:--reroll-count ()
:description "Reroll count"
:class 'transient-option
:key "C-m v "
:shortarg "-v"
:argument "--reroll-count="
:reader #'transient-read-number-N+)
(transient-define-argument magit-format-patch:--interdiff ()
:description "Insert interdiff"
:class 'transient-option
:key "C-m d i"
:argument "--interdiff="
:reader #'magit-transient-read-revision)
(transient-define-argument magit-format-patch:--range-diff ()
:description "Insert range-diff"
:class 'transient-option
:key "C-m d r"
:argument "--range-diff="
:reader #'magit-format-patch-select-range-diff)
(defun magit-format-patch-select-range-diff (prompt _initial-input _history)
(magit-read-range-or-commit prompt))
(transient-define-argument magit-format-patch:--subject-prefix ()
:description "Subject Prefix"
:class 'transient-option
:key "C-m p "
:argument "--subject-prefix=")
(transient-define-argument magit-format-patch:--cover-from-description ()
:description "Use branch description"
:class 'transient-option
:key "C-m D "
:argument "--cover-from-description="
:reader #'magit-format-patch-select-description-mode)
(defun magit-format-patch-select-description-mode (&rest _ignore)
(magit-read-char-case "Use description as " t
(?m "[m]essage" "message")
(?s "[s]ubject" "subject")
(?a "[a]uto" "auto")
(?n "[n]othing" "none")))
(transient-define-argument magit-format-patch:--notes ()
:description "Insert commentary from notes"
:class 'transient-option
:key "C-m n "
:argument "--notes="
:reader #'magit-notes-read-ref)
(transient-define-argument magit-format-patch:--from ()
:description "From"
:class 'transient-option
:key "C-m C-f"
:argument "--from="
:reader #'magit-transient-read-person)
(transient-define-argument magit-format-patch:--to ()
:description "To"
:class 'transient-option
:key "C-m C-t"
:argument "--to="
:reader #'magit-transient-read-person)
(transient-define-argument magit-format-patch:--cc ()
:description "CC"
:class 'transient-option
:key "C-m C-c"
:argument "--cc="
:reader #'magit-transient-read-person)
(transient-define-argument magit-format-patch:--output-directory ()
:description "Output directory"
:class 'transient-option
:key "C-m o "
:shortarg "-o"
:argument "--output-directory="
:reader #'transient-read-existing-directory)
;;;###autoload (autoload 'magit-patch-apply "magit-patch" nil t)
(transient-define-prefix magit-patch-apply (file &rest args)
"Apply the patch file FILE."
:man-page "git-apply"
["Arguments"
("-i" "Also apply to index" "--index")
("-c" "Only apply to index" "--cached")
("-3" "Fall back on 3way merge" ("-3" "--3way"))]
["Actions"
("a" "Apply patch" magit-patch-apply)]
(interactive
(if (not (eq transient-current-command 'magit-patch-apply))
(list nil)
(list (expand-file-name
(read-file-name "Apply patch: "
default-directory nil nil
(and-let* ((file (magit-file-at-point)))
(file-relative-name file))))
(transient-args 'magit-patch-apply))))
(if (not file)
(transient-setup 'magit-patch-apply)
(magit-run-git "apply" args "--" (magit-convert-filename-for-git file))))
;;;###autoload
(defun magit-patch-save (file &optional arg)
"Write current diff into patch FILE.
What arguments are used to create the patch depends on the value
of `magit-patch-save-arguments' and whether a prefix argument is
used.
If the value is the symbol `buffer', then use the same arguments
as the buffer. With a prefix argument use no arguments.
If the value is a list beginning with the symbol `exclude', then
use the same arguments as the buffer except for those matched by
entries in the cdr of the list. The comparison is done using
`string-prefix-p'. With a prefix argument use the same arguments
as the buffer.
If the value is a list of strings (including the empty list),
then use those arguments. With a prefix argument use the same
arguments as the buffer.
Of course the arguments that are required to actually show the
same differences as those shown in the buffer are always used."
(interactive (list (read-file-name "Write patch file: " default-directory)
current-prefix-arg))
(unless (derived-mode-p 'magit-diff-mode)
(user-error "Only diff buffers can be saved as patches"))
(let ((rev magit-buffer-range)
(typearg magit-buffer-typearg)
(args magit-buffer-diff-args)
(files magit-buffer-diff-files))
(cond ((eq magit-patch-save-arguments 'buffer)
(when arg
(setq args nil)))
((eq (car-safe magit-patch-save-arguments) 'exclude)
(unless arg
(setq args (-difference args (cdr magit-patch-save-arguments)))))
((not arg)
(setq args magit-patch-save-arguments)))
(with-temp-file file
(magit-git-insert "diff" rev "-p" typearg args "--" files)))
(magit-refresh))
;;;###autoload
(defun magit-request-pull (url start end)
"Request upstream to pull from your public repository.
URL is the url of your publicly accessible repository.
START is a commit that already is in the upstream repository.
END is the last commit, usually a branch name, which upstream
is asked to pull. START has to be reachable from that commit."
(interactive
(list (magit-get "remote" (magit-read-remote "Remote") "url")
(magit-read-branch-or-commit "Start" (magit-get-upstream-branch))
(magit-read-branch-or-commit "End")))
(let ((dir default-directory))
;; mu4e changes default-directory
(compose-mail)
(setq default-directory dir))
(message-goto-body)
(magit-git-insert "request-pull" start url end)
(set-buffer-modified-p nil))
;;; _
(provide 'magit-patch)
;;; magit-patch.el ends here

19
code/elpa/magit-20220821.1819/magit-pkg.el Normal file
View File

@ -0,0 +1,19 @@
(define-package "magit" "20220821.1819" "A Git porcelain inside Emacs."
'((emacs "25.1")
(compat "28.1.1.2")
(dash "20210826")
(git-commit "20220222")
(magit-section "20220325")
(transient "20220325")
(with-editor "20220318"))
:commit "712be4632b0ddc7899ca90db8f9be20d90b4326f" :authors
'(("Marius Vollmer" . "marius.vollmer@gmail.com")
("Jonas Bernoulli" . "jonas@bernoul.li"))
:maintainer
'("Jonas Bernoulli" . "jonas@bernoul.li")
:keywords
'("git" "tools" "vc")
:url "https://github.com/magit/magit")
;; Local Variables:
;; no-byte-compile: t
;; End:

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