|
|
@@ -1837,209 +1837,8 @@ and search from projectile root (if projectile is available)." |
|
|
|
|
|
|
|
|
|
|
|
(define-key ctl-x-map (kbd "C-r") 'recently-show) |
|
|
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
|
|
|
;; git-worktree |
|
|
|
|
|
|
|
(defun git-worktree-get-current-trees () |
|
|
|
"Get current worktree list." |
|
|
|
(with-temp-buffer |
|
|
|
(git-worktree--call-process "worktree" "list" "--porcelain") |
|
|
|
(goto-char (point-min)) |
|
|
|
(let ((trees nil)) |
|
|
|
(save-match-data |
|
|
|
(while (not (eq (point) (point-max))) |
|
|
|
(let ((worktree nil) |
|
|
|
(head nil) |
|
|
|
(branch nil) |
|
|
|
(bare nil)) |
|
|
|
(while (or (re-search-forward "^\\([^ ]+\\) \\(.*\\)$" (point-at-eol) t) |
|
|
|
(re-search-forward "^\\([^ ]+\\)$" (point-at-eol) t)) |
|
|
|
(pcase (match-string 1) |
|
|
|
("worktree" (setq worktree (match-string 2))) |
|
|
|
("HEAD" (setq head (match-string 2))) |
|
|
|
("branch" (setq branch (match-string 2))) |
|
|
|
("bare" (setq bare t)) |
|
|
|
) |
|
|
|
(forward-line 1) |
|
|
|
(goto-char (point-at-bol))) |
|
|
|
(setq trees `(,@trees |
|
|
|
( |
|
|
|
:worktree ,worktree |
|
|
|
:head ,head |
|
|
|
:branch ,branch |
|
|
|
:bare ,bare |
|
|
|
))) |
|
|
|
(forward-line 1) |
|
|
|
(goto-char (point-at-bol))) |
|
|
|
)) |
|
|
|
trees))) |
|
|
|
|
|
|
|
(defun git-worktree--call-process (&rest args) |
|
|
|
"Start git process synchronously with ARGS. |
|
|
|
|
|
|
|
Raise error when git process ends with non-zero status. |
|
|
|
Any output will be written to current buffer." |
|
|
|
(let ((status (apply 'call-process |
|
|
|
"git" |
|
|
|
nil |
|
|
|
t |
|
|
|
nil |
|
|
|
args))) |
|
|
|
(cl-assert (eq status 0) |
|
|
|
nil |
|
|
|
(buffer-substring-no-properties (point-min) (point-max))))) |
|
|
|
|
|
|
|
(defun git-worktree--get-repository-root (dir) |
|
|
|
"Resolve repository root of DIR. |
|
|
|
|
|
|
|
If DIR is not inside of any git repository, signal an error." |
|
|
|
(cl-assert (file-directory-p dir)) |
|
|
|
(with-temp-buffer |
|
|
|
(cd dir) |
|
|
|
(git-worktree--call-process "rev-parse" "--show-toplevel") |
|
|
|
(goto-char (point-min)) |
|
|
|
(buffer-substring-no-properties (point-at-bol) (point-at-eol)))) |
|
|
|
;;(git-worktree--get-repository-root default-directory) |
|
|
|
|
|
|
|
(defun git-worktree-open-noselect (&optional directory) |
|
|
|
"Open git worktree list buffer. |
|
|
|
|
|
|
|
If optional arg DIRECTORY is given change current directory to there before |
|
|
|
initializing." |
|
|
|
(setq directory (expand-file-name (or directory |
|
|
|
default-directory))) |
|
|
|
(cl-assert (file-directory-p directory)) |
|
|
|
(let* ((root (git-worktree--get-repository-root directory)) |
|
|
|
(name (file-name-nondirectory root)) |
|
|
|
(bname (format "*GitWorktree<%s>*" name))) |
|
|
|
(with-current-buffer (get-buffer-create bname) |
|
|
|
(cd root) |
|
|
|
(git-worktree--set-tabulated-list-mode-variables) |
|
|
|
(git-worktree-mode) |
|
|
|
(current-buffer)))) |
|
|
|
;; ((:worktree "/Users/10sr/.dotfiles" :head "5e7457a8d49ef6a517cdf39d038ba5fdf98dc68e" :branch "refs/heads/master") (:worktree "/Users/10sr/.dotfiles/b1" :head "fa7d868076d807692e35f82ae23596c903fd1117" :branch "refs/heads/b1")) |
|
|
|
|
|
|
|
(defun git-worktree--set-tabulated-list-mode-variables () |
|
|
|
"Set variables for `tabulated-list-mode'." |
|
|
|
(let ((trees (git-worktree-get-current-trees))) |
|
|
|
(setq tabulated-list-entries |
|
|
|
(mapcar (lambda (e) |
|
|
|
(list e |
|
|
|
(vector |
|
|
|
(concat (file-relative-name (plist-get e :worktree)) |
|
|
|
"/") |
|
|
|
(or (plist-get e :branch) |
|
|
|
;; bare worktree do not have head attr |
|
|
|
"N/A") |
|
|
|
(or (plist-get e :head) |
|
|
|
;; bare worktree do not have head attr |
|
|
|
"N/A") |
|
|
|
))) |
|
|
|
trees)) |
|
|
|
(let ((branch-max-size |
|
|
|
(apply 'max |
|
|
|
(length "Branch") ;; Header text |
|
|
|
(cl-loop for e in tabulated-list-entries |
|
|
|
collect (length (elt (cadr e) 1))))) |
|
|
|
(worktree-max-size |
|
|
|
(apply 'max |
|
|
|
(length "Worktree") ;; Header text |
|
|
|
(cl-loop for e in tabulated-list-entries |
|
|
|
collect (length (elt (cadr e) 0)))))) |
|
|
|
(setq tabulated-list-format |
|
|
|
`[ |
|
|
|
("Worktree" ,worktree-max-size t) |
|
|
|
("Branch" ,branch-max-size t) |
|
|
|
("Head" -1 t) |
|
|
|
])))) |
|
|
|
|
|
|
|
(defun git-worktree-open (&optional directory) |
|
|
|
"Open git worktree list buffer. |
|
|
|
|
|
|
|
If optional arg DIRECTORY is given change current directory to there before |
|
|
|
initializing." |
|
|
|
(interactive) |
|
|
|
(let ((bf (git-worktree-open-noselect directory))) |
|
|
|
(pop-to-buffer bf))) |
|
|
|
(defalias 'git-worktree 'git-worktree-open) |
|
|
|
(define-key ctl-x-map "T" 'git-worktree) |
|
|
|
|
|
|
|
(defun git-worktree-mode-go () |
|
|
|
"Go to worktree directory at point." |
|
|
|
(interactive) |
|
|
|
(let* ((id (tabulated-list-get-id)) |
|
|
|
(path (plist-get id :worktree))) |
|
|
|
(cl-assert path nil "No worktree info at point") |
|
|
|
(cl-assert (file-directory-p path) t "Directory not found") |
|
|
|
(dired path))) |
|
|
|
|
|
|
|
(defun git-worktree-mode-move () |
|
|
|
"Move worktree at point to a new location." |
|
|
|
(interactive) |
|
|
|
(let* ((id (tabulated-list-get-id)) |
|
|
|
(path (plist-get id :worktree))) |
|
|
|
(cl-assert path nil "No worktree info at point") |
|
|
|
(cl-assert (file-directory-p path) t "Directory not found") |
|
|
|
(let ((new (read-file-name (format "New name for worktree \"%s\": " |
|
|
|
path)))) |
|
|
|
(with-temp-buffer |
|
|
|
(git-worktree--call-process "worktree" |
|
|
|
"move" |
|
|
|
path |
|
|
|
(expand-file-name new))) |
|
|
|
(revert-buffer)))) |
|
|
|
|
|
|
|
(defun git-worktree-mode-add () |
|
|
|
"Add new git worktree." |
|
|
|
(interactive) |
|
|
|
(let* ((path (read-file-name "Path of new worktree: ")) |
|
|
|
(commitish (read-string (format "Commitish to checkout to worktree \"%s\" (Empty to use the same name): " |
|
|
|
path))) |
|
|
|
(args (append '("worktree" "add") |
|
|
|
(if (string= "" commitish) |
|
|
|
(list (expand-file-name path)) |
|
|
|
(list (expand-file-name path) commitish))))) |
|
|
|
(with-temp-buffer |
|
|
|
(apply 'git-worktree--call-process args)) |
|
|
|
(revert-buffer))) |
|
|
|
|
|
|
|
(defun git-worktree-mode-remove () |
|
|
|
"Remove worktree at point." |
|
|
|
(interactive) |
|
|
|
(let* ((id (tabulated-list-get-id)) |
|
|
|
(path (plist-get id :worktree))) |
|
|
|
(cl-assert path nil "No worktree info at point") |
|
|
|
(cl-assert (file-directory-p path) t "Directory not found") |
|
|
|
(when (yes-or-no-p (format "Remove workking directory \"%s\": " |
|
|
|
path)) |
|
|
|
(with-temp-buffer |
|
|
|
(git-worktree--call-process "worktree" |
|
|
|
"remove" |
|
|
|
path)) |
|
|
|
(revert-buffer)))) |
|
|
|
|
|
|
|
(defvar git-worktree-mode-map |
|
|
|
(let ((map (make-sparse-keymap))) |
|
|
|
(suppress-keymap map) |
|
|
|
(define-key map "A" 'git-worktree-mode-add) |
|
|
|
(define-key map (kbd "C-m") 'git-worktree-mode-go) |
|
|
|
(define-key map "R" 'git-worktree-mode-move) |
|
|
|
(define-key map "D" 'git-worktree-mode-remove) |
|
|
|
;; (define-key map (kbd "C-g") 'git-worktree-mode-close) |
|
|
|
(define-key map "/" 'isearch-forward) |
|
|
|
map)) |
|
|
|
|
|
|
|
(define-derived-mode git-worktree-mode tabulated-list-mode "Git-Worktrees" |
|
|
|
"Major mode for browsing recently opened files and directories." |
|
|
|
(setq tabulated-list-padding 2) |
|
|
|
(add-hook 'tabulated-list-revert-hook |
|
|
|
'git-worktree--set-tabulated-list-mode-variables |
|
|
|
nil |
|
|
|
t) |
|
|
|
(tabulated-list-init-header) |
|
|
|
(tabulated-list-print nil nil)) |
|
|
|
|
|
|
|
;;;;;;;;;;;;;;;; |
|
|
|
;; flychcek-black |
|
|
|
|
|
|
|