10sr
/
dotfiles-mirror
镜像来自 https://github.com/10sr/dotfiles.git
1
0
複製 0
程式碼 問題 0 版本發佈 0 Wiki 活動
瀏覽代碼

Remove git-walktree from el

master
10sr 6 年之前
父節點
f88513ecae
當前提交
06ea4745e9
簽署人: 10sr GPG 金鑰 ID: 7BEC428194130EB2
共有 1 個檔案被更改，包括 0 行新增 和 630 行删除
分割檢視
Diff Options
Show Stats Download Patch File Download Diff File
  1. +0
    -630
      emacs.el

+ 0
- 630
emacs.el 查看文件

@@ -2142,636 +2142,6 @@ use for the buffer. It defaults to \"*recetf-show*\"."

(define-key ctl-x-map (kbd "C-r") 'recently-show)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; git walktree

(defgroup git-walktree nil
"Git Walktree."
:tag "GitWalktree"
:prefix "git-walktree-"
:group 'tools)

(defvar-local git-walktree-current-committish nil
"Committish name of currently browsing.")

(defvar-local git-walktree-current-path nil
"Path name currently visiting without leading and trailing slash.
This path is always relative to repository root.")

(defvar-local git-walktree-buffer-file-name nil
"Psudo filename of current buffer.")

(defvar-local git-walktree-object-full-sha1 nil
"Object name in full sha1 format of current buffer.")

(defvar-local git-walktree-repository-root nil
"Repository root path of current buffer.")
(put 'git-walktree-repository-root
'permanent-local
t)

(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]+\\'"
committish)
(>= (length committish) 32))
(git-walktree--git-plumbing "rev-parse"
"--short"
committish)
committish))

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

(if (and git-walktree-reuse-tree-buffer
(string= type "tree"))
(with-current-buffer (or git-walktree-tree-buffer-for-reuse
(setq git-walktree-tree-buffer-for-reuse
(generate-new-buffer "gitwalktreebuf")))
(setq git-walktree-repository-root root)
(rename-buffer name t)
(current-buffer))
(with-current-buffer (get-buffer-create name)
(if git-walktree-repository-root
(if (string= root
git-walktree-repository-root)
(current-buffer)
;; If the buffer is for another repository, create new buffer
(with-current-buffer (generate-new-buffer name)
(setq git-walktree-repository-root root)
(current-buffer)))
;; New buffer
(setq git-walktree-repository-root root)
(current-buffer))))))

(defun git-walktree--replace-into-buffer (target)
"Replace TARGET buffer contents with that of current buffer.
It also copy text overlays."
(let ((src (current-buffer)))
(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))
(end (overlay-end o)))
(move-overlay (copy-overlay o)
beg
end
target)))))

