10sr 7 年之前
父節點
當前提交
d123f2467b
簽署人: 10sr GPG Key ID: 7BEC428194130EB2
共有 1 個文件被更改,包括 70 次插入70 次删除
  1. +70
    -70
      emacs.el

+ 70
- 70
emacs.el 查看文件

@@ -2270,9 +2270,9 @@ use for the buffer. It defaults to \"*recetf-show*\"."
:prefix "git-walktree-" :prefix "git-walktree-"
:group 'tools) :group 'tools)


(defvar git-walktree-current-commitish nil
"Commitish name of currently browsing.")
(make-variable-buffer-local 'git-walktree-current-commitish)
(defvar git-walktree-current-committish nil
"Committish name of currently browsing.")
(make-variable-buffer-local 'git-walktree-current-committish)


(defvar git-walktree-current-path nil (defvar git-walktree-current-path nil
"Path name currently visiting without leading slash. "Path name currently visiting without leading slash.
@@ -2294,25 +2294,25 @@ This path is always relative to repository root.")
'permanent-local 'permanent-local
t) t)


(defun git-walktree--commitish-fordisplay (commitish)
"Convert COMMITISH and return is a suitable format for displaying."
(if (and commitish
(defun git-walktree--committish-fordisplay (committish)
"Convert COMMITTISH and return is a suitable format for displaying."
(if (and committish
(string-match-p "\\`[0-9a-f]+\\'" (string-match-p "\\`[0-9a-f]+\\'"
commitish)
(>= (length commitish) 32))
committish)
(>= (length committish) 32))
(git-walktree--git-plumbing "rev-parse" (git-walktree--git-plumbing "rev-parse"
"--short" "--short"
commitish)
commitish))
committish)
committish))


(defun git-walktree--create-buffer (commitish name type)
"Create and return buffer for COMMITISH:NAME.
(defun git-walktree--create-buffer (committish name type)
"Create and return buffer for COMMITTISH:NAME.
TYPE is target object type." TYPE is target object type."
(let* ((root (git-walktree--git-plumbing "rev-parse" (let* ((root (git-walktree--git-plumbing "rev-parse"
"--show-toplevel")) "--show-toplevel"))
(commitish-display (git-walktree--commitish-fordisplay commitish))
(committish-display (git-walktree--committish-fordisplay committish))
(name (format "%s:%s" (name (format "%s:%s"
(or commitish-display "")
(or committish-display "")
name))) name)))


(if (and git-walktree-reuse-tree-buffer (if (and git-walktree-reuse-tree-buffer
@@ -2353,7 +2353,7 @@ It also copy text overlays."
target))))) target)))))


