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