Browse Source

git-revison -> git-walktree

master
10sr 6 years ago
parent
commit
a0fc6f4498
Signed by: 10sr GPG Key ID: 7BEC428194130EB2
1 changed files with 88 additions and 87 deletions
  1. +88
    -87
      emacs.el

+ 88
- 87
emacs.el View File

@@ -1,6 +1,6 @@
;;; emacs.el --- 10sr emacs initialization

;; Time-stamp: <2018-10-12 16:34:18 JST 10sr>
;; Time-stamp: <2018-10-12 17:39:33 JST 10sr>

;;; Code:

@@ -2238,36 +2238,41 @@ use for the buffer. It defaults to \"*recetf-show*\"."
(define-key ctl-x-map (kbd "C-r") 'recently-show)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; git revision
;; git walktree

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

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

(defvar git-revision-current-path nil
(defvar git-walktree-current-path nil
"Path name currently visiting without leading slash.")
(make-variable-buffer-local 'git-revision-current-path)
(make-variable-buffer-local 'git-walktree-current-path)

;; (defvar git-revision-repository-path nil
;; "Path of current git repository root.")
;; (make-variable-buffer-local 'git-revision-repository-path)

(defun git-revision--create-buffer (commitish name)
(defun git-walktree--create-buffer (commitish name)
;; TODO: check repository
"Create and return buffer for NAME."
(get-buffer-create (format "*GitRevision<%s:%s>*" (or commitish "") name)))

(defun git-revision--open-treeish (commitish path treeish)
(when (and commitish
(string-match-p "\\`[0-9a-f]+\\'"
commitish)
(> (length commitish) 32))
(setq commitish
(git-walktree--git-plumbing "rev-parse"
"--short"
commitish)))
(get-buffer-create (format "%s:%s" (or commitish "") name)))

(defun git-walktree--open-treeish (commitish path treeish)
"Open git tree buffer of TREEISH."
(let (point
point-tree-start
(buf (git-revision--create-buffer commitish path))
(type (git-revision--git-plumbing "cat-file"
(buf (git-walktree--create-buffer commitish path))
(type (git-walktree--git-plumbing "cat-file"
"-t"
treeish))
)
@@ -2280,24 +2285,24 @@ use for the buffer. It defaults to \"*recetf-show*\"."
(setq point (point))
(erase-buffer)
(when commitish
(git-revision--call-process nil
(git-walktree--call-process nil
"show"
"--no-patch"
"--pretty=short"
commitish)
(insert "\n"))
(setq point-tree-start (point))
(git-revision--call-process nil
(git-walktree--call-process nil
"ls-tree"
;; "-r"
"--abbrev"

treeish)))
(git-revision-mode)
(git-walktree-mode)
(set-buffer-modified-p nil)

(setq git-revision-current-commitish commitish)
(setq git-revision-current-path path)
(setq git-walktree-current-commitish commitish)
(setq git-walktree-current-path path)
;; FIXME: Somehow point go back to point-min when reopen the buffer
(if (eq point (point-min))
(goto-char point-tree-start)
@@ -2306,11 +2311,11 @@ use for the buffer. It defaults to \"*recetf-show*\"."
)
buf))

(defun git-revision--call-process (&optional infile &rest args)
(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-revision-git-executable
git-walktree-git-executable
infile
t
nil
@@ -2321,25 +2326,25 @@ Result will be inserted into current buffer."
infile
args))))
?w
(defun git-revision--open-blob (commitish path blob)
(defun git-walktree--open-blob (commitish path blob)
"Open BLOB object."
(let (point
(type (git-revision--git-plumbing "cat-file"
(type (git-walktree--git-plumbing "cat-file"
"-t"
blob))
(buf (git-revision--create-buffer commitish path)))
(buf (git-walktree--create-buffer commitish path)))
(cl-assert (string= type "blob"))
(with-current-buffer buf
(let ((inhibit-read-only t))
(setq point (point))
(erase-buffer)
(git-revision--call-process nil
(git-walktree--call-process nil
"cat-file"
"-p"
blob))
;; FIXME: Ask for file name when C-xC-s is given
(setq buffer-file-name
(concat (git-revision--git-plumbing "rev-parse"
(concat (git-walktree--git-plumbing "rev-parse"
"--show-toplevel")
"/git@"
commitish
@@ -2348,19 +2353,19 @@ Result will be inserted into current buffer."
(set-buffer-modified-p nil)
(normal-mode t)

(setq git-revision-current-commitish commitish)
(setq git-revision-current-path path)
(setq git-walktree-current-commitish commitish)
(setq git-walktree-current-path path)
(setq buffer-read-only t)
(goto-char point)
)
buf))

(defun git-revision--open-noselect (commitish path object)
(defun git-walktree--open-noselect (commitish path object)
"Open git tree buffer of COMMITISH.
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 checking it."
(let ((type (git-revision--git-plumbing "cat-file"
(let ((type (git-walktree--git-plumbing "cat-file"
"-t"
commitish)))
(cl-assert (string= type "commit")))
@@ -2375,47 +2380,47 @@ without checking it."
(setq object (or object
commitish))
(setq object (or object
(git-revision--resolve-object commitish path))))
(git-walktree--resolve-object commitish path))))
(cl-assert object)

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

(defun git-revision--resolve-object (commitish path)
(defun git-walktree--resolve-object (commitish path)
"Return object id of COMMITISIH:PATH."
(let ((info (git-revision--parse-lstree-line (git-revision--git-plumbing "ls-tree"
(let ((info (git-walktree--parse-lstree-line (git-walktree--git-plumbing "ls-tree"
commitish
path))))
(plist-get info :object)))

(defun git-revision-open (commitish &optional path object)
(defun git-walktree-open (commitish &optional path object)
"Open git tree buffer of COMMITISH.
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
checking it."
(interactive (list (magit-read-branch-or-commit "Revision: ")))
(pop-to-buffer (git-revision--open-noselect commitish path object)))
(defalias 'git-revision 'git-revision-open)
(pop-to-buffer (git-walktree--open-noselect commitish path object)))
(defalias 'git-walktree 'git-walktree-open)

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

(defun git-revision--git-plumbing (&rest args)
(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-revision-git-executable
git-walktree-git-executable
nil
t
nil
@@ -2430,13 +2435,13 @@ Returns first line of output without newline."
(progn
(goto-char (point-min))
(point-at-eol))))))
(defconst git-revision-ls-tree-line-regexp
(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-revision-ls-tree-line-tree-regexp
(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.")
(defun git-revision--parse-lstree-line (str)
(defun git-walktree--parse-lstree-line (str)
"Extract object info from STR.

STR should be a string like following without newline.:
@@ -2449,41 +2454,39 @@ Returns property list like (:mode MODE :type TYPE :object OBJECT :file FILE)."
(with-temp-buffer
(insert str)
(goto-char (point-min))
(and (re-search-forward git-revision-ls-tree-line-regexp
(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)))))))
;; (plist-get (git-revision--extract-object-info "100644 blob 6fd4d58202d0b46547c6fe43de0f8c878456f966 .editorconfig") :mode)
;; (git-revision--extract-object-info "100644 blob 6fd4d58202d0b46547c6fe43de0f8c878456f966")

(defun git-revision-mode-open-this ()
(defun git-walktree-mode-open-this ()
"Open current object."
(interactive)
(let ((info (git-revision--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)))))
(if info
(switch-to-buffer (git-revision--open-noselect
git-revision-current-commitish
(git-revision--join-path (plist-get info
(switch-to-buffer (git-walktree--open-noselect
git-walktree-current-commitish
(git-walktree--join-path (plist-get info
:file))
(plist-get info
:object)))
(message "No object on current line."))))

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

(defun git-revision--parent-directory (path)
(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."
@@ -2493,55 +2496,53 @@ If PATH is equal to \".\", return nil."
nil
".")))

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

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

(defface git-revision-tree-face
(defface git-walktree-tree-face
'((t (:inherit font-lock-function-name-face)))
"Face used for tree objects."
:group 'git-revision-faces)
(defvar git-revision-tree-face 'git-revision-tree-face
:group 'git-walktree-faces)
(defvar git-walktree-tree-face 'git-walktree-tree-face
"Face used for tree objects.")

(defvar git-revision-mode-map
(defvar git-walktree-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "n" 'next-line)
(define-key map "p" 'previous-line)
(define-key map "^" 'git-revision-up)
(define-key map (kbd "C-m") 'git-revision-mode-open-this)
(define-key map "^" 'git-walktree-parent)
(define-key map (kbd "C-m") 'git-walktree-mode-open-this)
map))

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

(define-derived-mode git-revision-mode special-mode "git-revision"
"Major-mode for `git-revision-open'."
(define-derived-mode git-walktree-mode special-mode "git-walktree"
"Major-mode for `git-walktree-open'."
(set (make-local-variable 'font-lock-defaults)
'(git-revision-mode-font-lock-keywords
'(git-walktree-mode-font-lock-keywords
nil nil nil nil
))
;; (add-to-list 'font-lock-value
;; )
)

(require 'magit nil t)


Loading…
Cancel
Save