Kaynağa Gözat

Add some refactors

master
10sr 6 yıl önce
ebeveyn
işleme
3aa065cf1a
İmzalayan: 10sr GPG Anahtar Kimliği: 7BEC428194130EB2
1 değiştirilmiş dosya ile 49 ekleme ve 54 silme
  1. +49
    -54
      emacs.el

+ 49
- 54
emacs.el Dosyayı Görüntüle

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


Yükleniyor…
İptal
Kaydet