1 6b6c8a78 2021-01-04 op ;;; vc-got-stage.el --- Stage functionalities for vc-got  -*- lexical-binding: t; -*-
  2 6b6c8a78 2021-01-04 op 
  3 6b6c8a78 2021-01-04 op ;; Copyright (C) 2021  Omar Polo
  4 6b6c8a78 2021-01-04 op 
  5 6b6c8a78 2021-01-04 op ;; Author: Omar Polo <op@omarpolo.com>
  6 6b6c8a78 2021-01-04 op ;; Keywords: vc
  7 6b6c8a78 2021-01-04 op 
  8 6b6c8a78 2021-01-04 op ;; This program is free software; you can redistribute it and/or modify
  9 6b6c8a78 2021-01-04 op ;; it under the terms of the GNU General Public License as published by
 10 6b6c8a78 2021-01-04 op ;; the Free Software Foundation, either version 3 of the License, or
 11 6b6c8a78 2021-01-04 op ;; (at your option) any later version.
 12 6b6c8a78 2021-01-04 op 
 13 6b6c8a78 2021-01-04 op ;; This program is distributed in the hope that it will be useful,
 14 6b6c8a78 2021-01-04 op ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 15 6b6c8a78 2021-01-04 op ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 16 6b6c8a78 2021-01-04 op ;; GNU General Public License for more details.
 17 6b6c8a78 2021-01-04 op 
 18 6b6c8a78 2021-01-04 op ;; You should have received a copy of the GNU General Public License
 19 6b6c8a78 2021-01-04 op ;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
 20 6b6c8a78 2021-01-04 op 
 21 6b6c8a78 2021-01-04 op ;;; Commentary:
 22 6b6c8a78 2021-01-04 op 
 23 6b6c8a78 2021-01-04 op ;; Stage-related functions for vc-got.  This allows vc-got to stage
 24 6b6c8a78 2021-01-04 op ;; and commit individual chunks and not entire filesets.
 25 6b6c8a78 2021-01-04 op 
 26 6b6c8a78 2021-01-04 op ;;; Code:
 27 6b6c8a78 2021-01-04 op 
 28 daae979d 2021-01-04 op (require 'log-edit)
 29 eacbf767 2021-01-04 op (require 'rx)
 30 6b6c8a78 2021-01-04 op (require 'vc)
 31 6b6c8a78 2021-01-04 op 
 32 6b6c8a78 2021-01-04 op (defvar vc-got-program)                 ;vc-got.el
 33 6b6c8a78 2021-01-04 op (declare-function vc-got--diff    "vc-got")
 34 6b6c8a78 2021-01-04 op (declare-function vc-got--unstage "vc-got" (file))
 35 a323f603 2021-01-04 op (declare-function vc-got--status  "vc-got" (status-codes dir &rest files))
 36 daae979d 2021-01-04 op (declare-function vc-got-checkin  "vc-got" (fileset comment))
 37 a323f603 2021-01-04 op (declare-function vc-got-root     "vc-got" (dir-or-file))
 38 6b6c8a78 2021-01-04 op 
 39 6b6c8a78 2021-01-04 op (defvar vc-got-stage--process nil
 40 6b6c8a78 2021-01-04 op   "The got stage process.")
 41 6b6c8a78 2021-01-04 op 
 42 6b6c8a78 2021-01-04 op (defvar vc-got-stage--fileset nil
 43 6b6c8a78 2021-01-04 op   "Remaining fileset to process.")
 44 6b6c8a78 2021-01-04 op 
 45 6b6c8a78 2021-01-04 op (defun vc-got-stage--assert-proc ()
 46 6b6c8a78 2021-01-04 op   "Assert no vc-got-stage process is running."
 47 6b6c8a78 2021-01-04 op   (when (process-live-p vc-got-stage--process)
 48 6b6c8a78 2021-01-04 op     (error "A vc-got-stage-files is already in progress")))
 49 6b6c8a78 2021-01-04 op 
 50 6b6c8a78 2021-01-04 op (defun vc-got-stage-files (fileset)
 51 6b6c8a78 2021-01-04 op   "Interactively stage hunks from files in FILESET."
 52 6b6c8a78 2021-01-04 op   (interactive (list (cadr (vc-deduce-fileset))))
 53 6b6c8a78 2021-01-04 op   (vc-got-stage--assert-proc)
 54 6b6c8a78 2021-01-04 op   (if (not fileset)
 55 6b6c8a78 2021-01-04 op       (message "[vc-got] nothing to stage.")
 56 6b6c8a78 2021-01-04 op     (setq vc-got-stage--fileset fileset)
 57 6b6c8a78 2021-01-04 op     (vc-got-stage--next)))
 58 6b6c8a78 2021-01-04 op 
 59 6b6c8a78 2021-01-04 op (defun vc-got-stage--next ()
 60 6b6c8a78 2021-01-04 op   "Process next file in stage list."
 61 6b6c8a78 2021-01-04 op   (vc-got-stage--assert-proc)
 62 6b6c8a78 2021-01-04 op   (let ((file (car vc-got-stage--fileset)))
 63 6b6c8a78 2021-01-04 op     (if (not file)
 64 6b6c8a78 2021-01-04 op         (progn (kill-buffer (process-buffer vc-got-stage--process))
 65 6b6c8a78 2021-01-04 op                (message "[vc-got] stage done."))
 66 6b6c8a78 2021-01-04 op       (setq vc-got-stage--fileset (cdr vc-got-stage--fileset))
 67 6b6c8a78 2021-01-04 op       (let ((buf (get-buffer-create "*vc-got-stage*")))
 68 6b6c8a78 2021-01-04 op         (pop-to-buffer buf)
 69 6b6c8a78 2021-01-04 op         (with-current-buffer buf
 70 6b6c8a78 2021-01-04 op           (buffer-disable-undo)
 71 6b6c8a78 2021-01-04 op           (erase-buffer)
 72 6b6c8a78 2021-01-04 op           (read-only-mode)
 73 6b6c8a78 2021-01-04 op           (unless (derived-mode-p 'diff-mode)
 74 6b6c8a78 2021-01-04 op             (diff-mode)))
 75 6b6c8a78 2021-01-04 op         (setq vc-got-stage--process
 76 6b6c8a78 2021-01-04 op               (make-process :name "got"
 77 6b6c8a78 2021-01-04 op                             :buffer buf
 78 6b6c8a78 2021-01-04 op                             :command (list vc-got-program "stage" "-p" file)
 79 6b6c8a78 2021-01-04 op                             :connection 'pty
 80 6b6c8a78 2021-01-04 op                             :filter #'vc-got-stage--filter
 81 6b6c8a78 2021-01-04 op                             :sentinel #'vc-got-stage--sentinel))))))
 82 6b6c8a78 2021-01-04 op 
 83 0d57aba1 2021-01-04 op (defun vc-got-stage--kill-separators ()
 84 0d57aba1 2021-01-04 op   "Kill the separator lines in interactive got stage."
 85 0d57aba1 2021-01-04 op   (save-excursion
 86 0d57aba1 2021-01-04 op     (forward-line -2)
 87 0d57aba1 2021-01-04 op     (kill-line)
 88 0d57aba1 2021-01-04 op     (goto-char (point-min))
 89 0d57aba1 2021-01-04 op     (kill-line)))
 90 0d57aba1 2021-01-04 op 
 91 6b6c8a78 2021-01-04 op (defun vc-got-stage--filter (proc string)
 92 6b6c8a78 2021-01-04 op   "Filter for got stage process.
 93 6b6c8a78 2021-01-04 op PROC is the process, STRING part of its output."
 94 6b6c8a78 2021-01-04 op   (let ((buf (process-buffer proc)))
 95 6b6c8a78 2021-01-04 op     (when (buffer-live-p buf)
 96 6b6c8a78 2021-01-04 op       (let ((inhibit-read-only t))
 97 6b6c8a78 2021-01-04 op         (with-current-buffer buf
 98 6b6c8a78 2021-01-04 op           (goto-char (point-max))
 99 6b6c8a78 2021-01-04 op           (insert string)
100 6b6c8a78 2021-01-04 op           (save-excursion
101 6b6c8a78 2021-01-04 op             (beginning-of-line)
102 eacbf767 2021-01-04 op             (when (looking-at (rx bol
103 eacbf767 2021-01-04 op                                   (group (zero-or-one "un")
104 eacbf767 2021-01-04 op                                          "stage"
105 eacbf767 2021-01-04 op                                          (zero-or-more anychar)
106 eacbf767 2021-01-04 op                                          "?")))
107 eacbf767 2021-01-04 op               (let ((msg (match-string 1)))
108 0d57aba1 2021-01-04 op                 (kill-line)             ; kill the question
109 0d57aba1 2021-01-04 op                 (vc-got-stage--kill-separators)
110 c8194594 2021-01-05 op                 (process-send-string buf
111 c8194594 2021-01-05 op                                      (condition-case nil
112 c8194594 2021-01-05 op                                          (if (y-or-n-p msg) "y\n" "n\n")
113 c8194594 2021-01-05 op                                        (quit "q\n")))
114 6b6c8a78 2021-01-04 op                 (erase-buffer)))))))))
115 6b6c8a78 2021-01-04 op 
116 6b6c8a78 2021-01-04 op (defun vc-got-stage--sentinel (_proc event)
117 6b6c8a78 2021-01-04 op   "Sentinel for got stage process.
118 6b6c8a78 2021-01-04 op Should be only called when EVENT is finished."
119 6b6c8a78 2021-01-04 op   (when (string= event "finished\n")
120 6b6c8a78 2021-01-04 op     (vc-got-stage--next)))
121 6b6c8a78 2021-01-04 op 
122 6b6c8a78 2021-01-04 op ;; TODO: make this interactive just as stage is
123 6b6c8a78 2021-01-04 op (defun vc-got-stage-unstage (fileset)
124 6b6c8a78 2021-01-04 op   "Unstage staged hunks in FILESET."
125 6b6c8a78 2021-01-04 op   (interactive (list (cadr (vc-deduce-fileset))))
126 6b6c8a78 2021-01-04 op   (vc-got-stage--assert-proc)
127 6b6c8a78 2021-01-04 op   (if fileset
128 6b6c8a78 2021-01-04 op       (dolist (file fileset)
129 6b6c8a78 2021-01-04 op         (vc-got--unstage file))
130 6b6c8a78 2021-01-04 op     (vc-got--unstage nil)))
131 6b6c8a78 2021-01-04 op 
132 6b6c8a78 2021-01-04 op (defun vc-got-stage-diff (fileset)
133 6b6c8a78 2021-01-04 op   "Pop a buffer with the staged diff for FILESET.
134 6b6c8a78 2021-01-04 op If FILESET is nil, show the diff for every staged hunks."
135 6b6c8a78 2021-01-04 op   (interactive (list (cadr (vc-deduce-fileset))))
136 6b6c8a78 2021-01-04 op   (with-current-buffer (get-buffer-create "*vc-diff*")
137 6b6c8a78 2021-01-04 op     (pop-to-buffer (current-buffer))
138 6b6c8a78 2021-01-04 op     (let ((inhibit-read-only t))
139 6b6c8a78 2021-01-04 op       (erase-buffer)
140 6b6c8a78 2021-01-04 op       (diff-mode)
141 6b6c8a78 2021-01-04 op       (if fileset
142 6b6c8a78 2021-01-04 op           (dolist (file fileset)
143 6b6c8a78 2021-01-04 op             (vc-got--diff "-s" file))
144 6b6c8a78 2021-01-04 op         (vc-got--diff "-s")))))
145 6b6c8a78 2021-01-04 op 
146 daae979d 2021-01-04 op (defun vc-got-stage-commit ()
147 daae979d 2021-01-04 op   "Commit staged hunks."
148 daae979d 2021-01-04 op   (interactive)
149 93562d9b 2021-01-04 op   (let* ((default-directory (vc-got-root default-directory))
150 93562d9b 2021-01-04 op          (buf (get-buffer-create "*vc-got-stage-commit*"))
151 a7777eaa 2021-01-05 op          (status (vc-got--status "MAD" "."))
152 a323f603 2021-01-04 op          (staged-files (cl-loop for (file _ staged) in status
153 a323f603 2021-01-04 op                                 when staged
154 a323f603 2021-01-04 op                                 collect file)))
155 daae979d 2021-01-04 op     (pop-to-buffer buf)
156 daae979d 2021-01-04 op     (log-edit (lambda ()
157 daae979d 2021-01-04 op                 (interactive)
158 daae979d 2021-01-04 op                 (let ((msg (buffer-substring-no-properties (point-min)
159 daae979d 2021-01-04 op                                                            (point-max))))
160 daae979d 2021-01-04 op                   (kill-buffer)
161 daae979d 2021-01-04 op                   (vc-got-checkin nil msg)))
162 daae979d 2021-01-04 op               t
163 a323f603 2021-01-04 op               `((log-edit-listfun . ,(lambda ()
164 a323f603 2021-01-04 op                                        (mapcar #'file-relative-name
165 a323f603 2021-01-04 op                                                staged-files)))))))
166 daae979d 2021-01-04 op 
167 6b6c8a78 2021-01-04 op (provide 'vc-got-stage)
168 6b6c8a78 2021-01-04 op ;;; vc-got-stage.el ends here