1 changed files with 0 additions and 630 deletions
Unified View
Diff Options
-
+0 -630emacs.el
+ 0
- 630
emacs.el
View File
| @@ -2142,636 +2142,6 @@ use for the buffer. It defaults to \"*recetf-show*\"." | |||||
| (define-key ctl-x-map (kbd "C-r") 'recently-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 | ;; git-worktree | ||||