|
|
@@ -2263,12 +2263,6 @@ use for the buffer. It defaults to \"*recetf-show*\"." |
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
|
|
|
;; git walktree |
|
|
|
|
|
|
|
;; TODO: Fix variable names |
|
|
|
;; commit-sha1 for commit sha1 (allow abbreviated) |
|
|
|
;; commit-full-sha1 for commit sha1 in 40 chars |
|
|
|
;; object-full-sha1 for object sha1 in 40 chars |
|
|
|
;; Do not use something like "-id" in name |
|
|
|
|
|
|
|
(defgroup git-walktree nil |
|
|
|
"Git Walktree." |
|
|
|
:tag "GitWalktree" |
|
|
@@ -2288,9 +2282,8 @@ This path is always relative to repository root.") |
|
|
|
"Psudo filename of current buffer.") |
|
|
|
(make-variable-buffer-local 'git-walktree-buffer-file-name) |
|
|
|
|
|
|
|
;; TODO: -> object-full-sha1 |
|
|
|
(defvar git-walktree-object-full-sha1 nil |
|
|
|
"Object id of current buffer.") |
|
|
|
"Object name in full sha1 format of current buffer.") |
|
|
|
(make-variable-buffer-local 'git-walktree-object-full-sha1) |
|
|
|
|
|
|
|
(defvar git-walktree-repository-root nil |
|
|
@@ -2325,7 +2318,7 @@ TYPE is target object type." |
|
|
|
(string= type "tree")) |
|
|
|
(with-current-buffer (or git-walktree-tree-buffer-for-reuse |
|
|
|
(setq git-walktree-tree-buffer-for-reuse |
|
|
|
(get-buffer-create "*gitwalktree*"))) |
|
|
|
(generate-new-buffer "gitwalktreebuf"))) |
|
|
|
(setq git-walktree-repository-root root) |
|
|
|
(rename-buffer name t) |
|
|
|
(current-buffer)) |
|
|
@@ -2349,6 +2342,7 @@ It also copy text overlays." |
|
|
|
(with-current-buffer target |
|
|
|
(replace-buffer-contents src))) |
|
|
|
|
|
|
|
;; Copy color overlays |
|
|
|
(let ((overlays (overlays-in (point-min) (point-max)))) |
|
|
|
(dolist (o overlays) |
|
|
|
(let ((beg (overlay-start o)) |
|
|
@@ -2360,7 +2354,9 @@ It also copy text overlays." |
|
|
|
|
|
|
|
(require 'ansi-color) |
|
|
|
(defun git-walktree--open-treeish (committish path treeish) |
|
|
|
"Open git tree buffer of TREEISH." |
|
|
|
"Open git tree buffer of COMMITISH:PATH. |
|
|
|
|
|
|
|
TREEISH should be a tree-ish object full-sha1 of COMMITISH:PATH." |
|
|
|
(cl-assert path) |
|
|
|
(cl-assert treeish) |
|
|
|
(let* (point-tree-start |
|
|
@@ -2374,10 +2370,10 @@ It also copy text overlays." |
|
|
|
(with-current-buffer buf |
|
|
|
(unless (and (string= treeish |
|
|
|
git-walktree-object-full-sha1) |
|
|
|
(or (string= committish |
|
|
|
git-walktree-current-committish) |
|
|
|
(eq committish |
|
|
|
git-walktree-current-committish))) |
|
|
|
(or (eq committish |
|
|
|
git-walktree-current-committish) |
|
|
|
(string= committish |
|
|
|
git-walktree-current-committish))) |
|
|
|
(buffer-disable-undo) |
|
|
|
;; For running git command go back to repository root |
|
|
|
(cd git-walktree-repository-root) |
|
|
@@ -2425,7 +2421,7 @@ It also copy text overlays." |
|
|
|
(cd dir))) |
|
|
|
(when (= (point) (point-min)) |
|
|
|
(goto-char point-tree-start) |
|
|
|
(git-walktree-mode--goto-file) |
|
|
|
(git-walktree-mode--move-to-file) |
|
|
|
) |
|
|
|
)) |
|
|
|
buf)) |
|
|
@@ -2446,7 +2442,8 @@ Result will be inserted into current buffer." |
|
|
|
args)))) |
|
|
|
?w |
|
|
|
(defun git-walktree--open-blob (committish path blob) |
|
|
|
"Open BLOB object." |
|
|
|
"Open blob object of COMMITISH:PATH. |
|
|
|
BLOB should be a object full sha1 of COMMITISH:PATH." |
|
|
|
(cl-assert committish) |
|
|
|
(cl-assert path) |
|
|
|
(cl-assert blob) |
|
|
@@ -2505,8 +2502,8 @@ When PATH is omitted or nil, it is calculated from current file or directory." |
|
|
|
(git-walktree--path-in-repository (or buffer-file-name |
|
|
|
default-directory)))) |
|
|
|
;; PATH must not start with and end with slashes |
|
|
|
(cl-assert (not (string-match "\\`/" path))) |
|
|
|
(cl-assert (not (string-match "/\\'" path))) |
|
|
|
(cl-assert (not (string-match-p "\\`/" path))) |
|
|
|
(cl-assert (not (string-match-p "/\\'" path))) |
|
|
|
|
|
|
|
(let ((obj (git-walktree--resolve-object committish path))) |
|
|
|
(while (not obj) |
|
|
@@ -2520,9 +2517,9 @@ When PATH is omitted or nil, it is calculated from current file or directory." |
|
|
|
|
|
|
|
;; TODO: Store view history |
|
|
|
(defun git-walktree--open-noselect (committish path object) |
|
|
|
"Open git tree buffer of COMMITTISH. |
|
|
|
"Open buffer to view git object of COMMITTISH:PATH. |
|
|
|
When PATH was given and non-nil open that, otherwise open root tree. |
|
|
|
When OBJECT was given and non-nil, assume that is the full sha1 object id of |
|
|
|
When OBJECT was given and non-nil, assume that is the object full sha1 of |
|
|
|
COMMITTISH:PATH without checking it." |
|
|
|
(cl-assert committish) |
|
|
|
(let ((type (git-walktree--git-plumbing "cat-file" |
|
|
@@ -2533,8 +2530,8 @@ COMMITTISH:PATH without checking it." |
|
|
|
(setq path (or path |
|
|
|
".")) |
|
|
|
;; PATH must not start with and end with slashes |
|
|
|
(cl-assert (not (string-match "\\`/" path))) |
|
|
|
(cl-assert (not (string-match "/\\'" path))) |
|
|
|
(cl-assert (not (string-match-p "\\`/" path))) |
|
|
|
(cl-assert (not (string-match-p "/\\'" path))) |
|
|
|
|
|
|
|
(setq object (or object |
|
|
|
(git-walktree--resolve-object committish path))) |
|
|
@@ -2554,11 +2551,13 @@ COMMITTISH:PATH without checking it." |
|
|
|
(error "Type cannot handle: %s" type))))) |
|
|
|
|
|
|
|
(defun git-walktree--resolve-object (committish path) |
|
|
|
"Return object id of COMMITISIH:PATH. |
|
|
|
If path is equal to \".\" return COMMITTISH's tree object |
|
|
|
"Return object full sha1 name of COMMITISIH:PATH. |
|
|
|
If path is equal to \".\" return COMMITTISH's root tree object. |
|
|
|
PATH will be always treated as relative to repository root." |
|
|
|
(cl-assert committish) |
|
|
|
(cl-assert path) |
|
|
|
(cl-assert (not (string-match-p "\\`/" path))) |
|
|
|
(cl-assert (not (string-match-p "/\\'" path))) |
|
|
|
(if (string= path ".") |
|
|
|
(git-walktree--git-plumbing "show" |
|
|
|
"--no-patch" |
|
|
@@ -2570,13 +2569,12 @@ PATH will be always treated as relative to repository root." |
|
|
|
path)))) |
|
|
|
(plist-get info :object)))) |
|
|
|
|
|
|
|
(defun git-walktree-open (committish &optional path object) |
|
|
|
(defun git-walktree-open (committish &optional path) |
|
|
|
"Open git tree buffer of COMMITTISH. |
|
|
|
When PATH was given and non-nil open that, otherwise open root tree. |
|
|
|
When OBJECT was given and non-nil, assume that is the object of COMMITTISH:PATH without |
|
|
|
checking it." |
|
|
|
When PATH was given and non-nil open that, otherwise try to open current path. |
|
|
|
If target path is not found in COMMITISH tree, go up path and try again until found." |
|
|
|
(interactive (list (magit-read-branch-or-commit "Revision: "))) |
|
|
|
(switch-to-buffer (git-walktree--open-noselect committish path object))) |
|
|
|
(switch-to-buffer (git-walktree--open-noselect-safe-path committish path))) |
|
|
|
(defalias 'git-walktree 'git-walktree-open) |
|
|
|
|
|
|
|
(defun git-walktree--path-in-repository (path) |
|
|
@@ -2596,7 +2594,7 @@ checking it." |
|
|
|
|
|
|
|
(defcustom git-walktree-try-cd t |
|
|
|
"Try to cd if directory exists in current working directory if non-nil. |
|
|
|
Otherwise buffer's `default-directory' is always repository root." |
|
|
|
Otherwise use repository root for gitwalktree buffer's `default-directory'." |
|
|
|
:type 'boolean |
|
|
|
:group 'git-walktree) |
|
|
|
|
|
|
@@ -2605,10 +2603,8 @@ Otherwise buffer's `default-directory' is always repository root." |
|
|
|
:type 'boolean |
|
|
|
:group 'git-walktree) |
|
|
|
|
|
|
|
(defcustom git-walktree-tree-buffer-for-reuse nil |
|
|
|
"Buffer to use when `git-walktree-reuse-tree-buffer' is non-nil." |
|
|
|
:type 'string |
|
|
|
:group 'git-walktree) |
|
|
|
(defvar git-walktree-tree-buffer-for-reuse nil |
|
|
|
"Buffer to use when `git-walktree-reuse-tree-buffer' is non-nil.") |
|
|
|
|
|
|
|
(defun git-walktree--git-plumbing (&rest args) |
|
|
|
"Run git plubming command with ARGS. |
|
|
@@ -2630,6 +2626,7 @@ Returns first line of output without newline." |
|
|
|
(progn |
|
|
|
(goto-char (point-min)) |
|
|
|
(point-at-eol)))))) |
|
|
|
|
|
|
|
(defconst git-walktree-ls-tree-line-regexp |
|
|
|
"^\\([0-9]\\{6\\}\\) \\(\\w+\\) \\([0-9a-f]+\\)\t\\(.*\\)$" |
|
|
|
"Regexp for one line of output of git ls-tree.") |
|
|
@@ -2661,7 +2658,7 @@ Returns property list like (:mode MODE :type TYPE :object OBJECT :file FILE)." |
|
|
|
:file (match-string 4))))))) |
|
|
|
|
|
|
|
(defun git-walktree-mode-open-this () |
|
|
|
"Open current object." |
|
|
|
"Open git object of current line." |
|
|
|
(interactive) |
|
|
|
(let ((info (git-walktree--parse-lstree-line (buffer-substring-no-properties (point-at-bol) |
|
|
|
(point-at-eol))))) |
|
|
@@ -2721,8 +2718,7 @@ If not given, value of current buffer will be used." |
|
|
|
nil)) |
|
|
|
(message "Cannot find parent directory for current tree.")))) |
|
|
|
|
|
|
|
;; TODO: -> -move-to |
|
|
|
(defun git-walktree-mode--goto-file () |
|
|
|
(defun git-walktree-mode--move-to-file () |
|
|
|
"Move point to file field of ls-tree output in current line. |
|
|
|
|
|
|
|
This function do nothing when current line is not ls-tree output." |
|
|
@@ -2739,7 +2735,7 @@ This function do nothing when current line is not ls-tree output." |
|
|
|
(interactive "^p\np") |
|
|
|
(or arg (setq arg 1)) |
|
|
|
(line-move arg nil nil try-vscroll) |
|
|
|
(git-walktree-mode--goto-file) |
|
|
|
(git-walktree-mode--move-to-file) |
|
|
|
) |
|
|
|
|
|
|
|
(defun git-walktree-mode-previous-line (&optional arg try-vscroll) |
|
|
@@ -2747,7 +2743,7 @@ This function do nothing when current line is not ls-tree output." |
|
|
|
(interactive "^p\np") |
|
|
|
(or arg (setq arg 1)) |
|
|
|
(line-move (- arg) nil nil try-vscroll) |
|
|
|
(git-walktree-mode--goto-file) |
|
|
|
(git-walktree-mode--move-to-file) |
|
|
|
) |
|
|
|
|
|
|
|
(defgroup git-walktree-faces nil |
|
|
@@ -2767,11 +2763,12 @@ This function do nothing when current line is not ls-tree output." |
|
|
|
:group 'git-walktree-faces) |
|
|
|
|
|
|
|
(defvar git-walktree-known-child-revisions (make-hash-table :test 'equal) |
|
|
|
"Hash of already known pair of commitid -> list of child commitid.") |
|
|
|
"Hash of already known pair of commitid -> list of child commitid. |
|
|
|
Both values should be object full sha1 names.") |
|
|
|
|
|
|
|
(defun git-walktree--put-child (parent child) |
|
|
|
"Register PARENT and CHILD relationship. |
|
|
|
PARENT should be a full SHA-1 object name." |
|
|
|
PARENT should be a full sha1 object name." |
|
|
|
;; Any way to check if PARENT is a full SHA-1 object name? |
|
|
|
(let ((current (gethash parent git-walktree-known-child-revisions))) |
|
|
|
(unless (member child current) |
|
|
@@ -2781,12 +2778,12 @@ PARENT should be a full SHA-1 object name." |
|
|
|
git-walktree-known-child-revisions)))) |
|
|
|
|
|
|
|
;; TODO: Add aggressive search mode |
|
|
|
;; https://stackoverflow.com/a/9870218 |
|
|
|
;; git log --reverse --pretty=format:%H -n 1 --ancestry-path <PARENT>..HEAD |
|
|
|
(defun git-walktree--get-children (parent) |
|
|
|
"Get known children list of PARENT commit. |
|
|
|
PARENT should be a full SHA-1 object name." |
|
|
|
PARENT should be a full sha1 object name." |
|
|
|
(gethash parent git-walktree-known-child-revisions)) |
|
|
|
;; https://stackoverflow.com/a/9870218 |
|
|
|
;; git log --reverse --pretty=format:%H -n 1 --ancestry-path <PARENT>..HEAD |
|
|
|
|
|
|
|
(defun git-walktree--choose-committish (prompt-format collection) |
|
|
|
"Emit PROMPT-FORMAT and ask user to which committish of COLLECTION to use. |
|
|
@@ -2807,12 +2804,12 @@ When collection has just one element, return the first element without asking." |
|
|
|
If current path was not found in the parent revision try to go up path." |
|
|
|
(interactive) |
|
|
|
(cl-assert git-walktree-current-committish) |
|
|
|
(let* ((commitid (git-walktree--git-plumbing "rev-parse" |
|
|
|
git-walktree-current-committish)) |
|
|
|
(parents (git-walktree--parent-commitid commitid))) |
|
|
|
(let* ((commit-full-sha1 (git-walktree--git-plumbing "rev-parse" |
|
|
|
git-walktree-current-committish)) |
|
|
|
(parents (git-walktree--parent-full-sha1 commit-full-sha1))) |
|
|
|
(dolist (parent parents) |
|
|
|
(git-walktree--put-child parent |
|
|
|
commitid)) |
|
|
|
commit-full-sha1)) |
|
|
|
(if (< (length parents) |
|
|
|
1) |
|
|
|
(message "This revision has no parent revision") |
|
|
@@ -2823,7 +2820,7 @@ If current path was not found in the parent revision try to go up path." |
|
|
|
(switch-to-buffer (git-walktree--open-noselect-safe-path parent |
|
|
|
path)))))) |
|
|
|
|
|
|
|
(defun git-walktree--parent-commitid (committish) |
|
|
|
(defun git-walktree--parent-full-sha1 (committish) |
|
|
|
"Return list of parent commits of COMMITTISH in sha1 string." |
|
|
|
(let ((type (git-walktree--git-plumbing "cat-file" |
|
|
|
"-t" |
|
|
@@ -2834,15 +2831,13 @@ If current path was not found in the parent revision try to go up path." |
|
|
|
"--pretty=format:%P" |
|
|
|
committish))) |
|
|
|
(split-string parents))) |
|
|
|
;; (git-walktree--parent-sha1 "HEAD") |
|
|
|
;; (git-walktree--parent-sha1 "ae4b80f") |
|
|
|
|
|
|
|
(defun git-walktree-known-child-revision () |
|
|
|
"Open known revision of current path." |
|
|
|
(interactive) |
|
|
|
(let* ((commitid (git-walktree--git-plumbing "rev-parse" |
|
|
|
git-walktree-current-committish)) |
|
|
|
(children (git-walktree--get-children commitid))) |
|
|
|
(let* ((commit-full-sha1 (git-walktree--git-plumbing "rev-parse" |
|
|
|
git-walktree-current-committish)) |
|
|
|
(children (git-walktree--get-children commit-full-sha1))) |
|
|
|
(if (< (length children) |
|
|
|
1) |
|
|
|
(message "There are no known child revision") |
|
|
|