diff --git a/emacs.el b/emacs.el index 3efe5fe..fe714a8 100644 --- a/emacs.el +++ b/emacs.el @@ -2263,12 +2263,6 @@ use for the buffer. It defaults to \"*recetf-show*\"." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; git walktree -;; TODO: Fix variable names -;; commit-sha1 for commit sha1 (allow abbreviated) -;; commit-full-sha1 for commit sha1 in 40 chars -;; object-full-sha1 for object sha1 in 40 chars -;; Do not use something like "-id" in name - (defgroup git-walktree nil "Git Walktree." :tag "GitWalktree" @@ -2288,9 +2282,8 @@ This path is always relative to repository root.") "Psudo filename of current buffer.") (make-variable-buffer-local 'git-walktree-buffer-file-name) -;; TODO: -> object-full-sha1 (defvar git-walktree-object-full-sha1 nil - "Object id of current buffer.") + "Object name in full sha1 format of current buffer.") (make-variable-buffer-local 'git-walktree-object-full-sha1) (defvar git-walktree-repository-root nil @@ -2325,7 +2318,7 @@ TYPE is target object type." (string= type "tree")) (with-current-buffer (or git-walktree-tree-buffer-for-reuse (setq git-walktree-tree-buffer-for-reuse - (get-buffer-create "*gitwalktree*"))) + (generate-new-buffer "gitwalktreebuf"))) (setq git-walktree-repository-root root) (rename-buffer name t) (current-buffer)) @@ -2349,6 +2342,7 @@ It also copy text overlays." (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)) @@ -2360,7 +2354,9 @@ It also copy text overlays." (require 'ansi-color) (defun git-walktree--open-treeish (committish path treeish) - "Open git tree buffer of 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 @@ -2374,10 +2370,10 @@ It also copy text overlays." (with-current-buffer buf (unless (and (string= treeish git-walktree-object-full-sha1) - (or (string= committish - git-walktree-current-committish) - (eq committish - git-walktree-current-committish))) + (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) @@ -2425,7 +2421,7 @@ It also copy text overlays." (cd dir))) (when (= (point) (point-min)) (goto-char point-tree-start) - (git-walktree-mode--goto-file) + (git-walktree-mode--move-to-file) ) )) buf)) @@ -2446,7 +2442,8 @@ Result will be inserted into current buffer." args)))) ?w (defun git-walktree--open-blob (committish path blob) - "Open BLOB object." + "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) @@ -2505,8 +2502,8 @@ When PATH is omitted or nil, it is calculated from current file or directory." (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 "\\`/" path))) - (cl-assert (not (string-match "/\\'" path))) + (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) @@ -2520,9 +2517,9 @@ When PATH is omitted or nil, it is calculated from current file or directory." ;; TODO: Store view history (defun git-walktree--open-noselect (committish path object) - "Open git tree buffer of COMMITTISH. + "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 full sha1 object id of +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" @@ -2533,8 +2530,8 @@ COMMITTISH:PATH without checking it." (setq path (or path ".")) ;; PATH must not start with and end with slashes - (cl-assert (not (string-match "\\`/" path))) - (cl-assert (not (string-match "/\\'" path))) + (cl-assert (not (string-match-p "\\`/" path))) + (cl-assert (not (string-match-p "/\\'" path))) (setq object (or object (git-walktree--resolve-object committish path))) @@ -2554,11 +2551,13 @@ COMMITTISH:PATH without checking it." (error "Type cannot handle: %s" type))))) (defun git-walktree--resolve-object (committish path) - "Return object id of COMMITISIH:PATH. -If path is equal to \".\" return COMMITTISH's tree object + "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" @@ -2570,13 +2569,12 @@ PATH will be always treated as relative to repository root." path)))) (plist-get info :object)))) -(defun git-walktree-open (committish &optional path object) +(defun git-walktree-open (committish &optional path) "Open git tree buffer of COMMITTISH. -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 COMMITTISH:PATH without -checking it." +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." (interactive (list (magit-read-branch-or-commit "Revision: "))) - (switch-to-buffer (git-walktree--open-noselect committish path object))) + (switch-to-buffer (git-walktree--open-noselect-safe-path committish path))) (defalias 'git-walktree 'git-walktree-open) (defun git-walktree--path-in-repository (path) @@ -2596,7 +2594,7 @@ checking it." (defcustom git-walktree-try-cd t "Try to cd if directory exists in current working directory if non-nil. -Otherwise buffer's `default-directory' is always repository root." +Otherwise use repository root for gitwalktree buffer's `default-directory'." :type 'boolean :group 'git-walktree) @@ -2605,10 +2603,8 @@ Otherwise buffer's `default-directory' is always repository root." :type 'boolean :group 'git-walktree) -(defcustom git-walktree-tree-buffer-for-reuse nil - "Buffer to use when `git-walktree-reuse-tree-buffer' is non-nil." - :type 'string - :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. @@ -2630,6 +2626,7 @@ Returns first line of output without newline." (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.") @@ -2661,7 +2658,7 @@ Returns property list like (:mode MODE :type TYPE :object OBJECT :file FILE)." :file (match-string 4))))))) (defun git-walktree-mode-open-this () - "Open current object." + "Open git object of current line." (interactive) (let ((info (git-walktree--parse-lstree-line (buffer-substring-no-properties (point-at-bol) (point-at-eol))))) @@ -2721,8 +2718,7 @@ If not given, value of current buffer will be used." nil)) (message "Cannot find parent directory for current tree.")))) -;; TODO: -> -move-to -(defun git-walktree-mode--goto-file () +(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." @@ -2739,7 +2735,7 @@ This function do nothing when current line is not ls-tree output." (interactive "^p\np") (or arg (setq arg 1)) (line-move arg nil nil try-vscroll) - (git-walktree-mode--goto-file) + (git-walktree-mode--move-to-file) ) (defun git-walktree-mode-previous-line (&optional arg try-vscroll) @@ -2747,7 +2743,7 @@ This function do nothing when current line is not ls-tree output." (interactive "^p\np") (or arg (setq arg 1)) (line-move (- arg) nil nil try-vscroll) - (git-walktree-mode--goto-file) + (git-walktree-mode--move-to-file) ) (defgroup git-walktree-faces nil @@ -2767,11 +2763,12 @@ This function do nothing when current line is not ls-tree output." :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.") + "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 SHA-1 object name." +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) @@ -2781,12 +2778,12 @@ PARENT should be a full SHA-1 object name." 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 SHA-1 object name." +PARENT should be a full sha1 object name." (gethash parent git-walktree-known-child-revisions)) -;; https://stackoverflow.com/a/9870218 -;; git log --reverse --pretty=format:%H -n 1 --ancestry-path ..HEAD (defun git-walktree--choose-committish (prompt-format collection) "Emit PROMPT-FORMAT and ask user to which committish of COLLECTION to use. @@ -2807,12 +2804,12 @@ When collection has just one element, return the first element without asking." If current path was not found in the parent revision try to go up path." (interactive) (cl-assert git-walktree-current-committish) - (let* ((commitid (git-walktree--git-plumbing "rev-parse" - git-walktree-current-committish)) - (parents (git-walktree--parent-commitid commitid))) + (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 - commitid)) + commit-full-sha1)) (if (< (length parents) 1) (message "This revision has no parent revision") @@ -2823,7 +2820,7 @@ If current path was not found in the parent revision try to go up path." (switch-to-buffer (git-walktree--open-noselect-safe-path parent path)))))) -(defun git-walktree--parent-commitid (committish) +(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" @@ -2834,15 +2831,13 @@ If current path was not found in the parent revision try to go up path." "--pretty=format:%P" committish))) (split-string parents))) -;; (git-walktree--parent-sha1 "HEAD") -;; (git-walktree--parent-sha1 "ae4b80f") (defun git-walktree-known-child-revision () "Open known revision of current path." (interactive) - (let* ((commitid (git-walktree--git-plumbing "rev-parse" - git-walktree-current-committish)) - (children (git-walktree--get-children commitid))) + (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")