From 06ea4745e9240459a29ffda02e8423313be4ede8 Mon Sep 17 00:00:00 2001 From: 10sr <8.slashes@gmail.com> Date: Fri, 7 Dec 2018 12:54:31 +0900 Subject: [PATCH] Remove git-walktree from el --- emacs.el | 630 ------------------------------------------------------- 1 file changed, 630 deletions(-) diff --git a/emacs.el b/emacs.el index 506c4b2..065033b 100644 --- a/emacs.el +++ b/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 ..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