浏览代码

Remove git-worktree from emacs.el

master
10sr 5 年前
父节点
当前提交
493ca66e3b
签署人:: 10sr GPG 密钥 ID: 7BEC428194130EB2
共有 1 个文件被更改,包括 0 次插入201 次删除
  1. +0
    -201
      emacs.el

+ 0
- 201
emacs.el 查看文件

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



正在加载...
取消
保存