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