kemonine
/
emacs
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
emacs/org/elpa/helm-ls-git-20220418.657/helm-ls-git.el

1782 lines
74 KiB
EmacsLisp
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;;; helm-ls-git.el --- list git files. -*- lexical-binding: t -*-
;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto <thierry.volpiatto@gmail.com>
;; Package-Requires: ((helm "1.7.8"))
;; Package-Version: 20220418.657
;; Package-Commit: c6494a462e605d6fd16c9355e32685c3e0085589
;; 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 'vc)
(require 'vc-git)
(require 'helm-files) ; helm-grep is required in helm-files.
(require 'helm-types)
(defvaralias 'helm-c-source-ls-git 'helm-source-ls-git)
(make-obsolete-variable 'helm-c-source-ls-git 'helm-source-ls-git "1.5.1")
(defvaralias 'helm-c-source-ls-git-status 'helm-source-ls-git-status)
(make-obsolete-variable 'helm-c-source-ls-git-status 'helm-source-ls-git-status "1.5.1")
(defvar server-clients)
(declare-function helm-comp-read "ext:helm-mode.el")
(declare-function server-running-p "server.el")
(declare-function server-edit "server.el")
(declare-function server-send-string "server.el")
(declare-function server-quote-arg "server.el")
;; Define the sources.
(defvar helm-source-ls-git-status nil
"This source will built at runtime.
It can be build explicitly with function
`helm-ls-git-build-git-status-source'.")
(defvar helm-source-ls-git nil
"This source will built at runtime.
It can be build explicitly with function
`helm-ls-git-build-ls-git-source'.")
(defvar helm-source-ls-git-buffers nil
"This source will built at runtime.
It can be build explicitly with function
`helm-ls-git-build-buffers-source'.")
(defgroup helm-ls-git nil
"Helm completion for git repos."
:group 'helm)
(defcustom helm-ls-git-show-abs-or-relative 'relative
"Show full path or relative path to repo when using `helm-ff-toggle-basename'.
Valid values are symbol 'absolute or 'relative (default)."
:group 'helm-ls-git
:type '(radio :tag "Show full path or relative path to Git repo when toggling"
(const :tag "Show full path" absolute)
(const :tag "Show relative path" relative)))
(defcustom helm-ls-git-status-command 'vc-dir
"Favorite git-status command for emacs.
If you want to use magit use `magit-status-setup-buffer' and not
`magit-status' which is working only interactively."
:group 'helm-ls-git
:type 'symbol)
(defcustom helm-ls-git-fuzzy-match nil
"Enable fuzzy matching in `helm-source-ls-git-status' and `helm-source-ls-git'."
:group 'helm-ls-git
:set (lambda (var val)
(set var val)
(setq helm-source-ls-git nil
helm-source-ls-git-status nil
helm-source-ls-git-buffers nil))
:type 'boolean)
;; Now the git-grep command is defined in helm-grep.el,
;; alias it for backward compatibility.
(defvar helm-ls-git-grep-command)
(defvaralias 'helm-ls-git-grep-command 'helm-grep-git-grep-command)
(make-obsolete-variable 'helm-ls-git-grep-command 'helm-grep-git-grep-command "1.8.0")
(defcustom helm-ls-git-default-sources '(helm-source-ls-git-status
helm-ls-git-branches-source
helm-source-ls-git-buffers
helm-source-ls-git
helm-ls-git-stashes-source
helm-ls-git-create-branch-source)
"Default sources for `helm-ls-git-ls'."
:group 'helm-ls-git
:type '(repeat symbol))
(defcustom helm-ls-git-format-glob-string "'%s'"
"String to format globs in `helm-grep-get-file-extensions'.
Glob are enclosed in single quotes by default."
:group 'helm-ls-git
:type 'string)
(defcustom helm-ls-git-ls-switches '("ls-files" "--full-name" "--")
"A list of arguments to pass to `git-ls-files'.
To see files in submodules add the option \"--recurse-submodules\".
If you have problems displaying unicode filenames use
\'(\"-c\" \"core.quotePath=false\" \"ls-files\" \"--full-name\" \"--\").
See Issue #52."
:type '(repeat string)
:group 'helm-ls-git)
(defcustom helm-ls-git-auto-checkout nil
"Stash automatically uncommited changes before checking out a branch."
:type 'boolean
:group 'helm-ls-git)
(defcustom helm-ls-git-log-max-commits "100"
"Max number of commits to show in git log (git log -n option)."
:type 'string
:group 'helm-ls-git)
(defcustom helm-ls-git-delete-branch-on-remote nil
"Delete remote branch without asking when non nil.
This happen only when deleting a remote branch e.g. remotes/origin/foo."
:type 'boolean
:group 'helm-ls-git)
(defface helm-ls-git-modified-not-staged-face
'((t :foreground "yellow"))
"Files which are modified but not yet staged."
:group 'helm-ls-git)
(defface helm-ls-git-modified-and-staged-face
'((t :foreground "Goldenrod"))
"Files which are modified and already staged."
:group 'helm-ls-git)
(defface helm-ls-git-renamed-modified-face
'((t :foreground "Goldenrod"))
"Files which are renamed or renamed and modified."
:group 'helm-ls-git)
(defface helm-ls-git-untracked-face
'((t :foreground "red"))
"Files which are not yet tracked by git."
:group 'helm-ls-git)
(defface helm-ls-git-added-copied-face
'((t :foreground "green"))
"Files which are newly added or copied."
:group 'helm-ls-git)
(defface helm-ls-git-added-modified-face
'((t :foreground "blue"))
"Files which are newly added and have unstaged modifications."
:group 'helm-ls-git)
(defface helm-ls-git-deleted-not-staged-face
'((t :foreground "Darkgoldenrod3"))
"Files which are deleted but not staged."
:group 'helm-ls-git)
(defface helm-ls-git-deleted-and-staged-face
'((t :foreground "DimGray"))
"Files which are deleted and staged."
:group 'helm-ls-git)
(defface helm-ls-git-conflict-face
'((t :foreground "MediumVioletRed"))
"Files which contain rebase/merge conflicts."
:group 'helm-ls-git)
(defface helm-ls-git-branches-current
'((t :foreground "gold"))
"Color of the start prefixing current branch."
:group 'helm-ls-git)
(defface helm-ls-git-branches-name
'((t :foreground "red"))
"Color of branches names."
:group 'helm-ls-git)
(defvar helm-ls-git-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map helm-generic-files-map)
(define-key map (kbd "C-s") 'helm-ff-run-grep)
(define-key map (kbd "M-g g") 'helm-ls-git-run-grep)
(define-key map (kbd "C-c g") 'helm-ff-run-gid)
(define-key map (kbd "C-c i") 'helm-ls-git-ls-files-show-others)
(define-key map (kbd "M-e") 'helm-ls-git-run-switch-to-shell)
map))
(defvar helm-ls-git-buffer-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map helm-buffer-map)
(define-key map (kbd "C-c i") 'helm-ls-git-ls-files-show-others)
map))
(defvar helm-ls-git-branches-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map helm-map)
(define-key map (kbd "C-c b") 'helm-ls-git-branches-toggle-show-all)
(define-key map (kbd "M-L") 'helm-ls-git-run-show-log)
(define-key map (kbd "C-c P") 'helm-ls-git-run-push)
(define-key map (kbd "C-c F") 'helm-ls-git-run-pull)
(define-key map (kbd "C-c f") 'helm-ls-git-run-fetch)
(define-key map (kbd "M-e") 'helm-ls-git-run-switch-to-shell)
map))
(defvar helm-ls-git-status-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map helm-ls-git-map)
(define-key map (kbd "C-c c") 'helm-ls-git-run-stage-marked-and-commit)
(define-key map (kbd "C-c a") 'helm-ls-git-run-stage-marked-and-amend-commit)
(define-key map (kbd "C-c s") 'helm-ls-git-run-stage-files)
(define-key map (kbd "C-c e") 'helm-ls-git-run-stage-marked-and-extend-commit)
(define-key map (kbd "C-c z") 'helm-ls-git-run-stash)
(define-key map (kbd "C-c Z") 'helm-ls-git-run-stash-snapshot)
(define-key map (kbd "M-e") 'helm-ls-git-run-switch-to-shell)
map))
(defvar helm-ls-git-help-message
"* Helm ls git
** Tips
*** Start helm-ls-git
You can start with `helm-ls-git' but you can also use the generic
`helm-browse-project' which will use `helm-ls-git' if you are in
a git project (actually supported backends are git and hg though
helm-ls-hg is no more maintained).
*** You may want to use magit as git status command
By default helm-ls-git is using emacs `vc-dir' as `helm-ls-git-status-command',
perhaps you want to use something better like `magit-status' ?
*** Git log
From branches source, you can launch git log. With a numeric
prefix arg specify the number of commits to show. Once you are
in Git log you can specify with 2 marked candidates range of
commits, specifying more than two marked candidate for actions
accepting ranges will fail. When specifying a range of commits,
the top commit will be included in range whereas the bottom
commit will not be included, e.g. if you mark commit-2 and
commit-5, and use the format-patch action, git will make
01-commit-4.patch, 02-commit-3.patch, and 03-commit-2.patch files
taking care of naming files in the reverse order for applying
patches later, commit-5 beeing excluded.
Persistent action in git log is to show diff of commits, if you
want to always show diff while moving from one commit to the
other use follow-mode (C-c C-f).
*** Git commit
Commits will be done using emacsclient as GIT_EDITOR, with
major-mode `helm-ls-git-commmit-mode' which provide following commands:
\\<helm-ls-git-commit-mode-map>
|Keys|Description
|-------------+--------------|
|\\[helm-ls-git-server-edit]|Exit when done
|\\[helm-ls-git-server-edit-abort]|Abort
NOTE: This mode is based on diff-mode, this to show a colorized
diff of your commit, you can use any regular emacs editing
commands from there.
*** Git rebase
helm-ls-git provide two rebase actions, one that run
interactively from git log source and one that work
non-interactively from branches source. With the former you can
rebase interactively from a given commit you selected from git log
and this ONLY for current branch, once done you can rebase one
branch into the other from branches source. This is one workflow
that helm-ls-git provide, other workflows may not work, so for
more complex usage switch to command line or a more enhaced tool
like Magit. For editing the first file git rebase use for
rebasing (\"git-rebase-todo\") helm-ls-git use a major-mode
called `helm-ls-git-rebase-todo-mode' which provide several commands:
\\<helm-ls-git-rebase-todo-mode-map>
|Keys|Description
|-------------+--------------|
|p|pick
|r|reword
|e|edit
|s|squash
|f|fixup
|x|exec
|d|drop
|\\[helm-ls-git-rebase-todo-move-down]|Move line down
|\\[helm-ls-git-rebase-todo-move-up]|Move line up
|\\[helm-ls-git-server-edit]|Exit when done
|\\[helm-ls-git-server-edit-abort]|Abort
*** Git grep usage
The behavior is not exactly the same as what you have when you
launch git-grep from `helm-find-files', here in what it differ:
1) The prefix arg allow to grep only the `default-directory' whereas
with `helm-find-files' the prefix arg allow browsing the whole repo.
So with `helm-ls-git' the default is to grep the whole repo.
2) With `helm-ls-git', because you have the whole list of files of the repo
you can mark some of the files to grep only those, if no files are marked grep
the whole repo or the files under current directory depending of prefix arg.
NOTE: The previous behavior was prompting user for the file
extensions to grep, this is non sense because we have here the
whole list of files (recursive) of current repo and not only the
file under current directory, so we have better time
selectionning the files we want to grep.
**** Grep a subdirectory of current repository.
Switch to `helm-find-files' with `C-x C-f', navigate to your directory
and launch git-grep from there.
*** Problem with unicode filenames (chinese etc...)
See docstring of `helm-ls-git-ls-switches'.
** Commands
\\<helm-ls-git-map>
|Keys|Description
|-----------+----------|
|\\[helm-ls-git-run-grep]|Run git-grep.
|\\[helm-ff-run-gid]|Run Gid.
|\\[helm-ls-git-ls-files-show-others]|Toggle tracked/non tracked files view.
|\\[helm-ls-git-run-switch-to-shell]|Switch to shell
|\\<helm-generic-files-map>
|\\[helm-ff-run-toggle-basename]|Toggle basename.
|\\[helm-ff-run-zgrep]|Run zgrep.
|\\[helm-ff-run-pdfgrep]|Run Pdfgrep on marked files.
|\\[helm-ff-run-copy-file]|Copy file(s)
|\\[helm-ff-run-rename-file]|Rename file(s).
|\\[helm-ff-run-symlink-file]|Symlink file(s).
|\\[helm-ff-run-hardlink-file]|Hardlink file(s).
|\\[helm-ff-run-delete-file]|Delete file(s).
|\\[helm-ff-run-byte-compile-file]|Byte compile file(s) (C-u load) (elisp).
|\\[helm-ff-run-load-file]|Load file(s) (elisp).
|\\[helm-ff-run-ediff-file]|Ediff file.
|\\[helm-ff-run-ediff-merge-file]|Ediff merge file.
|\\[helm-ff-run-switch-other-window]|Switch other window.
|\\[helm-ff-properties-persistent]|Show file properties.
|\\[helm-ff-run-etags]|Run etags (C-u use tap, C-u C-u reload DB).
|\\[helm-yank-text-at-point]|Yank text at point.
|\\[helm-ff-run-open-file-externally]|Open file with external program (C-u to choose).
|\\[helm-ff-run-open-file-with-default-tool]|Open file externally with default tool.
|\\[helm-ff-run-insert-org-link]|Insert org link.")
;; Append visited files from `helm-source-ls-git' to `file-name-history'.
(add-to-list 'helm-files-save-history-extra-sources "Git files")
(defvar helm-ls-git-log-file nil) ; Set it for debugging.
(defun helm-ls-git-list-files ()
(when (and helm-ls-git-log-file
(file-exists-p helm-ls-git-log-file))
(delete-file helm-ls-git-log-file))
;; `helm-resume' will use the local value of `default-directory'
;; in `helm-buffer' as value for `default-directory'.
(helm-aif (helm-ls-git-root-dir)
(with-helm-default-directory it
(with-output-to-string
(with-current-buffer standard-output
(apply #'process-file
"git"
nil (list t helm-ls-git-log-file) nil
helm-ls-git-ls-switches))))
;; Return empty string to give to `split-string'
;; in `helm-ls-git-init'.
""))
(defun helm-ls-git-ls-files-show-others ()
"Toggle view of tracked/non tracked files."
(interactive)
(with-helm-alive-p
(setq helm-ls-git-ls-switches
(if (member "-o" helm-ls-git-ls-switches)
(remove "-o" helm-ls-git-ls-switches)
(helm-append-at-nth helm-ls-git-ls-switches "-o" 1)))
(helm-force-update)))
(put 'helm-ls-git-ls-files-show-others 'no-helm-mx t)
(cl-defun helm-ls-git-root-dir (&optional (directory default-directory))
(locate-dominating-file directory ".git"))
(defun helm-ls-git-not-inside-git-repo ()
(not (helm-ls-git-root-dir)))
(defun helm-ls-git-transformer (candidates _source)
(cl-loop with root = (helm-ls-git-root-dir)
with untracking = (member "-o" helm-ls-git-ls-switches)
for file in candidates
for abs = (expand-file-name file root)
for disp = (if (and helm-ff-transformer-show-only-basename
(not (string-match "[.]\\{1,2\\}\\'" file)))
(helm-basename file) file)
collect
(cons (propertize (if untracking (concat "? " disp) disp)
'face (if untracking
'helm-ls-git-untracked-face
'helm-ff-file))
abs)))
(defun helm-ls-git-sort-fn (candidates _source)
"Transformer for sorting candidates."
(helm-ff-sort-candidates candidates nil))
(defun helm-ls-git-init ()
(let ((data (cl-loop with root = (helm-ls-git-root-dir)
for c in (split-string (helm-ls-git-list-files) "\n" t)
collect (if (eq helm-ls-git-show-abs-or-relative 'relative)
c (expand-file-name c root)))))
(when (null data)
(setq data
(if helm-ls-git-log-file
(with-current-buffer
(find-file-noselect helm-ls-git-log-file)
(prog1
(buffer-substring-no-properties
(point-min) (point-max))
(kill-buffer)))
data)))
(helm-init-candidates-in-buffer 'global data)))
(defvar helm-ls-git--current-branch nil)
(defun helm-ls-git--branch ()
(or helm-ls-git--current-branch
(with-temp-buffer
(let ((ret (process-file "git" nil t nil "symbolic-ref" "--short" "HEAD")))
;; Use sha of HEAD when branch name is missing.
(unless (zerop ret)
(erase-buffer)
(process-file "git" nil t nil "rev-parse" "--short" "HEAD")))
;; We use here (goto-char (point-min)) instead of (point-min)
;; to not endup with a ^J control char at end of branch name.
(buffer-substring-no-properties (goto-char (point-min))
(line-end-position)))))
(defun helm-ls-git-header-name (name)
(format "%s (%s)" name (helm-ls-git--branch)))
(defun helm-ls-git-actions-list (&optional actions)
(helm-append-at-nth
actions
(helm-make-actions "Git status"
(lambda (_candidate)
(funcall helm-ls-git-status-command
(helm-default-directory)))
"Git grep files (`C-u' only current directory)"
'helm-ls-git-grep
"Gid" 'helm-ff-gid
"Search in Git log (C-u show patch)"
'helm-ls-git-search-log
"Switch to shell" 'helm-ls-git-switch-to-shell)
1))
(defun helm-ls-git-match-part (candidate)
(if (with-helm-buffer helm-ff-transformer-show-only-basename)
(helm-basename candidate)
candidate))
(defclass helm-ls-git-source (helm-source-in-buffer)
((header-name :initform 'helm-ls-git-header-name)
(init :initform 'helm-ls-git-init)
(cleanup :initform (lambda ()
(setq helm-ls-git-ls-switches (remove "-o" helm-ls-git-ls-switches))))
(update :initform (lambda ()
(helm-set-local-variable
'helm-ls-git--current-branch nil)))
(keymap :initform 'helm-ls-git-map)
(help-message :initform 'helm-ls-git-help-message)
(match-part :initform 'helm-ls-git-match-part)
(filtered-candidate-transformer
:initform '(helm-ls-git-transformer
helm-ls-git-sort-fn))
(action-transformer :initform 'helm-transform-file-load-el)
(group :initform 'helm-ls-git)))
(defclass helm-ls-git-status-source (helm-source-in-buffer)
((header-name :initform 'helm-ls-git-header-name)
(init :initform
(lambda ()
(helm-init-candidates-in-buffer 'global
(helm-ls-git-status))))
(keymap :initform 'helm-ls-git-status-map)
(filtered-candidate-transformer :initform 'helm-ls-git-status-transformer)
(persistent-action :initform 'helm-ls-git-diff)
(persistent-help :initform "Diff")
(help-message :initform 'helm-ls-git-help-message)
(action-transformer :initform 'helm-ls-git-status-action-transformer)
(action :initform
(helm-make-actions
"Find file" 'helm-find-many-files
"Git status" (lambda (_candidate)
(funcall helm-ls-git-status-command
(helm-default-directory)))
"Switch to shell" #'helm-ls-git-switch-to-shell))
(group :initform 'helm-ls-git)))
(defun helm-ls-git-revert-buffers-in-project ()
(cl-loop for buf in (helm-browse-project-get-buffers (helm-ls-git-root-dir))
when (buffer-file-name (get-buffer buf))
do (with-current-buffer buf (revert-buffer nil t))))
(defun helm-ls-git-diff (candidate)
(let ((default-directory
(expand-file-name (file-name-directory candidate)))
(win (get-buffer-window "*vc-diff*" 'visible)))
(if (and win
(eq last-command 'helm-execute-persistent-action))
(with-helm-window
(kill-buffer "*vc-diff*")
(if (and helm-persistent-action-display-window
(window-dedicated-p (next-window win 1)))
(delete-window helm-persistent-action-display-window)
(set-window-buffer win helm-current-buffer)))
(when (buffer-live-p (get-buffer "*vc-diff*"))
(kill-buffer "*vc-diff*"))
(vc-git-diff (helm-marked-candidates))
(pop-to-buffer "*vc-diff*")
(diff-mode))))
;;; Git grep
;;
(defun helm-ls-git-grep (_candidate)
(let* ((helm-grep-default-command helm-ls-git-grep-command)
helm-grep-default-recurse-command
(mkd (helm-marked-candidates))
(files (if (cdr mkd) mkd '("")))
;; Expand filename of each candidate with the git root dir.
;; The filename will be in the help-echo prop.
(helm-grep-default-directory-fn 'helm-ls-git-root-dir)
;; set `helm-ff-default-directory' to the root of project.
(helm-ff-default-directory (if helm-current-prefix-arg
default-directory
(helm-ls-git-root-dir))))
(helm-do-grep-1 files)))
(defun helm-ls-git-run-grep ()
"Run Git Grep action from helm-ls-git."
(interactive)
(with-helm-alive-p
(helm-exit-and-execute-action 'helm-ls-git-grep)))
(put 'helm-ls-git-run-grep 'no-helm-mx t)
;;; Git log
;;
(defun helm-ls-git-search-log (_candidate)
(let* ((query (helm-read-string "Search log: "))
(coms (if helm-current-prefix-arg
(list "log" "-p" "--grep" query)
(list "log" "--grep" query))))
(with-current-buffer (get-buffer-create "*helm ls log*")
(set (make-local-variable 'buffer-read-only) nil)
(erase-buffer)
(apply #'process-file "git" nil (list t nil) nil coms)))
(pop-to-buffer "*helm ls log*")
(goto-char (point-min))
(diff-mode))
(defun helm-ls-git-log (&optional branch num)
(when (string-match "->" branch)
(setq branch (car (last (split-string branch "->")))))
(let* ((commits-number (if num
(number-to-string num)
helm-ls-git-log-max-commits))
(switches `("log" "--color"
"--date=local"
"--pretty=format:%C(yellow)%h%Creset \
%C(green)%ad%Creset %<(60,trunc)%s %Cred%an%Creset %C(auto)%d%Creset"
"-n" ,commits-number
,(or branch ""))))
(with-helm-default-directory (helm-ls-git-root-dir)
(with-output-to-string
(with-current-buffer standard-output
(apply #'process-file "git" nil t nil switches))))))
(defun helm-ls-git-show-log (branch)
(let* ((name (replace-regexp-in-string "[ *]" "" branch))
(str (helm-ls-git-log name (helm-aif helm-current-prefix-arg
(prefix-numeric-value it)))))
(when (buffer-live-p "*git log diff*")
(kill-buffer "*git log diff*"))
(helm :sources (helm-build-in-buffer-source "Git log"
:header-name (lambda (sname) (format "%s (%s)" sname name))
:data str
:get-line 'buffer-substring
:marked-with-props 'withprop
:help-message 'helm-ls-git-help-message
:action '(("Show commit" . helm-ls-git-log-show-commit)
("Find file at rev" . helm-ls-git-log-find-file)
("Kill rev as short hash" .
helm-ls-git-log-kill-short-hash)
("Kill rev as long hash" .
helm-ls-git-log-kill-long-hash)
("Kill rev as <branch~n>" .
helm-ls-git-log-kill-rev)
("Cherry-pick" . helm-ls-git-log-cherry-pick)
("Format patches" . helm-ls-git-log-format-patch)
("Git am" . helm-ls-git-log-am)
("Git interactive rebase" . helm-ls-git-log-interactive-rebase)
("Hard reset" . helm-ls-git-log-hard-reset)
("Soft reset" . helm-ls-git-log-soft-reset)
("Git revert" . helm-ls-git-log-revert))
:candidate-transformer
(lambda (candidates)
(cl-loop for c in candidates
for count from 0
for cand = (ansi-color-apply c)
collect (propertize
cand 'rev (if (zerop count)
name
(format "%s~%s" name count)))))
:group 'helm-ls-git)
:buffer "*helm-ls-git log*")))
(defun helm-ls-git-log-show-commit-1 (candidate)
(let ((sha (car (split-string candidate))))
(with-current-buffer (get-buffer-create "*git log diff*")
(let ((inhibit-read-only t))
(erase-buffer)
(insert (with-helm-default-directory (helm-ls-git-root-dir
(helm-default-directory))
(with-output-to-string
(with-current-buffer standard-output
(process-file
"git" nil (list t helm-ls-git-log-file) nil
"show" "-p" sha)))))
(goto-char (point-min))
(diff-mode))
(display-buffer (current-buffer)))))
(defun helm-ls-git-log-kill-short-hash (candidate)
(kill-new (car (split-string candidate))))
(defun helm-ls-git-log-kill-long-hash (_candidate)
(helm-ls-git-log-get-long-hash 'kill))
(defun helm-ls-git-log-get-long-hash (&optional kill)
(with-helm-buffer
(let (str)
(helm-aif (get-text-property
2 'rev
(helm-get-selection nil 'withprop))
(setq str
(replace-regexp-in-string
"\n" ""
(shell-command-to-string
(format "git rev-parse --default %s %s"
(replace-regexp-in-string
"~[0-9]+" "" it)
it)))))
(when str
(if kill (kill-new str) str)))))
(defun helm-ls-git-log-kill-rev (_candidate)
(helm-aif (get-text-property
2 'rev
(helm-get-selection nil 'withprop))
(kill-new it)))
(defun helm-ls-git-log-format-patch (_candidate)
(helm-ls-git-log-format-patch-1))
(defun helm-ls-git-log-am (_candidate)
(helm-ls-git-log-format-patch-1 'am))
(defun helm-ls-git-log-format-patch-1 (&optional am)
(let ((commits (cl-loop for c in (helm-marked-candidates)
collect (get-text-property 1 'rev c)))
range switches)
(cond ((= 2 (length commits))
;; Using "..." makes a range from top marked (included) to
;; bottom marked (not included) e.g. when we have commit-2
;; marked and commit-5 marked the serie of patches will be
;; 01-commit-4.patch, 02-commit-3.patch, 03-commit-2.patch,
;; git taking care of numering the patch in reversed order
;; for further apply.
(setq range (mapconcat 'identity (sort commits #'string-lessp) "...")
switches `("format-patch" ,range)))
((not (cdr commits))
(setq range (car commits)
switches `("format-patch" "-1" ,range)))
((> (length commits) 2)
(error "Specify either a single commit or a range with only two marked commits")))
(with-helm-default-directory (helm-ls-git-root-dir
(helm-default-directory))
(if am
(with-current-buffer-window "*git am*" '(display-buffer-below-selected
(window-height . fit-window-to-buffer)
(preserve-size . (nil . t)))
nil
(process-file-shell-command
(format "git %s | git am -3 -k"
(mapconcat 'identity (helm-append-at-nth switches '("-k --stdout") 1) " "))
nil t t))
(apply #'process-file "git" nil "*git format-patch*" nil switches)))))
(defun helm-ls-git-log-reset-1 (hard-or-soft)
(let ((rev (get-text-property 1 'rev (helm-get-selection nil 'withprop)))
(arg (cl-case hard-or-soft
(hard "--hard")
(soft "--soft"))))
(with-helm-default-directory (helm-ls-git-root-dir
(helm-default-directory))
(when (and (y-or-n-p (format "%s reset to <%s>?"
(capitalize (symbol-name hard-or-soft)) rev))
(= (process-file "git" nil nil nil "reset" arg rev) 0))
(message "Now at `%s'" (helm-ls-git-oneline-log
(helm-ls-git--branch)))))))
(defun helm-ls-git-log-hard-reset (_candidate)
(helm-ls-git-log-reset-1 'hard))
(defun helm-ls-git-log-soft-reset (_candidate)
(helm-ls-git-log-reset-1 'soft))
(defun helm-ls-git-log-revert (_candidate)
(let ((rev (get-text-property 1 'rev (helm-get-selection nil 'withprop))))
(helm-ls-git-with-editor "revert" rev)))
(defun helm-ls-git-log-revert-continue (_candidate)
(helm-ls-git-with-editor "revert" "--continue"))
(defun helm-ls-git-revert-abort (_candidate)
(with-helm-default-directory (helm-default-directory)
(process-file "git" nil nil nil "revert" "--abort")))
(defun helm-ls-git-log-show-commit (candidate)
(if (and (eq last-command 'helm-execute-persistent-action)
(get-buffer-window "*git log diff*" 'visible))
(kill-buffer "*git log diff*")
(helm-ls-git-log-show-commit-1 candidate)))
(defun helm-ls-git-log-find-file (_candidate)
(with-helm-default-directory (helm-default-directory)
(let* ((rev (get-text-property 1 'rev (helm-get-selection nil 'withprop)))
(file (helm :sources (helm-build-in-buffer-source "Git cat-file"
:data (helm-ls-git-list-files))
:buffer "*helm-ls-git cat-file*"))
(fname (concat rev ":" file))
(path (expand-file-name fname))
str status)
(setq str (with-output-to-string
(with-current-buffer standard-output
(setq status (process-file "git" nil t nil "cat-file" "-p" fname)))))
(if (zerop status)
(progn
(with-current-buffer (find-file-noselect path)
(insert str)
(save-buffer))
(find-file path))
(error "No such file %s at %s" file rev)))))
(defun helm-ls-git-log-cherry-pick (_candidate)
(let* ((commits (cl-loop for c in (helm-marked-candidates)
collect (get-text-property 1 'rev c) into revs
finally return (sort revs #'string-greaterp))))
(with-helm-default-directory (helm-ls-git-root-dir
(helm-default-directory))
(with-current-buffer-window "*git cherry-pick*" '(display-buffer-below-selected
(window-height . fit-window-to-buffer)
(preserve-size . (nil . t)))
nil
(apply #'process-file "git" nil "*git cherry-pick*" nil "cherry-pick" commits)))))
(defun helm-ls-git-cherry-pick-abort (_candidate)
(with-helm-default-directory (helm-default-directory)
(process-file "git" nil nil nil "cherry-pick" "--abort")))
(defun helm-ls-git-rebase-abort (_candidate)
(with-helm-default-directory (helm-default-directory)
(process-file "git" nil nil nil "rebase" "--abort")))
(defun helm-ls-git-merge-abort (_candidate)
(with-helm-default-directory (helm-default-directory)
(process-file "git" nil nil nil "merge" "--abort")))
(defun helm-ls-git-rebase-continue (_candidate)
(helm-ls-git-with-editor "rebase" "--continue"))
(defun helm-ls-git-cherry-pick-continue (_candidate)
(helm-ls-git-with-editor "cherry-pick" "--continue"))
(defun helm-ls-git-am-continue (_candidate)
(helm-ls-git-with-editor "am" "--continue"))
(defun helm-ls-git-merge-continue (_candidate)
(helm-ls-git-with-editor "merge" "--continue"))
(defun helm-ls-git-rebase-running-p ()
(with-helm-buffer
(with-helm-default-directory (helm-ls-git-root-dir)
(let ((git-dir (expand-file-name ".git" default-directory)))
(or (file-exists-p (expand-file-name "rebase-merge" git-dir))
(file-exists-p (expand-file-name "rebase-apply/onto" git-dir)))))))
(defun helm-ls-git-log-interactive-rebase (_candidate)
"Rebase interactively current branch from CANDIDATE.
Where CANDIDATE is a candidate from git log source and its commit
object will be passed git rebase i.e. git rebase -i <hash>."
(if (helm-ls-git-rebase-running-p)
(if (y-or-n-p "A rebase is already running, continue ?")
(helm-ls-git-rebase-continue nil)
(helm-ls-git-rebase-abort nil))
(let ((hash (helm-ls-git-log-get-long-hash)))
(helm-ls-git-with-editor "rebase" "-i" hash))))
(defun helm-ls-git-run-show-log ()
(interactive)
(with-helm-alive-p
(helm-exit-and-execute-action #'helm-ls-git-show-log)))
(put 'helm-ls-git-run-show-log 'no-helm-mx t)
;;; Git branch basic management
;;
(defvar helm-ls-git-branches-show-all nil)
(defun helm-ls-git-collect-branches (&optional arg)
(helm-aif (helm-ls-git-root-dir)
(with-helm-default-directory it
(with-output-to-string
(with-current-buffer standard-output
(cond ((null arg)
;; Only local branches.
(apply #'process-file "git" nil t nil '("branch")))
(t
(apply #'process-file "git" nil t nil '("branch" "-a")))))))
""))
(defun helm-ls-git-branches-toggle-show-all ()
(interactive)
(setq helm-ls-git-branches-show-all (not helm-ls-git-branches-show-all))
(helm-force-update))
(put 'helm-ls-git-branches-toggle-show-all 'no-helm-mx t)
(defun helm-ls-git-checkout (candidate)
(let ((default-directory (helm-default-directory)))
(if (and helm-ls-git-auto-checkout
(helm-ls-git-modified-p t))
(helm-ls-git-stash-1 "")
(cl-assert (not (helm-ls-git-modified-p t))
nil "Please commit or stash your changes before proceeding"))
(with-helm-default-directory (helm-ls-git-root-dir)
(let* ((branch (replace-regexp-in-string "[ ]" "" candidate))
(real (replace-regexp-in-string "\\`\\*" "" branch)))
(if (string-match "\\`[*]" candidate)
(message "Already on %s branch" real)
(let* ((switches (if (string-match "\\`[Rr]emotes" real)
`("checkout" "-b"
,(car (last (split-string real "/" t)))
"-t" ,real)
`("checkout" ,real)))
(status (apply #'process-file "git"
nil nil nil
switches)))
(if (= status 0)
(progn (message "Switched to %s branch" real)
(helm-ls-git-revert-buffers-in-project))
(error "Process exit with non zero status"))))))))
(defun helm-ls-git-branches-create (candidate)
(with-helm-default-directory (helm-ls-git-root-dir)
(process-file "git" nil nil nil
"checkout" "-B" candidate "-t" (helm-ls-git--branch))))
(defun helm-ls-git-branches-delete (candidate)
(with-helm-default-directory (helm-ls-git-root-dir)
(let* ((branch (helm-ls-git-normalize-branch-name candidate))
(remote (string-match "remotes/" candidate))
(switches (if remote
`("-D" "-r" ,branch)
`("-D" ,branch))))
(cl-assert (not (string-match "\\`[*]" candidate))
nil "Can't delete current branch")
(if (= (apply #'process-file "git" nil nil nil "branch" switches) 0)
(progn
(when (and remote
(or helm-ls-git-delete-branch-on-remote
(y-or-n-p (format "Delete `%s' branch on remote as well ?" branch))))
(let ((proc (start-file-process
"git" "*helm-ls-git branch delete*"
"git" "push" "origin" "--delete"
(car (last (split-string branch "/" t))))))
(set-process-sentinel
proc
(lambda (_process event)
(if (string= event "finished\n")
(message "Remote branch %s deleted successfully" branch)
(message "Failed to delete remote branch %s" branch))))))
(message "Local branch %s deleted successfully" branch))
(message "failed to delete branch %s" branch)))))
(defun helm-ls-git-normalize-branch-names (names)
(cl-loop for name in names collect
(helm-ls-git-normalize-branch-name name)))
(defun helm-ls-git-normalize-branch-name (name)
(helm-aand name
(replace-regexp-in-string " " "" it)
(replace-regexp-in-string "[*]" "" it)
(replace-regexp-in-string "remotes/" "" it)))
(defun helm-ls-git-delete-marked-branches (_candidate)
(let* ((branches (helm-marked-candidates))
(bnames (helm-ls-git-normalize-branch-names branches))
(display-buf "*helm-ls-git deleted branches*"))
(with-helm-display-marked-candidates
display-buf bnames
(when (y-or-n-p "Really delete branche(s) ?")
(cl-loop for b in branches
do (helm-ls-git-branches-delete b))))))
(defun helm-ls-git-modified-p (&optional ignore-untracked)
(with-helm-default-directory (helm-ls-git-root-dir)
(not (string= (helm-ls-git-status ignore-untracked) ""))))
(defun helm-ls-git-branches-merge (candidate)
(with-helm-default-directory (helm-ls-git-root-dir)
(let ((branch (replace-regexp-in-string "[ ]" "" candidate))
(current (helm-ls-git--branch)))
(when (y-or-n-p (format "Merge branch %s into %s?" branch current))
(if (= (process-file "git" nil nil nil "merge" branch) 0)
(progn (message "Branch %s merged successfully into %s" branch current)
(helm-ls-git-revert-buffers-in-project))
(message "failed to merge branch %s" branch))))))
(defvar helm-ls-git-create-branch-source
(helm-build-dummy-source "Create branch"
:filtered-candidate-transformer
(lambda (_candidates _source)
(list (or (and (not (string= helm-pattern ""))
helm-pattern)
"Enter new branch name")))
:action 'helm-ls-git-branches-create))
(defun helm-ls-git-oneline-log (branch)
(let ((output (with-output-to-string
(with-current-buffer standard-output
(process-file
"git" nil t nil
"log" (car (split-string branch "->"))
"-n" "1" "--oneline")))))
(replace-regexp-in-string "\n" "" output)))
(defun helm-ls-git-branches-transformer (candidates)
(cl-loop for c in candidates
for maxlen = (cl-loop for i in candidates maximize (length i))
for name = (replace-regexp-in-string "[ *]" "" c)
for log = (helm-ls-git-oneline-log name)
for disp = (if (string-match "\\`\\([*]\\)\\(.*\\)" c)
(format "%s%s: %s%s"
(propertize (match-string 1 c)
'face 'helm-ls-git-branches-current)
(propertize (match-string 2 c)
'face 'helm-ls-git-branches-name)
(make-string (- maxlen (length c)) ? )
log)
(format "%s: %s%s"
(propertize c 'face 'helm-ls-git-branches-name)
(make-string (- maxlen (length c)) ? )
log))
collect (cons disp c)))
(defun helm-ls-git-push (_candidate)
(with-helm-default-directory (helm-default-directory)
(message "Pushing changes on remote...")
(let ((proc (start-file-process
"git" "*helm-ls-git push*" "git" "push" "origin" "HEAD")))
(set-process-sentinel
proc (lambda (_process event)
(if (string= event "finished\n")
(message "Pushing changes on remote done")
(error "Failed to push on remote")))))))
(defun helm-ls-git-run-push ()
(interactive)
(with-helm-alive-p
(when (y-or-n-p "Push on remote ?")
(helm-exit-and-execute-action #'helm-ls-git-push))))
(put 'helm-ls-git-run-push 'no-helm-mx t)
(defun helm-ls-git-remotes ()
(with-helm-default-directory (helm-default-directory)
(with-output-to-string
(with-current-buffer standard-output
(process-file "git" nil t nil "remote")))))
(defun helm-ls-git--pull-or-fetch (command &rest args)
(with-helm-default-directory (helm-default-directory)
(let* ((remote "origin")
(pcommand (capitalize command))
;; A `C-g' in helm-comp-read will quit function as well.
(switches (if current-prefix-arg
(append (list command)
args
(list (setq remote
(helm-comp-read
(format "%s from: " pcommand)
(split-string
(helm-ls-git-remotes)
"\n")
:allow-nest t)))
(list (helm-ls-git--branch)))
(append (list command) args)))
process-connection-type
proc)
(setq proc (apply #'helm-ls-git-with-editor switches))
(with-current-buffer (process-buffer proc) (erase-buffer))
(message "%sing from `%s'..." pcommand remote)
(set-process-filter proc 'helm-ls-git--filter-process)
(save-selected-window
(display-buffer (process-buffer proc)))
(set-process-sentinel
proc (lambda (_process event)
(if (string= event "finished\n")
(progn (message "%sing from %s done" pcommand remote)
(when helm-alive-p
(with-helm-window (helm-force-update "^\\*"))))
(error "Failed %sing from %s" command remote)))))))
(defun helm-ls-git--filter-process (proc string)
(when (buffer-live-p (process-buffer proc))
(with-current-buffer (process-buffer proc)
(let ((moving (= (point) (process-mark proc))))
(save-excursion
;; Insert the text, advancing the process marker.
(goto-char (process-mark proc))
;; Ignore git progress reporter lines.
(unless (string-match-p "
\\'" string)
(insert string))
(set-marker (process-mark proc) (point)))
(when moving
(goto-char (process-mark proc)))))))
(defun helm-ls-git-pull (_candidate)
(helm-ls-git--pull-or-fetch "pull" "--stat"))
(defun helm-ls-git-fetch (_candidate)
(helm-ls-git--pull-or-fetch "fetch"))
(defun helm-ls-git-run-pull ()
(interactive)
(with-helm-alive-p
(helm-set-attr 'pull 'helm-ls-git-pull)
(helm-execute-persistent-action 'pull)))
(put 'helm-ls-git-run-pull 'no-helm-mx t)
(defun helm-ls-git-run-fetch ()
(interactive)
(with-helm-alive-p
(helm-set-attr 'fetch '(helm-ls-git-fetch . never-split))
(helm-execute-persistent-action 'fetch)))
(put 'helm-ls-git-run-fetch 'no-helm-mx t)
(defun helm-ls-git-branch-rebase (candidate)
"Rebase CANDIDATE branch on current branch."
(if (helm-ls-git-rebase-running-p)
(if (y-or-n-p "A rebase is already running, continue ?")
(helm-ls-git-rebase-continue nil)
(helm-ls-git-rebase-abort nil))
(let ((branch (helm-ls-git-normalize-branch-name candidate))
(current (helm-ls-git--branch)))
(when (y-or-n-p (format "Rebase branch %s from %s?" current branch))
(if (= (process-file "git" nil nil nil "rebase" branch) 0)
(progn (message "Branch %s rebased successfully from %s" current branch)
(helm-ls-git-revert-buffers-in-project))
(message "failed to rebase from branch %s, try to abort rebasing or resolve conflicts" branch))))))
(defvar helm-ls-git-branches-source
(helm-build-in-buffer-source "Git branches"
:init (lambda ()
(let ((data (helm-ls-git-collect-branches
helm-ls-git-branches-show-all)))
(helm-init-candidates-in-buffer 'global data)))
:candidate-transformer 'helm-ls-git-branches-transformer
:action-transformer (lambda (actions candidate)
(if (not (string-match "\\`[*]" candidate))
(append
'(("Checkout" . helm-ls-git-checkout)
("Delete branche(s)" . helm-ls-git-delete-marked-branches)
("Merge in current" .
helm-ls-git-branches-merge)
("Rebase in current" .
helm-ls-git-branch-rebase))
actions)
(helm-append-at-nth
actions
'(("Git amend" . helm-ls-git-amend-commit)
("Git push (C-c P)" . helm-ls-git-push))
2)))
:help-message 'helm-ls-git-help-message
:cleanup (lambda () (setq helm-ls-git-branches-show-all nil))
:persistent-help "Checkout"
:persistent-action (lambda (candidate)
(helm-ls-git-checkout candidate)
(helm-force-update "^\\*"))
:action '(("Git status" . (lambda (_candidate)
(funcall helm-ls-git-status-command
(helm-default-directory))))
("Git log (M-L)" . helm-ls-git-show-log)
("Switch to shell" . helm-ls-git-switch-to-shell))
:keymap 'helm-ls-git-branches-map
:group 'helm-ls-git))
;;; Stashing
;;
(defun helm-ls-git-list-stashes ()
(helm-aif (helm-ls-git-root-dir)
(with-helm-default-directory it
(with-output-to-string
(with-current-buffer standard-output
(apply #'process-file
"git"
nil (list t helm-ls-git-log-file) nil
(list "stash" "list")))))))
(defun helm-ls-git-get-stash-name (candidate)
(when (string-match "stash@[{][0-9]+[}]" candidate)
(match-string 0 candidate)))
(defun helm-ls-git-stash-show (candidate)
(if (and (eq last-command 'helm-execute-persistent-action)
(get-buffer-window "*stash diff*" 'visible))
(kill-buffer "*stash diff*")
(let ((stash (helm-ls-git-get-stash-name candidate)))
(with-current-buffer (get-buffer-create "*stash diff*")
(let ((inhibit-read-only t))
(erase-buffer)
(insert (with-helm-default-directory (helm-ls-git-root-dir)
(with-output-to-string
(with-current-buffer standard-output
(process-file
"git" nil (list t helm-ls-git-log-file) nil
"stash" "show" "-p" stash)))))
(diff-mode))
(display-buffer (current-buffer))))))
(defun helm-ls-git-stash-apply (candidate)
(let ((num (helm-ls-git-get-stash-name candidate)))
(if (eq (process-file "git" nil nil nil "stash" "apply" num) 0)
(progn
(helm-ls-git-revert-buffers-in-project)
(message "Stash <%s> applied" candidate))
(error "Couldn't apply stash <%s>" candidate))))
(defun helm-ls-git-stash-pop (candidate)
(let ((num (helm-ls-git-get-stash-name candidate)))
(if (eq (process-file "git" nil nil nil "stash" "pop" num) 0)
(progn
(helm-ls-git-revert-buffers-in-project)
(message "Stashed pop <%s>" candidate))
(error "Couldn't stash pop <%s>" candidate))))
(defun helm-ls-git-stash-1 (name)
(with-helm-default-directory (helm-ls-git-root-dir)
(apply #'process-file "git" nil nil nil `("stash" "push" "-m" ,name))
(helm-ls-git-revert-buffers-in-project)))
(defun helm-ls-git-stash (_candidate)
(let ((name (read-string "Stash name: ")))
(helm-ls-git-stash-1 name)))
(defun helm-ls-git-run-stash ()
(interactive)
(with-helm-alive-p
(helm-exit-and-execute-action 'helm-ls-git-stash)))
(put 'helm-ls-git-run-stash 'no-helm-mx t)
(defun helm-ls-git-stash-snapshot (_candidate)
(vc-git-stash-snapshot))
(defun helm-ls-git-run-stash-snapshot ()
(interactive)
(with-helm-alive-p
(helm-exit-and-execute-action 'helm-ls-git-stash-snapshot)))
(put 'helm-ls-git-run-stash-snapshot 'no-helm-mx t)
(defun helm-ls-git-stash-drop (candidate)
(let ((num (helm-ls-git-get-stash-name candidate)))
(if (eq (process-file "git" nil nil nil "stash" "drop" num) 0)
(message "Stash <%s> deleted" candidate)
(error "Couldn't delete <%s>" candidate))))
(defun helm-ls-git-stash-drop-marked (_candidate)
(let ((mkd (helm-marked-candidates)))
(cl-loop with sorted =
(sort mkd (lambda (s1 s2)
(let ((n1 (and (string-match
"^stash@[{]\\([0-9]+\\)[}]" s1)
(match-string 1 s1)))
(n2 (and (string-match
"^stash@[{]\\([0-9]+\\)[}]" s2)
(match-string 1 s2))))
(string-greaterp n1 n2))))
for c in sorted do (helm-ls-git-stash-drop c))))
(defun helm-ls-git-apply-patch (_candidate)
(with-helm-default-directory (helm-default-directory)
(let ((patchs (helm-marked-candidates)))
(with-current-buffer-window "*git apply*" '(display-buffer-below-selected
(window-height . fit-window-to-buffer)
(preserve-size . (nil . t)))
nil
(apply #'process-file "git" nil t t "apply" patchs)
(helm-ls-git-revert-buffers-in-project)))))
(defvar helm-ls-git-stashes-source
(helm-build-in-buffer-source "Stashes"
:data 'helm-ls-git-list-stashes
:persistent-action 'helm-ls-git-stash-show
:action '(("Apply stash" . helm-ls-git-stash-apply)
("Pop stash" . helm-ls-git-stash-pop)
("Drop stashe(s)" . helm-ls-git-stash-drop-marked))
:group 'helm-ls-git))
;;; Git status
(defun helm-ls-git-status (&optional ignore-untracked)
(when (and helm-ls-git-log-file
(file-exists-p helm-ls-git-log-file))
(delete-file helm-ls-git-log-file))
(helm-aif (helm-ls-git-root-dir)
(with-helm-default-directory it
(with-output-to-string
(with-current-buffer standard-output
(apply #'process-file
"git"
nil (list t helm-ls-git-log-file) nil
(if ignore-untracked
(list "status" "-uno" "--porcelain")
(list "status" "--porcelain"))))))))
(defun helm-ls-git-status-transformer (candidates _source)
(cl-loop with root = (helm-ls-git-root-dir)
for i in candidates
collect
(cond ((string-match "^\\( M \\)\\(.*\\)" i) ; modified.
(cons (propertize i 'face 'helm-ls-git-modified-not-staged-face)
(expand-file-name (match-string 2 i) root)))
((string-match "^\\(M+ *\\)\\(.*\\)" i) ; modified and staged.
(cons (propertize i 'face 'helm-ls-git-modified-and-staged-face)
(expand-file-name (match-string 2 i) root)))
((string-match "^\\([?]\\{2\\} \\)\\(.*\\)" i)
(cons (propertize i 'face 'helm-ls-git-untracked-face)
(expand-file-name (match-string 2 i) root)))
((string-match "^\\([AC] +\\)\\(.*\\)" i)
(cons (propertize i 'face 'helm-ls-git-added-copied-face)
(expand-file-name (match-string 2 i) root)))
((string-match "^\\( [D] \\)\\(.*\\)" i)
(cons (propertize i 'face 'helm-ls-git-deleted-not-staged-face)
(expand-file-name (match-string 2 i) root)))
((string-match "^\\(RM?\\).* -> \\(.*\\)" i)
(cons (propertize i 'face 'helm-ls-git-renamed-modified-face)
(expand-file-name (match-string 2 i) root)))
((string-match "^\\([D] +\\)\\(.*\\)" i)
(cons (propertize i 'face 'helm-ls-git-deleted-and-staged-face)
(expand-file-name (match-string 2 i) root)))
((string-match "^\\(UU \\)\\(.*\\)" i)
(cons (propertize i 'face 'helm-ls-git-conflict-face)
(expand-file-name (match-string 2 i) root)))
((string-match "^\\(AM \\)\\(.*\\)" i)
(cons (propertize i 'face 'helm-ls-git-added-modified-face)
(expand-file-name (match-string 2 i) root)))
(t i))))
(defun helm-ls-git-status-action-transformer (actions _candidate)
(let ((disp (helm-get-selection nil t))
(mofified-actions
(helm-make-actions "Diff file" 'helm-ls-git-diff
"Revert file(s)"
(lambda (_candidate)
(let ((marked (helm-marked-candidates)))
(cl-loop for f in marked do
(progn
(vc-git-revert f)
(helm-aif (get-file-buffer f)
(with-current-buffer it
(revert-buffer t t)))))))
"Copy file(s) `C-u to follow'" 'helm-find-files-copy
"Rename file(s) `C-u to follow'" 'helm-find-files-rename)))
;; Unregistered files
(cond ((string-match "^[?]\\{2\\}" disp)
(append actions
(helm-make-actions "Add file(s)"
(lambda (candidate)
(let ((default-directory
(file-name-directory candidate))
(marked (helm-marked-candidates)))
(vc-call-backend 'Git 'register marked)))
"Delete file(s)"
'helm-ff-delete-files
(lambda ()
(and (string-match "\\`[?]\\{2\\}.*\\.patch\\|diff" disp)
"Apply patch"))
'helm-ls-git-apply-patch
(lambda ()
(and (string-match "\\`[?]\\{2\\}.*\\.patch" disp)
"Git AM patches"))
'helm-ls-git-am-files
"Copy bnames to .gitignore"
(lambda (candidate)
(let ((default-directory
(file-name-directory candidate))
(marked (helm-marked-candidates)))
(with-current-buffer (find-file-noselect
(expand-file-name
".gitignore"
(helm-ls-git-root-dir)))
(goto-char (point-max))
(cl-loop with last-bname
for f in marked
for bname = (helm-basename f)
unless (string= bname last-bname)
do (insert (concat bname "\n"))
do (setq last-bname bname))
(save-buffer)))))))
((string-match "^A " disp)
(append actions '(("Commit staged file(s)"
. helm-ls-git-commit)
("Extend commit"
. helm-ls-git-extend-commit)
("Amend commit"
. helm-ls-git-amend-commit)
("Unstage file(s)"
. helm-ls-git-unstage-files))))
;; Modified but not staged
((string-match "^ M+ *" disp)
(append actions (helm-append-at-nth
mofified-actions
'(("Stage file(s) (C-c s)"
. helm-ls-git-stage-files)
("Stage marked file(s) and commit (C-c c)"
. helm-ls-git-stage-marked-and-commit)
("Stage marked file(s) and extend commit (C-c e)"
. helm-ls-git-stage-marked-and-extend-commit)
("Stage marked file(s) and amend commit (C-c a)"
. helm-ls-git-stage-marked-and-amend-commit)
("Stash (C-c z)" . helm-ls-git-stash)
("Stash snapshot (C-c Z)" . helm-ls-git-stash-snapshot))
1)))
;; Modified and staged
((string-match "^M+ +" disp)
(append actions (helm-append-at-nth
mofified-actions
'(("Commit staged file(s)"
. helm-ls-git-commit)
("Extend commit"
. helm-ls-git-extend-commit)
("Amend commit"
. helm-ls-git-amend-commit)
("Unstage file(s)"
. helm-ls-git-unstage-files)
("Git rebase continue" .
helm-ls-git-rebase-continue)
("Git cherry-pick continue" .
helm-ls-git-cherry-pick-continue)
("Git AM continue" .
helm-ls-git-am-continue)
("Git merge continue" .
helm-ls-git-merge-continue)
("Git revert continue" .
helm-ls-git-log-revert-continue))
1)))
;; Deleted
((string-match "^ D " disp)
(append actions (list '("Git delete" . (lambda (_candidate)
(let ((mkd (helm-marked-candidates)))
(cl-loop for c in mkd
do (helm-ls-git-rm c)))))
'("Stage file(s)"
. helm-ls-git-stage-files))))
;; Deleted and staged
((string-match "^D +" disp)
(append actions (list '("Commit staged file(s)"
. helm-ls-git-commit)
'("Stage marked file(s) and commit"
. helm-ls-git-stage-marked-and-commit))))
;; Conflict
((string-match "^U+ +" disp)
(append actions (list '("Git cherry-pick abort" . helm-ls-git-cherry-pick-abort)
'("Git rebase abort" . helm-ls-git-rebase-abort)
'("Git AM abort" . helm-ls-git-am-abort)
'("Git merge abort" . helm-ls-git-merge-abort)
'("Git revert abort" . helm-ls-git-log-revert-abort))))
(t actions))))
(defun helm-ls-git-am-files (_candidate)
(let ((files (helm-marked-candidates)))
(cl-assert (cl-loop for f in files
for ext = (file-name-extension f)
always (and ext (string= ext "patch"))))
(with-current-buffer-window "*git am*" '(display-buffer-below-selected
(window-height . fit-window-to-buffer)
(preserve-size . (nil . t)))
nil
(apply #'process-file "git" nil t nil "am" files))))
(defun helm-ls-git-am-abort (_candidate)
(with-helm-default-directory (helm-default-directory)
(process-file "git" nil nil nil "am" "--abort")))
(defun helm-ls-git-rm (_candidate)
(with-helm-default-directory (helm-default-directory)
(let ((files (helm-marked-candidates)))
(apply #'process-file "git" nil nil nil "rm" files))))
(defun helm-ls-git-switch-to-shell (_candidate)
(let ((helm-ff-default-directory
(helm-ls-git-root-dir)))
(helm-ff-switch-to-shell nil)))
(defun helm-ls-git-run-switch-to-shell ()
(interactive)
(with-helm-alive-p
(helm-exit-and-execute-action 'helm-ls-git-switch-to-shell)))
(put 'helm-ls-git-run-switch-to-shell 'no-helm-mx t)
;;; Stage and commit
;;
(defun helm-ls-git-stage-files (_candidate)
"Stage marked files."
(let* ((files (helm-marked-candidates))
(default-directory (helm-default-directory)))
(apply #'process-file "git" nil nil nil "stage" files)))
(defun helm-ls-git-run-stage-files (arg)
(interactive "P")
(with-helm-alive-p
(helm-exit-and-execute-action (if arg
'helm-ls-git-unstage-files
'helm-ls-git-stage-files))))
(put 'helm-ls-git-run-stage-files 'no-helm-mx t)
(defun helm-ls-git-unstage-files (_candidate)
"Unstage marked files."
(let* ((files (helm-marked-candidates))
(default-directory (file-name-directory (car files))))
(apply #'process-file "git" nil nil nil "reset" "HEAD" "--" files)))
(defun helm-ls-git-stage-marked-and-commit (_candidate)
"Stage marked files and commit."
(helm-ls-git-stage-files nil)
(let ((proc (helm-ls-git-with-editor "commit" "-v")))
(set-process-sentinel proc 'helm-ls-git-commit-sentinel)))
(defun helm-ls-git-commit-sentinel (process event)
(let ((default-directory (with-current-buffer (process-buffer process)
default-directory)))
(when (string= event "finished\n")
(let ((commit (helm-ls-git-oneline-log (helm-ls-git--branch))))
(when (string-match "\\`\\([^ ]+\\)+ +\\(.*\\)" commit)
(add-face-text-property 0 (match-end 1)
'font-lock-type-face nil commit)
(add-face-text-property (1+ (match-end 1))
(match-end 2)
'font-lock-function-name-face nil commit))
(message "Commit done, now at `%s'" commit)))))
(defun helm-ls-git-run-stage-marked-and-commit ()
(interactive)
(with-helm-alive-p
(helm-exit-and-execute-action 'helm-ls-git-stage-marked-and-commit)))
(put 'helm-ls-git-run-stage-marked-and-commit 'no-helm-mx t)
(defun helm-ls-git-stage-marked-and-extend-commit (candidate)
"Stage marked files and extend these changes to last commit"
(helm-ls-git-stage-files nil)
(helm-ls-git-extend-commit candidate))
(defun helm-ls-git-run-stage-marked-and-extend-commit ()
(interactive)
(with-helm-alive-p
(helm-exit-and-execute-action 'helm-ls-git-stage-marked-and-extend-commit)))
(put 'helm-ls-git-run-stage-marked-and-extend-commit 'no-helm-mx t)
(defun helm-ls-git-stage-marked-and-amend-commit (candidate)
"Stage marked files and amend last commit."
(helm-ls-git-stage-files nil)
(helm-ls-git-amend-commit candidate))
(defun helm-ls-git-run-stage-marked-and-amend-commit ()
(interactive)
(with-helm-alive-p
(helm-exit-and-execute-action 'helm-ls-git-stage-marked-and-amend-commit)))
(put 'helm-ls-git-run-stage-marked-and-amend-commit 'no-helm-mx t)
(defun helm-ls-git-extend-commit (candidate)
(let ((default-directory (file-name-directory candidate)))
(process-file "git" nil nil nil "commit" "--amend" "--no-edit")))
(defun helm-ls-git-amend-commit (_candidate)
"Amend last commit."
(let ((proc (helm-ls-git-with-editor "commit" "-v" "--amend")))
(set-process-sentinel proc 'helm-ls-git-commit-sentinel)))
(defun helm-ls-git-commit (_candidate)
"Commit already staged files."
(let ((proc (helm-ls-git-with-editor "commit" "-v")))
(set-process-sentinel proc 'helm-ls-git-commit-sentinel)))
;;; Emacsclient as git editor
;;
;;;###autoload
(add-to-list 'auto-mode-alist '("/COMMIT_EDITMSG$" . helm-ls-git-commit-mode))
(defun helm-ls-git-with-editor (&rest args)
"Binds GIT_EDITOR env var to emacsclient and run git with ARGS.
Bound `default-directory' to the root dir of project determining value
from the helm-buffer, so don't use this function outside of helm
context i.e. use it in helm actions."
(require 'server)
(let ((default-directory (expand-file-name
(helm-ls-git-root-dir
(helm-default-directory))))
(process-environment process-environment)
(bname (format "*helm-ls-git %s*" (car args))))
;; It seems git once it knows GIT_EDITOR reuse the same value
;; along its whole process e.g. when squashing in a rebase
;; process, so even if the env setting goes away after initial
;; process, git should reuse same GIT_EDITOR in subsequent
;; commits.
(when (get-buffer bname) (kill-buffer bname))
(push "GIT_EDITOR=emacsclient $@" process-environment)
(unless (server-running-p)
(server-start))
(apply #'start-file-process "git" bname "git" args)))
(defun helm-ls-git-server-edit ()
(interactive)
(cl-assert server-clients nil "No server editing buffers exist")
;; Prevent server asking to save file when done.
(helm-aif buffer-file-name
(save-buffer it))
(server-edit))
;; Same as `server-edit-abort' from emacs-28 but kill edit buffer as well.
(defun helm-ls-git-server-edit-abort ()
"Abort editing the current client buffer."
(interactive)
(if server-clients
(progn
(mapc (lambda (proc)
(server-send-string
proc (concat "-error "
(server-quote-arg "Aborted by the user"))))
server-clients)
(kill-buffer))
(message "This buffer has no clients")))
(defvar helm-ls-git-commit-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "C-c C-c") 'helm-ls-git-server-edit)
(define-key map (kbd "C-c C-k") 'helm-ls-git-server-edit-abort)
map))
;;;###autoload
(define-derived-mode helm-ls-git-commit-mode diff-mode "helm-ls-git-commit"
"Mode to edit COMMIT_EDITMSG files.
Commands:
\\{helm-ls-git-commit-mode-map}
"
(helm-ls-git-with-editor-setup))
(defun helm-ls-git-with-editor-setup ()
(setq fill-column 70)
;; For some reasons, using (setq buffer-read-only nil) in emacs-29
;; doesn't work anymore.
(read-only-mode -1)
(set (make-local-variable 'comment-start) "#")
(set (make-local-variable 'comment-end) "")
(auto-fill-mode 1)
(run-at-time
0.1 nil
(lambda ()
(message
"When done with a buffer, type `C-c C-c', to abort type `C-c C-k'"))))
;;; Git rebase
;;
;;;###autoload
(add-to-list 'auto-mode-alist '("/git-rebase-todo$" . helm-ls-git-rebase-todo-mode))
(defconst helm-ls-git-rebase-actions
'(("p" . "pick")
("r" . "reword")
("e" . "edit")
("s" . "squash")
("f" . "fixup")
("x" . "exec")
("d" . "drop")))
(defvar helm-ls-git-rebase-todo-font-lock-keywords
'(("^\\([a-z]+\\) \\([0-9a-f]+\\) \\(.*\\)$"
(1 'font-lock-keyword-face)
(2 'font-lock-function-name-face))
("^#.*$" . 'font-lock-comment-face))
"Keywords in `helm-ls-git-rebase-todo' mode.")
(defvar helm-ls-git-rebase-todo-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "M-n") 'helm-ls-git-rebase-todo-move-down)
(define-key map (kbd "M-p") 'helm-ls-git-rebase-todo-move-up)
(define-key map (kbd "C-c C-c") 'helm-ls-git-server-edit)
(define-key map (kbd "C-c C-k") 'helm-ls-git-server-edit-abort)
map)
"Keymap used in `helm-ls-git-rebase-todo-mode' buffers.")
(defun helm-ls-git-rebase-todo-move-down ()
"Move commit line one line down."
(interactive)
(beginning-of-line)
(let* ((next (+ 1 (line-end-position)))
(line (buffer-substring (point) next)))
(delete-region (point) next)
(forward-line 1)
(insert line)
(forward-line -1)))
(defun helm-ls-git-rebase-todo-move-up ()
"Move commit line on line up."
(interactive)
(beginning-of-line)
(let* ((next (+ 1 (line-end-position)))
(line (buffer-substring (point) next)))
(delete-region (point) next)
(forward-line -1)
(insert line)
(forward-line -1)))
(defun helm-ls-git-rebase-action (action)
"Replace the current rebase command at bol by ACTION.
ACTION is the cdr entry of one of `helm-ls-git-rebase-actions'."
(let* ((assocs helm-ls-git-rebase-actions)
(regexp (cl-loop with len = (length assocs)
for (_k . v) in assocs
for count from 1 to len
concat (concat v (if (= count len) "" "\\|")) into str
finally return (concat "^\\(" str "\\) +")))
(inhibit-read-only t))
(goto-char (point-at-bol))
(save-excursion
(when (re-search-forward regexp (point-at-eol) t)
(delete-region (point-at-bol) (match-end 1))))
(insert (cdr (rassoc action assocs)))
(forward-line 1)))
(cl-defun helm-ls-git-rebase-build-commands ()
"build a function for each `helm-ls-git-rebase-actions' entry.
Bind it to the car of each entry of `helm-ls-git-rebase-actions'."
(cl-loop for (k . v) in helm-ls-git-rebase-actions
for sym = (intern (concat "helm-ls-git-rebase-" v))
for doc = (format "Replace current rebase command at bol by `%s'." v)
do (progn
(defalias sym `(lambda () (interactive)
(helm-ls-git-rebase-action ,v))
doc)
(define-key helm-ls-git-rebase-todo-mode-map (kbd k) sym))))
;;;###autoload
(define-derived-mode helm-ls-git-rebase-todo-mode fundamental-mode "helm-ls-git-rebase-todo"
"Major Mode to edit git-rebase-todo files when using git rebase -i.
Commands:
\\{helm-ls-git-rebase-todo-mode-map}
"
(set (make-local-variable 'font-lock-defaults)
'(helm-ls-git-rebase-todo-font-lock-keywords t))
(helm-ls-git-rebase-build-commands)
(set (make-local-variable 'comment-start) "#")
(set (make-local-variable 'comment-end) "")
(run-at-time
0.1 nil
(lambda ()
(message
"When done with a buffer, type `C-c C-c', to abort type `C-c C-k'"))))
;;; Build sources
;;
;; Overhide the actions of helm-type-buffer.
(cl-defmethod helm--setup-source :after ((source helm-source-buffers))
(let ((name (slot-value source 'name)))
(when (string= name "Buffers in git project")
(setf (slot-value source 'action)
(helm-append-at-nth
helm-type-buffer-actions
(helm-make-actions "Git status"
(lambda (_candidate)
(funcall helm-ls-git-status-command
(helm-default-directory))))
1)))))
(defun helm-ls-git-build-git-status-source ()
"Build `helm-source-ls-git-status'.
Do nothing when `helm-source-ls-git-status' is not member of
`helm-ls-git-default-sources'."
(and (memq 'helm-source-ls-git-status helm-ls-git-default-sources)
(helm-make-source "Git status" 'helm-ls-git-status-source
:fuzzy-match helm-ls-git-fuzzy-match
:group 'helm-ls-git)))
(defun helm-ls-git-build-ls-git-source ()
"Build `helm-source-ls-git'.
Do nothing when `helm-source-ls-git' is not member of
`helm-ls-git-default-sources'."
(and (memq 'helm-source-ls-git helm-ls-git-default-sources)
(helm-make-source "Git files" 'helm-ls-git-source
:fuzzy-match helm-ls-git-fuzzy-match
:action (helm-ls-git-actions-list helm-type-file-actions)
:group 'helm-ls-git)))
(defun helm-ls-git-build-buffers-source ()
"Build `helm-source-ls-git-buffers'.
Do nothing when `helm-source-ls-git-buffers' is not member of
`helm-ls-git-default-sources'."
(and (memq 'helm-source-ls-git-buffers helm-ls-git-default-sources)
(helm-make-source "Buffers in git project" 'helm-source-buffers
:header-name #'helm-ls-git-header-name
:buffer-list (lambda () (helm-browse-project-get-buffers
(helm-ls-git-root-dir)))
:keymap 'helm-ls-git-buffer-map)))
;;;###autoload
(defun helm-ls-git (&optional arg)
(interactive "p")
(let ((helm-ff-default-directory
(or helm-ff-default-directory
default-directory)))
(when (and arg (helm-ls-git-not-inside-git-repo))
(error "Not inside a Git repository"))
(unless (cl-loop for s in helm-ls-git-default-sources
always (symbol-value s))
(setq helm-source-ls-git-status
(helm-ls-git-build-git-status-source)
helm-source-ls-git
(helm-ls-git-build-ls-git-source)
helm-source-ls-git-buffers
(helm-ls-git-build-buffers-source)))
(helm-set-local-variable 'helm-ls-git--current-branch (helm-ls-git--branch))
(helm :sources helm-ls-git-default-sources
:ff-transformer-show-only-basename nil
:truncate-lines helm-buffers-truncate-lines
:buffer "*helm lsgit*")))
(defalias 'helm-ls-git-ls 'helm-ls-git)
(make-obsolete 'helm-ls-git-ls 'helm-ls-git "1.9.2")
(put 'helm-ls-git-ls 'no-helm-mx t)
(provide 'helm-ls-git)
;;; helm-ls-git.el ends here
Reference in New Issue View Git Blame Copy Permalink