commit - 686eac9a1fae366933598d31881b2684f69dbeaa
commit + ba123905bee33e736ce9f4e97bf5f3e714a7d39f
blob - 32c1b2a61fc11dbdadc3e6c436a0c8a3a97ca4a7
blob + 083718cd6b5cd7775e19d6cef1b9ff51add91c6d
--- vc-got.el
+++ vc-got.el
(require 'seq)
(require 'vc)
+(require 'vc-got-stage)
+
(defvar vc-got-cmd "got"
"The got command.")
(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
+;; 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