(require 'ansi-color)
(defun git-walktree--open-treeish (committish path 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
(type (git-walktree--git-plumbing "cat-file"
"-t"
treeish))
(buf (git-walktree--create-buffer committish path type))
)
(cl-assert (member type
'("commit" "tree")))
(with-current-buffer buf
(unless (and (string= treeish
git-walktree-object-full-sha1)
(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)
(save-excursion
(let ((inhibit-read-only t))
;; Remove existing overlays generated by ansi-color-apply-on-region
(remove-overlays)
(with-temp-buffer
(if committish
(progn (git-walktree--call-process nil
"show"
;; TODO: Make this args configurable
;; "--no-patch"
"--color=always"
"--pretty=short"
"--decorate"
"--stat"
committish)
(ansi-color-apply-on-region (point-min)
(point))
(insert "\n")
(insert (format "Contents of '%s:%s':\n"
(git-walktree--committish-fordisplay committish)
path)))
(insert (format "Contents of treeish object '%s:\n"
treeish)))
(setq point-tree-start (point))
(git-walktree--call-process nil
"ls-tree"
;; "-r"
"--abbrev"

treeish)
(git-walktree--replace-into-buffer buf))
))
(git-walktree-mode)
(set-buffer-modified-p nil)

(setq git-walktree-current-committish committish)
(setq git-walktree-current-path path)
(setq git-walktree-object-full-sha1 treeish)
(let ((dir (expand-file-name path git-walktree-repository-root)))
(when (and git-walktree-try-cd
(file-directory-p dir))
(cd dir)))
(when (= (point) (point-min))
(goto-char point-tree-start)
(git-walktree-mode--move-to-file)
)
))
buf))

(defun git-walktree--call-process (&optional infile &rest args)
"Call git command with input from INFILE and args ARGS.
Result will be inserted into current buffer."
(let ((status (apply 'call-process
git-walktree-git-executable
infile
t
nil
args)))
(unless (eq 0
status)
(error "Failed to call git process %S %S"
infile
args))))
?w
(defun git-walktree--open-blob (committish path blob)
"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)
(let* ((type (git-walktree--git-plumbing "cat-file"
"-t"
blob))
(buf (git-walktree--create-buffer committish path type)))
(cl-assert (string= type "blob"))
(with-current-buffer buf
(unless (string= blob
git-walktree-object-full-sha1)
;; For running git command go back to repository root
(cd git-walktree-repository-root)
(let ((inhibit-read-only t))
(with-temp-buffer
(git-walktree--call-process nil
"cat-file"
"-p"
blob)
(git-walktree--replace-into-buffer buf)))
(setq git-walktree-buffer-file-name
(concat git-walktree-repository-root "/git@" committish ":" path))
(setq buffer-file-name
(concat git-walktree-repository-root "/" path))
(normal-mode t)
;; For asking filename when C-xC-s
(setq buffer-file-name nil)
(set-buffer-modified-p t)

(setq git-walktree-current-committish committish)
(setq git-walktree-current-path path)
(setq git-walktree-object-full-sha1 blob)
(let ((dir (expand-file-name (or (file-name-directory path)
".")
git-walktree-repository-root)))
(when (and git-walktree-try-cd
(file-directory-p dir))
(cd dir)))

(view-mode 1)
))
buf))

(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."
(cl-assert committish)
(let ((type (git-walktree--git-plumbing "cat-file"
"-t"
committish)))
(cl-assert (string= type "commit")))

(setq path
(or path
(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-p "\\`/" path)))
(cl-assert (not (string-match-p "/\\'" path)))

(let ((obj (git-walktree--resolve-object committish path)))
(while (not obj)
(setq path
(git-walktree--parent-directory path))
(setq obj
(git-walktree--resolve-object committish path)))
(git-walktree--open-noselect committish
path
obj)))

;; TODO: Store view history
(defun git-walktree--open-noselect (committish path object)
"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 object full sha1 of
COMMITTISH:PATH without checking it."
(cl-assert committish)
(let ((type (git-walktree--git-plumbing "cat-file"
"-t"
committish)))
(cl-assert (string= type "commit")))

(setq path (or path
"."))
;; PATH must not start with and end with slashes
(cl-assert (not (string-match-p "\\`/" path)))
(cl-assert (not (string-match-p "/\\'" path)))

(setq object (or object
(git-walktree--resolve-object committish path)))
(setq object (git-walktree--git-plumbing "rev-parse"
object))
(cl-assert object)

(let ((type (git-walktree--git-plumbing "cat-file"
"-t"
object)))
(pcase type
((or "commit" "tree")
(git-walktree--open-treeish committish path object))
("blob"
(git-walktree--open-blob committish path object))
(_
(error "Type cannot handle: %s" type)))))

(defun git-walktree--resolve-object (committish path)
"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"
"--pretty=format:%T"
committish)
(let ((info (git-walktree--parse-lstree-line (git-walktree--git-plumbing "ls-tree"
"--full-tree"
committish
path))))
(plist-get info :object))))

(defun git-walktree-open (committish &optional path)
"Open git tree buffer of COMMITTISH.
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."
;; TODO: Add fallback method for cases where magit is not available
(interactive (list (magit-read-branch-or-commit "Revision: ")))
(switch-to-buffer (git-walktree--open-noselect-safe-path committish path)))
(defalias 'git-walktree 'git-walktree-open)

(defun git-walktree--path-in-repository (path)
"Convert PATH into relative path to repository root.
Result will not have leading and trailing slashes."
(with-temp-buffer
(cd (if (file-directory-p path)
path
(file-name-directory path)))
(let ((root (git-walktree--git-plumbing "rev-parse"
"--show-toplevel")))
(file-relative-name (directory-file-name path)
root))))

(defcustom git-walktree-git-executable "git"
"Git executable."
:type 'string
:group 'git-walktree)

(defcustom git-walktree-try-cd t
"Try to cd if directory exists in current working directory if non-nil.
Otherwise use repository root for gitwalktree buffer's `default-directory'."
:type 'boolean
:group 'git-walktree)

(defcustom git-walktree-reuse-tree-buffer t
"Non-nil to reuse buffer for treeish object."
:type 'boolean
: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.
Returns first line of output without newline."
(with-temp-buffer
(let ((status (apply 'call-process
git-walktree-git-executable
nil
t
nil
args)))
(unless (eq 0
status)
(error "Faild to run git %S:\n%s"
args
(buffer-substring-no-properties (point-min)
(point-max))))
(buffer-substring-no-properties (point-min)
(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.")
(defconst git-walktree-ls-tree-line-tree-regexp
"^\\([0-9]\\{6\\}\\) \\(tree\\) \\([0-9a-f]+\\)\t\\(.*\\)$"
"Regexp for tree line of output of git ls-tree.")
(defconst git-walktree-ls-tree-line-commit-regexp
"^\\([0-9]\\{6\\}\\) \\(commit\\) \\([0-9a-f]+\\)\t\\(.*\\)$"
"Regexp for commit line of output of git ls-tree.")
(defun git-walktree--parse-lstree-line (str)
"Extract object info from STR.

STR should be a string like following without newline.:

100644 blob 6fd4d58202d0b46547c6fe43de0f8c878456f966 .editorconfig

Returns property list like (:mode MODE :type TYPE :object OBJECT :file FILE)."
(let (result mode type object file)
(save-match-data
(with-temp-buffer
(insert str)
(goto-char (point-min))
(and (re-search-forward git-walktree-ls-tree-line-regexp
nil
t)
(list :mode (match-string 1)
:type (match-string 2)
:object (match-string 3)
:file (match-string 4)))))))

(defun git-walktree-mode-open-this ()
"Open git object of current line."
(interactive)
(let ((info (git-walktree--parse-lstree-line (buffer-substring-no-properties (point-at-bol)
(point-at-eol)))))
(if info
(switch-to-buffer
(if (string= (plist-get info
:type)
"commit")
;; For submodule cd to that directory and intialize
;; TODO: Provide way to go back to known "parent" repository
(with-temp-buffer
(cd (plist-get info :file))
(git-walktree--open-noselect (plist-get info
:object)
nil
(plist-get info
:object)))
(git-walktree--open-noselect git-walktree-current-committish
(git-walktree--join-path (plist-get info
:file))
(plist-get info
:object))))
(message "No object on current line."))))

(defun git-walktree--join-path (name &optional base)
"Make path from NAME and BASE.
If base is omitted or nil use value of `git-walktree-current-path'."
(setq base (or base
git-walktree-current-path))
(cl-assert base)
(if (string= base ".")
name
(concat base "/" name)))

(defun git-walktree--parent-directory (path)
"Return parent directory of PATH without trailing slash.
For root directory return \".\".
If PATH is equal to \".\", return nil."
(if (string-match-p "/" path)
(directory-file-name (file-name-directory path))
(if (string= "." path)
nil
".")))

(defun git-walktree-up (&optional committish path)
"Open parent directory of COMMITTISH and PATH.
If not given, value of current buffer will be used."
(interactive)
(setq committish
(or committish git-walktree-current-committish))
(setq path
(or path git-walktree-current-path))
(let ((parent (git-walktree--parent-directory path)))
(if parent
(switch-to-buffer (git-walktree--open-noselect committish
parent
nil))
(message "Cannot find parent directory for current tree."))))

(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."
(interactive)
(save-match-data
(when (save-excursion
(goto-char (point-at-bol))
(re-search-forward git-walktree-ls-tree-line-regexp
(point-at-eol) t))
(goto-char (match-beginning 4)))))

(defun git-walktree-mode-next-line (&optional arg try-vscroll)
"Move cursor vertically down ARG lines and move to file field if found."
(interactive "^p\np")
(or arg (setq arg 1))
(line-move arg nil nil try-vscroll)
(git-walktree-mode--move-to-file)
)

(defun git-walktree-mode-previous-line (&optional arg try-vscroll)
"Move cursor vertically up ARG lines and move to file field if found."
(interactive "^p\np")
(or arg (setq arg 1))
(line-move (- arg) nil nil try-vscroll)
(git-walktree-mode--move-to-file)
)

(defgroup git-walktree-faces nil
"Faces used by git-walktree."
:group 'git-walktree
:group 'faces)

(defface git-walktree-tree-face
;; Same as dired-directory
'((t (:inherit font-lock-function-name-face)))
"Face used for tree objects."
:group 'git-walktree-faces)
(defface git-walktree-commit-face
;; Same as dired-symlink face
'((t (:inherit font-lock-keyword-face)))
"Face used for commit objects."
: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.
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 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)
(puthash parent
(cons child
current)
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 sha1 object name."
(gethash parent git-walktree-known-child-revisions))

(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."
(cl-assert collection)
(if (< (length collection) 2)
(car collection)
(completing-read (format prompt-format
(mapconcat 'git-walktree--committish-fordisplay
collection
" "))
collection
nil
t)))

(defun git-walktree-parent-revision ()
"Open parent revision of current path.
If current path was not found in the parent revision try to go up path."
(interactive)
(cl-assert git-walktree-current-committish)
(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
commit-full-sha1))
(if (< (length parents)
1)
(message "This revision has no parent revision")
(let* ((parent (git-walktree--choose-committish "This revision has multiple parents. Which to open? (%s) "
parents))
(path git-walktree-current-path))
(cl-assert path)
(switch-to-buffer (git-walktree--open-noselect-safe-path parent
path))))))

(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"
committish)))
(cl-assert (string= type "commit")))
(let ((parents (git-walktree--git-plumbing "show"
"--no-patch"
"--pretty=format:%P"
committish)))
(split-string parents)))

(defun git-walktree-known-child-revision ()
"Open known revision of current path."
(interactive)
(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")
(let* ((child (git-walktree--choose-committish "There are multiple known childrens. Which to open? (%s)"
children))
(path git-walktree-current-path))
(cl-assert path)
(switch-to-buffer (git-walktree--open-noselect-safe-path child
path))))))

(defvar git-walktree-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "n" 'git-walktree-mode-next-line)
(define-key map "p" 'git-walktree-mode-previous-line)
(define-key map (kbd "C-n") 'git-walktree-mode-next-line)
(define-key map (kbd "C-p") 'git-walktree-mode-previous-line)
;; TODO: Review keybind
(define-key map "P" 'git-walktree-parent-revision)
(define-key map "N" 'git-walktree-known-child-revision)
(define-key map "^" 'git-walktree-up)
;; TODO: implement
(define-key map (kbd "DEL") 'git-walktree-back)
(define-key map (kbd "C-m") 'git-walktree-mode-open-this)
map))

(defvar git-walktree-mode-font-lock-keywords
`(
(,git-walktree-ls-tree-line-regexp . (
(1 'shadow)
(3 'shadow)
))
(,git-walktree-ls-tree-line-tree-regexp . (
(2 'git-walktree-tree-face)
(4 'git-walktree-tree-face)
))
(,git-walktree-ls-tree-line-commit-regexp . (
(2 'git-walktree-commit-face)
(4 'git-walktree-commit-face)
))
)
"Syntax highlighting for git-walktree mode.")

(define-derived-mode git-walktree-mode special-mode "GitWalktree"
"Major-mode for `git-walktree-open'."
(set (make-local-variable 'font-lock-defaults)
'(git-walktree-mode-font-lock-keywords
nil nil nil nil
))
)

(require 'magit nil t)
;; (git-revision--git-plumbing "cat-file" "-t" "HEAD")


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; git-worktree



Write Preview
Loading…
取消
儲存