1 ;;; vc-got-stage.el --- Stage functionalities for vc-got  -*- lexical-binding: t; -*-
2 
3 ;; Copyright (C) 2021  Omar Polo
4 
5 ;; Author: Omar Polo <op@omarpolo.com>
6 ;; Keywords: vc
7 
8 ;; This program is free software; you can redistribute it and/or modify
9 ;; it under the terms of the GNU General Public License as published by
10 ;; the Free Software Foundation, either version 3 of the License, or
11 ;; (at your option) any later version.
12 
13 ;; This program is distributed in the hope that it will be useful,
14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
16 ;; GNU General Public License for more details.
17 
18 ;; You should have received a copy of the GNU General Public License
19 ;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
20 
21 ;;; Commentary:
22 
23 ;; Stage-related functions for vc-got.  This allows vc-got to stage
24 ;; and commit individual chunks and not entire filesets.
25 
26 ;;; Code:
27 
28 (require 'vc)
29 
30 (defvar vc-got-program)                 ;vc-got.el
31 (declare-function vc-got--diff    "vc-got")
32 (declare-function vc-got--unstage "vc-got" (file))
33 
34 (defvar vc-got-stage--process nil
35   "The got stage process.")
36 
37 (defvar vc-got-stage--fileset nil
38   "Remaining fileset to process.")
39 
40 (defun vc-got-stage--assert-proc ()
41   "Assert no vc-got-stage process is running."
42   (when (process-live-p vc-got-stage--process)
43     (error "A vc-got-stage-files is already in progress")))
44 
45 (defun vc-got-stage-files (fileset)
46   "Interactively stage hunks from files in FILESET."
47   (interactive (list (cadr (vc-deduce-fileset))))
48   (vc-got-stage--assert-proc)
49   (if (not fileset)
50       (message "[vc-got] nothing to stage.")
51     (setq vc-got-stage--fileset fileset)
52     (vc-got-stage--next)))
53 
54 (defun vc-got-stage--next ()
55   "Process next file in stage list."
56   (vc-got-stage--assert-proc)
57   (let ((file (car vc-got-stage--fileset)))
58     (if (not file)
59         (progn (kill-buffer (process-buffer vc-got-stage--process))
60                (message "[vc-got] stage done."))
61       (setq vc-got-stage--fileset (cdr vc-got-stage--fileset))
62       (let ((buf (get-buffer-create "*vc-got-stage*")))
63         (pop-to-buffer buf)
64         (with-current-buffer buf
65           (buffer-disable-undo)
66           (erase-buffer)
67           (read-only-mode)
68           (unless (derived-mode-p 'diff-mode)
69             (diff-mode)))
70         (setq vc-got-stage--process
71               (make-process :name "got"
72                             :buffer buf
73                             :command (list vc-got-program "stage" "-p" file)
74                             :connection 'pty
75                             :filter #'vc-got-stage--filter
76                             :sentinel #'vc-got-stage--sentinel))))))
77 
78 (defun vc-got-stage--filter (proc string)
79   "Filter for got stage process.
80 PROC is the process, STRING part of its output."
81   (let ((buf (process-buffer proc)))
82     (when (buffer-live-p buf)
83       (let ((inhibit-read-only t))
84         (with-current-buffer buf
85           (goto-char (point-max))
86           (insert string)
87           (save-excursion
88             (beginning-of-line)
89             (let ((msg (cond ((looking-at "^stage this change?")
90                               "Stage this change? ")
91                              ((looking-at "^stage this addition?")
92                               "Stage this addition? "))))
93               (when msg
94                 (kill-line)
95                 (process-send-string buf (if (y-or-n-p msg) "y\n" "n\n"))
96                 (erase-buffer)))))))))
97 
98 (defun vc-got-stage--sentinel (_proc event)
99   "Sentinel for got stage process.
100 Should be only called when EVENT is finished."
101   (when (string= event "finished\n")
102     (vc-got-stage--next)))
103 
104 ;; TODO: make this interactive just as stage is
105 (defun vc-got-stage-unstage (fileset)
106   "Unstage staged hunks in FILESET."
107   (interactive (list (cadr (vc-deduce-fileset))))
108   (vc-got-stage--assert-proc)
109   (if fileset
110       (dolist (file fileset)
111         (vc-got--unstage file))
112     (vc-got--unstage nil)))
113 
114 (defun vc-got-stage-diff (fileset)
115   "Pop a buffer with the staged diff for FILESET.
116 If FILESET is nil, show the diff for every staged hunks."
117   (interactive (list (cadr (vc-deduce-fileset))))
118   (with-current-buffer (get-buffer-create "*vc-diff*")
119     (pop-to-buffer (current-buffer))
120     (let ((inhibit-read-only t))
121       (erase-buffer)
122       (diff-mode)
123       (if fileset
124           (dolist (file fileset)
125             (vc-got--diff "-s" file))
126         (vc-got--diff "-s")))))
127 
128 (provide 'vc-got-stage)
129 ;;; vc-got-stage.el ends here