commit ba123905bee33e736ce9f4e97bf5f3e714a7d39f from: Omar Polo date: Tue Dec 08 22:23:38 2020 UTC adding vc-got-stage vc-got-stage is a minor mode for vc-diff buffers controlled by Got. It's a tentative at implementing the stage operation for specific changes instead of whole files. vc.el works with filesets, and this is fine. But sometimes you want to commit only certain hunks. This initial implementation allows the user to stage changes, but you can't commit them (yet). commit - 686eac9a1fae366933598d31881b2684f69dbeaa commit + ba123905bee33e736ce9f4e97bf5f3e714a7d39f blob - 32c1b2a61fc11dbdadc3e6c436a0c8a3a97ca4a7 blob + 083718cd6b5cd7775e19d6cef1b9ff51add91c6d --- vc-got.el +++ vc-got.el @@ -107,6 +107,8 @@ (require 'seq) (require 'vc) +(require 'vc-got-stage) + (defvar vc-got-cmd "got" "The got command.") @@ -496,6 +498,11 @@ LIMIT limits the number of commits, optionally startin (let* ((buffer (get-buffer-create (or buffer "*vc-diff*"))) (inhibit-read-only t)) (with-current-buffer buffer + (vc-got-stage-mode +1) + ;; TODO: this shouldn't be done in an unconditioned fashion. If + ;; we're diffing two revision, we can't stage hunks; we can + ;; stage only when diffing the local modifications. + (setq vc-got-stage-fileset files) (vc-got-with-worktree (car files) (cond ((and (null rev1) (null rev2)) blob - /dev/null blob + ae553d2eb00d0bbee009b3e4c80dc0443af4db4a (mode 644) --- /dev/null +++ vc-got-stage.el @@ -0,0 +1,205 @@ +;; vc-got-stage.el --- Stage changes in vc-got diff buffers -*- lexical-binding: t; -*- + +(eval-when-compile + (require 'subr-x)) + +(defgroup vc-got-stage nil + "Stage hunks in vc-got diff buffers" + :group 'faces + :prefix "vc-got-stage-") + +(defface vc-got-stage-staged-face + '((t (:foreground "red" :background "yellow"))) + "Face used to highlight the staged mark on changes." + :group 'vc-got-stage) + +(defvar vc-got-stage-fileset nil + "The files diffed in the last call to `vc-got-diff'.") + +(defvar vc-got-stage-overlay-priority 0 + "Specify overlay priority. +Higher values means higher priority. DON'T use negative numbers.") + +(defvar vc-got-stage--overlays nil + "The list of overlays.") + +(defvar vc-got-stage-prefix-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "A") #'vc-got-stage-apply) + (define-key map (kbd "b") #'vc-got-stage-beginning-of-change) + (define-key map (kbd "e") #'vc-got-stage-end-of-change) + (define-key map (kbd "n") #'vc-got-stage-next-change) + (define-key map (kbd "p") #'vc-got-stage-prev-change) + (define-key map (kbd "t") #'vc-got-stage-toggle-mark) + map) + "Keymap for function `vc-got-stage-mode'.") + +;;;###autoload +(define-minor-mode vc-got-stage-mode + "Stage hunks in vc-got diff buffers. + +\\{vc-got-stage-mode-map}" + :group vc-got-stage + :keymap (let ((map (make-sparse-keymap))) + (define-key map (kbd "C-c g") vc-got-stage-prefix-map) + map)) + +;;;###autoload (defun vc-got-stage-activate () +;;;###autoload "Activate vg-got-stage-mode if the current buffer is a vc-got diff." +;;;###autoload (when-let (root (vc-find-root default-directory ".got")) +;;;###autoload (vc-got-stage-mode +1))) + +(defun vc-got-stage-activate () + "Activate vg-got-stage-mode if the current buffer is a vc-got diff." + (message "VC got stage activate? %s" (vc-find-root default-directory ".got")) + (when-let (root (vc-find-root default-directory ".got")) + (vc-got-stage-mode +1))) + +;;;###autoload (add-hook 'diff-mode-hook #'vc-got-stage-activate) +(add-hook 'diff-mode-hook #'vc-got-stage-activate) + +(defun vc-got-stage--in-change () + "T if the point is in a line that's part of a change." + (save-excursion + (beginning-of-line) + (when-let (ch (char-after)) + (or (= ch ?\-) + (= ch ?\+))))) + +(defun vc-got-stage--change-marked-p () + "T if the current change is marked." + (let ((p (point))) + (cl-loop + for overlay in vc-got-stage--overlays + if (and (overlay-start overlay) + (= p (overlay-start overlay))) + return t + finally (return nil)))) + +(defun vc-got-stage--compute-y-or-n (buf) + "Fill BUF with ``y'' or ``n'' lines for staging purpose." + (save-excursion + (goto-char (point-min)) + (let ((p (point))) + (while (not (= p (progn (vc-got-stage-next-change) + (point)))) + (setq p (point)) + (if (vc-got-stage--change-marked-p) + (with-current-buffer buf + (insert "y\n")) + (with-current-buffer buf + (insert "n\n"))))))) + +(defun vc-got-stage--apply-impl (script tmp-file) + "Apply the stages using SCRIPT as script (TMP-FILE is the path)." + (interactive "P") + (let* ((default-directory (vc-got-root default-directory)) + (stage-buf (get-buffer-create "*vc-got-stage*"))) + (unless (zerop (apply #'process-file "got" nil stage-buf nil "unstage" + (mapcar #'file-relative-name vc-got-stage-fileset))) + (pop-to-buffer stage-buf) + (error "Got unstage failed")) + (vc-got-stage--compute-y-or-n script) + (with-current-buffer script + (save-buffer)) + (unless (zerop (apply #'process-file "got" nil stage-buf nil "stage" "-p" + "-F" tmp-file (mapcar #'file-relative-name + vc-got-stage-fileset))) + (pop-to-buffer stage-buf) + (error "Got stage failed")))) + +(defun vc-got-stage-apply () + "Apply the stages. +This will first reset the stages of all the involved files, then +stage the marked changes." + (interactive) + (let* ((tmp-file (make-temp-file "vc-got-stage-script")) + (script (find-file-noselect tmp-file))) + (unwind-protect + (vc-got-stage--apply-impl script tmp-file) + (kill-buffer script) + (delete-file tmp-file)))) + +(defun vc-got-stage-beginning-of-change () + "Goto the beginning of the current change." + (interactive) + (ignore-errors + (beginning-of-line) + (while (vc-got-stage--in-change) + (forward-line -1)) + (forward-line))) + +(defun vc-got-stage-end-of-change () + "Goto the end of the current change." + (interactive) + (ignore-errors + (beginning-of-line) + (while (vc-got-stage--in-change) + (forward-line)) + (forward-line -1))) + +(defun vc-got-stage--prevnext-change (n) + "Goto next/previous change by N." + (let ((start (point))) + (beginning-of-line) + (while (and (not (= (point) (if (= n -1) + (point-min) + (point-max)))) + (vc-got-stage--in-change)) + (forward-line n)) + (while (let ((face (get-text-property (point) 'face))) + (and (not (= (point) (if (= n -1) + (point-min) + (point-max)))) + (or (eq face 'diff-hunk-header) + (eq face 'diff-header) + (eq face 'diff-context)))) + (forward-line n)) + (if (= n -1) + (vc-got-stage-beginning-of-change)) + (unless (vc-got-stage--in-change) + (goto-char start) + (message "No prev/next change")))) + +(defun vc-got-stage-prev-change () + "Goto previous change." + (interactive) + (vc-got-stage--prevnext-change -1)) + +(defun vc-got-stage-next-change () + "Goto next change." + (interactive) + (vc-got-stage--prevnext-change +1)) + +(defun vc-got-stage--delete-overlay-at (point) + "Delete overlays at POINT. +Return t if something was deleted." + (let (delp) + (cl-delete-if (lambda (overlay) + (let ((start (overlay-start overlay))) + ;; silently drop dangling overlays + (cond ((not start) + t) + ((= point start) + (delete-overlay overlay) + (setq delp t))))) + vc-got-stage--overlays) + delp)) + +(defun vc-got-stage-toggle-mark () + "Toggle the staged status on the change at point." + (interactive) + (when (vc-got-stage--in-change) + (save-excursion + (vc-got-stage-beginning-of-change) + (unless (vc-got-stage--delete-overlay-at (point)) + (let ((overlay (make-overlay (point) (point)))) + (overlay-put overlay + 'before-string + (propertize "A" + 'display '(left-fringe right-triangle) + 'face 'vc-got-stage-staged-face)) + (push overlay vc-got-stage--overlays)))))) + +(provide 'vc-got-stage) +;;; vc-got-stage.el ends here