(require 'ansi-color) (require 'ansi-color)
(defun git-walktree--open-treeish (commitish path treeish)
(defun git-walktree--open-treeish (committish path treeish)
"Open git tree buffer of TREEISH." "Open git tree buffer of TREEISH."
(cl-assert path) (cl-assert path)
(cl-assert treeish) (cl-assert treeish)
@@ -2361,7 +2361,7 @@ It also copy text overlays."
(type (git-walktree--git-plumbing "cat-file" (type (git-walktree--git-plumbing "cat-file"
"-t" "-t"
treeish)) treeish))
(buf (git-walktree--create-buffer commitish path type))
(buf (git-walktree--create-buffer committish path type))
) )
(cl-assert (member type (cl-assert (member type
'("commit" "tree"))) '("commit" "tree")))
@@ -2376,7 +2376,7 @@ It also copy text overlays."
;; Remove existing overlays generated by ansi-color-apply-on-region ;; Remove existing overlays generated by ansi-color-apply-on-region
(remove-overlays) (remove-overlays)
(with-temp-buffer (with-temp-buffer
(if commitish
(if committish
(progn (git-walktree--call-process nil (progn (git-walktree--call-process nil
"show" "show"
;; TODO: Make this args configurable ;; TODO: Make this args configurable
@@ -2385,12 +2385,12 @@ It also copy text overlays."
"--pretty=short" "--pretty=short"
"--decorate" "--decorate"
"--stat" "--stat"
commitish)
committish)
(ansi-color-apply-on-region (point-min) (ansi-color-apply-on-region (point-min)
(point)) (point))
(insert "\n") (insert "\n")
(insert (format "Contents of '%s:%s':\n" (insert (format "Contents of '%s:%s':\n"
(git-walktree--commitish-fordisplay commitish)
(git-walktree--committish-fordisplay committish)
path))) path)))
(insert (format "Contents of treeish object '%s:\n" (insert (format "Contents of treeish object '%s:\n"
treeish))) treeish)))
@@ -2406,7 +2406,7 @@ It also copy text overlays."
(git-walktree-mode) (git-walktree-mode)
(set-buffer-modified-p nil) (set-buffer-modified-p nil)


(setq git-walktree-current-commitish commitish)
(setq git-walktree-current-committish committish)
(setq git-walktree-current-path path) (setq git-walktree-current-path path)
(setq git-walktree-object-id treeish) (setq git-walktree-object-id treeish)
(let ((dir (expand-file-name path git-walktree-repository-root))) (let ((dir (expand-file-name path git-walktree-repository-root)))
@@ -2435,15 +2435,15 @@ Result will be inserted into current buffer."
infile infile
args)))) args))))
?w ?w
(defun git-walktree--open-blob (commitish path blob)
(defun git-walktree--open-blob (committish path blob)
"Open BLOB object." "Open BLOB object."
(cl-assert commitish)
(cl-assert committish)
(cl-assert path) (cl-assert path)
(cl-assert blob) (cl-assert blob)
(let* ((type (git-walktree--git-plumbing "cat-file" (let* ((type (git-walktree--git-plumbing "cat-file"
"-t" "-t"
blob)) blob))
(buf (git-walktree--create-buffer commitish path type)))
(buf (git-walktree--create-buffer committish path type)))
(cl-assert (string= type "blob")) (cl-assert (string= type "blob"))
(with-current-buffer buf (with-current-buffer buf
(unless (string= blob (unless (string= blob
@@ -2458,7 +2458,7 @@ Result will be inserted into current buffer."
blob) blob)
(git-walktree--replace-into-buffer buf))) (git-walktree--replace-into-buffer buf)))
(setq git-walktree-buffer-file-name (setq git-walktree-buffer-file-name
(concat git-walktree-repository-root "/git@" commitish ":" path))
(concat git-walktree-repository-root "/git@" committish ":" path))
(setq buffer-file-name (setq buffer-file-name
(concat git-walktree-repository-root "/" path)) (concat git-walktree-repository-root "/" path))
(normal-mode t) (normal-mode t)
@@ -2466,7 +2466,7 @@ Result will be inserted into current buffer."
(setq buffer-file-name nil) (setq buffer-file-name nil)
(set-buffer-modified-p t) (set-buffer-modified-p t)


(setq git-walktree-current-commitish commitish)
(setq git-walktree-current-committish committish)
(setq git-walktree-current-path path) (setq git-walktree-current-path path)
(setq git-walktree-object-id blob) (setq git-walktree-object-id blob)
(let ((dir (expand-file-name (or (file-name-directory path) (let ((dir (expand-file-name (or (file-name-directory path)
@@ -2481,14 +2481,14 @@ Result will be inserted into current buffer."
buf)) buf))


;; TODO: Fix name ;; TODO: Fix name
(defun git-walktree--open-noselect-safe-path (commitish &optional path)
"Open git object of COMMITISH:PATH.
If PATH not found in COMMITISH tree, go up path and try again until found.
(defun git-walktree--open-noselect-safe-path (committish &optional path)
"Open git object of COMMITTISH:PATH.
If PATH not found in COMMITTISH tree, go up path and try again until found.
When PATH is omitted or nil, it is calculated from current file or directory." When PATH is omitted or nil, it is calculated from current file or directory."
(cl-assert commitish)
(cl-assert committish)
(let ((type (git-walktree--git-plumbing "cat-file" (let ((type (git-walktree--git-plumbing "cat-file"
"-t" "-t"
commitish)))
committish)))
(cl-assert (string= type "commit"))) (cl-assert (string= type "commit")))


(setq path (setq path
@@ -2504,22 +2504,22 @@ When PATH is omitted or nil, it is calculated from current file or directory."
(setq path (setq path
(git-walktree--parent-directory path)) (git-walktree--parent-directory path))
(setq obj (setq obj
(git-walktree--resolve-object commitish path)))
(git-walktree--open-noselect commitish
(git-walktree--resolve-object committish path)))
(git-walktree--open-noselect committish
path path
obj))) obj)))


;; TODO: Store view history ;; TODO: Store view history
;; TODO: Open current file or directory if available ;; TODO: Open current file or directory if available
(defun git-walktree--open-noselect (commitish path object)
"Open git tree buffer of COMMITISH.
(defun git-walktree--open-noselect (committish path object)
"Open git tree buffer of COMMITTISH.
When PATH was given and non-nil open that, otherwise open root tree. 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 full sha1 object id of
COMMITISH:PATH without checking it."
(cl-assert commitish)
COMMITTISH:PATH without checking it."
(cl-assert committish)
(let ((type (git-walktree--git-plumbing "cat-file" (let ((type (git-walktree--git-plumbing "cat-file"
"-t" "-t"
commitish)))
committish)))
(cl-assert (string= type "commit"))) (cl-assert (string= type "commit")))


(setq path (or path (setq path (or path
@@ -2529,7 +2529,7 @@ COMMITISH:PATH without checking it."
(cl-assert (not (string-match "/\\'" path))) (cl-assert (not (string-match "/\\'" path)))


(setq object (or object (setq object (or object
(git-walktree--resolve-object commitish path)))
(git-walktree--resolve-object committish path)))
(setq object (git-walktree--git-plumbing "rev-parse" (setq object (git-walktree--git-plumbing "rev-parse"
object)) object))
(cl-assert object) (cl-assert object)
@@ -2539,38 +2539,38 @@ COMMITISH:PATH without checking it."
object))) object)))
(pcase type (pcase type
((or "commit" "tree") ((or "commit" "tree")
(git-walktree--open-treeish commitish path object))
(git-walktree--open-treeish committish path object))
("blob" ("blob"
(git-walktree--open-blob commitish path object))
(git-walktree--open-blob committish path object))
(_ (_
(error "Type cannot handle: %s" type))))) (error "Type cannot handle: %s" type)))))


(defun git-walktree--resolve-object (commitish path)
(defun git-walktree--resolve-object (committish path)
"Return object id of COMMITISIH:PATH. "Return object id of COMMITISIH:PATH.
If path is equal to \".\" return COMMITISH's tree object
If path is equal to \".\" return COMMITTISH's tree object
PATH will be always treated as relative to repository root." PATH will be always treated as relative to repository root."
(cl-assert commitish)
(cl-assert committish)
(cl-assert path) (cl-assert path)
(if (string= path ".") (if (string= path ".")
(git-walktree--git-plumbing "show" (git-walktree--git-plumbing "show"
"--no-patch" "--no-patch"
"--pretty=format:%T" "--pretty=format:%T"
commitish)
committish)
(let ((info (git-walktree--parse-lstree-line (git-walktree--git-plumbing "ls-tree" (let ((info (git-walktree--parse-lstree-line (git-walktree--git-plumbing "ls-tree"
"--full-tree" "--full-tree"
commitish
committish
path)))) path))))
(plist-get info :object)))) (plist-get info :object))))


(defun git-walktree-open (commitish &optional path object)
"Open git tree buffer of COMMITISH.
(defun git-walktree-open (committish &optional path object)
"Open git tree buffer of COMMITTISH.
When PATH was given and non-nil open that, otherwise open root tree. 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 COMMITISH:PATH without
When OBJECT was given and non-nil, assume that is the object of COMMITTISH:PATH without
checking it." checking it."
(interactive (list (magit-read-branch-or-commit "Revision: "))) (interactive (list (magit-read-branch-or-commit "Revision: ")))
;; (setq path (or path ;; (setq path (or path
;; (git-walktree--path-in-repository (directory-file-name default-directory)))) ;; (git-walktree--path-in-repository (directory-file-name default-directory))))
(switch-to-buffer (git-walktree--open-noselect commitish path object)))
(switch-to-buffer (git-walktree--open-noselect committish path object)))
(defalias 'git-walktree 'git-walktree-open) (defalias 'git-walktree 'git-walktree-open)


(defun git-walktree--path-in-repository (path) (defun git-walktree--path-in-repository (path)
@@ -2659,7 +2659,7 @@ Returns property list like (:mode MODE :type TYPE :object OBJECT :file FILE)."
(interactive) (interactive)
(let ((info (git-walktree--parse-lstree-line (buffer-substring-no-properties (point-at-bol) (let ((info (git-walktree--parse-lstree-line (buffer-substring-no-properties (point-at-bol)
(point-at-eol))))) (point-at-eol)))))
;; TODO: Open commitish when currently on commitish like symbol
;; TODO: Open committish when currently on committish like symbol
(if info (if info
(switch-to-buffer (switch-to-buffer
(if (string= (plist-get info (if (string= (plist-get info
@@ -2674,7 +2674,7 @@ Returns property list like (:mode MODE :type TYPE :object OBJECT :file FILE)."
nil nil
(plist-get info (plist-get info
:object))) :object)))
(git-walktree--open-noselect git-walktree-current-commitish
(git-walktree--open-noselect git-walktree-current-committish
(git-walktree--join-path (plist-get info (git-walktree--join-path (plist-get info
:file)) :file))
(plist-get info (plist-get info
@@ -2701,17 +2701,17 @@ If PATH is equal to \".\", return nil."
nil nil
"."))) ".")))


(defun git-walktree-up (&optional commitish path)
"Open parent directory of COMMITISH and PATH.
(defun git-walktree-up (&optional committish path)
"Open parent directory of COMMITTISH and PATH.
If not given, value of current buffer will be used." If not given, value of current buffer will be used."
(interactive) (interactive)
(setq commitish
(or commitish git-walktree-current-commitish))
(setq committish
(or committish git-walktree-current-committish))
(setq path (setq path
(or path git-walktree-current-path)) (or path git-walktree-current-path))
(let ((parent (git-walktree--parent-directory path))) (let ((parent (git-walktree--parent-directory path)))
(if parent (if parent
(switch-to-buffer (git-walktree--open-noselect commitish
(switch-to-buffer (git-walktree--open-noselect committish
parent parent
nil)) nil))
(message "Cannot find parent directory for current tree.")))) (message "Cannot find parent directory for current tree."))))
@@ -2780,14 +2780,14 @@ PARENT should be a full SHA-1 object name."
PARENT should be a full SHA-1 object name." PARENT should be a full SHA-1 object name."
(gethash parent git-walktree-known-child-revisions)) (gethash parent git-walktree-known-child-revisions))


(defun git-walktree--choose-commitish (prompt-format collection)
"Emit PROMPT-FORMAT and ask user to which commitish of COLLECTION to use.
(defun git-walktree--choose-committish (prompt-format collection)
"Emit PROMPT-FORMAT and ask user to which committish of COLLECTION to use.
When collection has just one element, return the first element without asking." When collection has just one element, return the first element without asking."
(cl-assert collection) (cl-assert collection)
(if (< (length collection) 2) (if (< (length collection) 2)
(car collection) (car collection)
(completing-read (format prompt-format (completing-read (format prompt-format
(mapconcat 'git-walktree--commitish-fordisplay
(mapconcat 'git-walktree--committish-fordisplay
collection collection
" ")) " "))
collection collection
@@ -2799,9 +2799,9 @@ When collection has just one element, return the first element without asking."
"Open parent revision of current path. "Open parent revision of current path.
If current path was not found in the parent revision try to go up path." If current path was not found in the parent revision try to go up path."
(interactive) (interactive)
(cl-assert git-walktree-current-commitish)
(cl-assert git-walktree-current-committish)
(let* ((commitid (git-walktree--git-plumbing "rev-parse" (let* ((commitid (git-walktree--git-plumbing "rev-parse"
git-walktree-current-commitish))
git-walktree-current-committish))
(parents (git-walktree--parent-commitid commitid))) (parents (git-walktree--parent-commitid commitid)))
(dolist (parent parents) (dolist (parent parents)
(git-walktree--put-child parent (git-walktree--put-child parent
@@ -2809,8 +2809,8 @@ If current path was not found in the parent revision try to go up path."
(if (< (length parents) (if (< (length parents)
1) 1)
(message "This revision has no parent revision") (message "This revision has no parent revision")
(let* ((parent (git-walktree--choose-commitish "This revision has multiple parents. Which to open? (%s) "
parents))
(let* ((parent (git-walktree--choose-committish "This revision has multiple parents. Which to open? (%s) "
parents))
(path git-walktree-current-path) (path git-walktree-current-path)
(obj (git-walktree--resolve-object parent path))) (obj (git-walktree--resolve-object parent path)))
(cl-assert path) (cl-assert path)
@@ -2824,16 +2824,16 @@ If current path was not found in the parent revision try to go up path."
obj)) obj))
)))) ))))


(defun git-walktree--parent-commitid (commitish)
"Return list of parent commits of COMMITISH in sha1 string."
(defun git-walktree--parent-commitid (committish)
"Return list of parent commits of COMMITTISH in sha1 string."
(let ((type (git-walktree--git-plumbing "cat-file" (let ((type (git-walktree--git-plumbing "cat-file"
"-t" "-t"
commitish)))
committish)))
(cl-assert (string= type "commit"))) (cl-assert (string= type "commit")))
(let ((parents (git-walktree--git-plumbing "show" (let ((parents (git-walktree--git-plumbing "show"
"--no-patch" "--no-patch"
"--pretty=format:%P" "--pretty=format:%P"
commitish)))
committish)))
(split-string parents))) (split-string parents)))
;; (git-walktree--parent-sha1 "HEAD") ;; (git-walktree--parent-sha1 "HEAD")
;; (git-walktree--parent-sha1 "ae4b80f") ;; (git-walktree--parent-sha1 "ae4b80f")
@@ -2842,13 +2842,13 @@ If current path was not found in the parent revision try to go up path."
"Open known revision of current path." "Open known revision of current path."
(interactive) (interactive)
(let* ((commitid (git-walktree--git-plumbing "rev-parse" (let* ((commitid (git-walktree--git-plumbing "rev-parse"
git-walktree-current-commitish))
git-walktree-current-committish))
(children (git-walktree--get-children commitid))) (children (git-walktree--get-children commitid)))
(if (< (length children) (if (< (length children)
1) 1)
(message "There are no known child revision") (message "There are no known child revision")
(let* ((child (git-walktree--choose-commitish "There are multiple known childrens. Which to open? (%s)"
children))
(let* ((child (git-walktree--choose-committish "There are multiple known childrens. Which to open? (%s)"
children))
(path git-walktree-current-path) (path git-walktree-current-path)
(obj (git-walktree--resolve-object child path))) (obj (git-walktree--resolve-object child path)))
(cl-assert path) (cl-assert path)


Loading…
取消
儲存