Blame


1 00713762 2021-08-17 op ;;; vc-got.el --- VC backend for Game of Trees VCS -*- lexical-binding: t; -*-
2 af5ef7cd 2020-11-29 op
3 4b3c0c67 2021-08-17 op ;; Copyright (C) 2020, 2021 Omar Polo
4 4b3c0c67 2021-08-17 op ;; Copyright (C) 2020, 2021 Timo Myyrä
5 af5ef7cd 2020-11-29 op
6 76d978fa 2021-01-05 op ;; Author: Omar Polo <op@omarpolo.com>
7 4b3c0c67 2021-08-17 op ;; Timo Myyrä <timo.myyra@bittivirhe.fi>
8 d3ca33b4 2021-08-16 op ;; URL: https://git.omarpolo.com/vc-got/
9 61b9a83b 2021-08-17 op ;; Keywords: vc tools
10 d3ca33b4 2021-08-16 op ;; Version: 0
11 3efc7598 2021-09-09 op ;; Package-Requires: ((emacs "25.1"))
12 af5ef7cd 2020-11-29 op
13 406d7b4d 2020-12-26 op ;; This program is free software; you can redistribute it and/or modify
14 406d7b4d 2020-12-26 op ;; it under the terms of the GNU General Public License as published by
15 406d7b4d 2020-12-26 op ;; the Free Software Foundation, either version 3 of the License, or
16 406d7b4d 2020-12-26 op ;; (at your option) any later version.
17 af5ef7cd 2020-11-29 op
18 406d7b4d 2020-12-26 op ;; This program is distributed in the hope that it will be useful,
19 406d7b4d 2020-12-26 op ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 406d7b4d 2020-12-26 op ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 406d7b4d 2020-12-26 op ;; GNU General Public License for more details.
22 af5ef7cd 2020-11-29 op
23 406d7b4d 2020-12-26 op ;; You should have received a copy of the GNU General Public License
24 406d7b4d 2020-12-26 op ;; along with this program. If not, see <https://www.gnu.org/licenses/>.
25 406d7b4d 2020-12-26 op
26 7726b6c9 2021-08-10 op ;;; Commentary:
27 af5ef7cd 2020-11-29 op
28 186da174 2021-08-17 op ;; This file contains a VC backend for the Game of Trees (got) version
29 186da174 2021-08-17 op ;; control system.
30 186da174 2021-08-17 op
31 af5ef7cd 2020-11-29 op ;; Backend implementation status
32 af5ef7cd 2020-11-29 op ;;
33 af5ef7cd 2020-11-29 op ;; Function marked with `*' are required, those with `-' are optional.
34 af5ef7cd 2020-11-29 op ;;
35 af5ef7cd 2020-11-29 op ;; FUNCTION NAME STATUS
36 af5ef7cd 2020-11-29 op ;;
37 af5ef7cd 2020-11-29 op ;; BACKEND PROPERTIES:
38 af5ef7cd 2020-11-29 op ;; * revision-granularity DONE
39 af5ef7cd 2020-11-29 op ;; - update-on-retrieve-tag XXX: what should this do?
40 af5ef7cd 2020-11-29 op ;;
41 af5ef7cd 2020-11-29 op ;; STATE-QUERYING FUNCTIONS:
42 af5ef7cd 2020-11-29 op ;; * registered DONE
43 af5ef7cd 2020-11-29 op ;; * state DONE
44 af5ef7cd 2020-11-29 op ;; - dir-status-files DONE
45 a8466f02 2020-12-07 op ;; - dir-extra-headers DONE
46 2d83de2e 2021-01-05 op ;; - dir-printer DONE
47 af5ef7cd 2020-11-29 op ;; - status-fileinfo-extra NOT IMPLEMENTED
48 af5ef7cd 2020-11-29 op ;; * working-revision DONE
49 af5ef7cd 2020-11-29 op ;; * checkout-model DONE
50 694534b4 2020-12-05 op ;; - mode-line-string DONE
51 23a0b465 2020-11-30 op ;;
52 23a0b465 2020-11-30 op ;; STATE-CHANGING FUNCTIONS:
53 23a0b465 2020-11-30 op ;; * create-repo NOT IMPLEMENTED
54 eb85ad27 2020-12-05 op ;; I don't think got init does what this function is supposed to
55 eb85ad27 2020-12-05 op ;; do.
56 23a0b465 2020-11-30 op ;; * register DONE
57 23a0b465 2020-11-30 op ;; - responsible-p DONE
58 3ec8a8b4 2021-08-17 op ;; - receive-file NOT NEEDED, default `register' is fine
59 241a3b12 2021-08-11 op ;; - unregister DONE
60 23a0b465 2020-11-30 op ;; * checkin DONE
61 23a0b465 2020-11-30 op ;; * find-revision DONE
62 eb85ad27 2020-12-05 op ;; * checkout NOT IMPLEMENTED
63 eb85ad27 2020-12-05 op ;; I'm not sure how to properly implement this. Does filling
64 eb85ad27 2020-12-05 op ;; FILE with the find-revision do the trick? Or use got update?
65 eb85ad27 2020-12-05 op ;; * revert DONE
66 eb85ad27 2020-12-05 op ;; - merge-file NOT IMPLEMENTED
67 eb85ad27 2020-12-05 op ;; - merge-branch DONE
68 eb85ad27 2020-12-05 op ;; - merge-news NOT IMPLEMENTED
69 eb85ad27 2020-12-05 op ;; - pull DONE
70 686eac9a 2020-12-07 op ;; - push DONE
71 3cdb0759 2020-01-03 47739920+ ;; - steal-lock NOT NEEDED, `got' is not using locks
72 eb85ad27 2020-12-05 op ;; - modify-change-comment NOT IMPLEMENTED
73 eb85ad27 2020-12-05 op ;; can be implemented via histedit, if I understood correctly
74 eb85ad27 2020-12-05 op ;; what it is supposed to do.
75 ae2ad572 2021-08-17 op ;; - mark-resolved NOT NEEDED
76 ae2ad572 2021-08-17 op ;; got notice by itself when a file doesn't have any pending
77 ae2ad572 2021-08-17 op ;; conflicts to be resolved.
78 ae2ad572 2021-08-17 op ;; - find-admin-dir NOT NEEDED
79 eb85ad27 2020-12-05 op ;;
80 eb85ad27 2020-12-05 op ;; HISTORY FUNCTIONS
81 eb85ad27 2020-12-05 op ;; * print-log DONE
82 9ad1eb5d 2020-12-07 op ;; * log-outgoing DONE
83 6eda2f1f 2020-12-26 op ;; * log-incoming DONE
84 eb85ad27 2020-12-05 op ;; - log-search DONE
85 0a3316a6 2021-02-22 op ;; - log-view-mode DONE
86 6eda2f1f 2020-12-26 op ;; - show-log-entry NOT IMPLEMENTED
87 6eda2f1f 2020-12-26 op ;; - comment-history NOT IMPLEMENTED
88 6eda2f1f 2020-12-26 op ;; - update-changelog NOT IMPLEMENTED
89 7c257a7b 2020-12-31 noreply ;; * diff DONE
90 5fb2f474 2021-08-10 op ;; - revision-completion-table DONE
91 3f25d9ff 2020-01-02 noreply ;; - annotate-command DONE
92 3f25d9ff 2020-01-02 noreply ;; - annotate-time DONE
93 424f5152 2021-08-10 op ;; - annotate-current-time NOT NEEDED
94 424f5152 2021-08-10 op ;; the default time handling is enough.
95 3f25d9ff 2020-01-02 noreply ;; - annotate-extract-revision-at-line DONE
96 7c257a7b 2020-12-31 noreply ;; - region-history NOT IMPLEMENTED
97 7c257a7b 2020-12-31 noreply ;; - region-history-mode NOT IMPLEMENTED
98 7c257a7b 2020-12-31 noreply ;; - mergebase NOT IMPLEMENTED
99 7c257a7b 2020-12-31 noreply ;;
100 7c257a7b 2020-12-31 noreply ;; TAG SYSTEM
101 6ab1c7b4 2021-08-11 op ;; - create-tag DONE
102 09d59379 2021-08-11 op ;; - retrieve-tag DONE
103 7c257a7b 2020-12-31 noreply ;;
104 7c257a7b 2020-12-31 noreply ;; MISCELLANEOUS NOT IMPLEMENTED
105 3cdb0759 2020-01-03 47739920+ ;; - make-version-backups-p NOT NEEDED, `got' works fine locally
106 7c257a7b 2020-12-31 noreply ;; - root DONE
107 49945a03 2021-08-11 op ;; - ignore NOT NEEDED, the default action is good
108 49945a03 2021-08-11 op ;; - ignore-completion-table NOT NEEDED, the default action is good
109 2552a6c7 2021-08-11 op ;; - find-ignore-file DONE
110 3f25d9ff 2020-01-02 noreply ;; - previous-revision DONE
111 3f25d9ff 2020-01-02 noreply ;; - next-revision DONE
112 7c257a7b 2020-12-31 noreply ;; - log-edit-mode NOT IMPLEMENTED
113 3cdb0759 2020-01-03 47739920+ ;; - check-headers NOT NEEDED, `got' does not use headers
114 a96df0e8 2020-01-03 noreply ;; - delete-file DONE
115 3ec8a8b4 2021-08-17 op ;; - rename-file NOT IMPLEMENTED
116 c151c257 2021-08-03 op ;; - find-file-hook DONE
117 3ec8a8b4 2021-08-17 op ;; - extra-menu NOT IMPLEMENTED
118 3cdb0759 2020-01-03 47739920+ ;; - extra-dir-menu NOT IMPLEMENTED, same as above
119 7bb16f79 2020-01-03 op ;; - conflicted-files DONE
120 8b635a9f 2020-01-03 op ;; - repository-url DONE
121 af5ef7cd 2020-11-29 op
122 eb85ad27 2020-12-05 op ;; TODO: vc-git has most function that starts with:
123 eb85ad27 2020-12-05 op ;;
124 eb85ad27 2020-12-05 op ;; (let* ((root (vc-git-root default-directory))
125 eb85ad27 2020-12-05 op ;; (buffer (format "*vc-git : %s*" (expand-file-name root)))
126 eb85ad27 2020-12-05 op ;; ...)
127 eb85ad27 2020-12-05 op ;; ...)
128 eb85ad27 2020-12-05 op ;;
129 eb85ad27 2020-12-05 op ;; we should 1) investigate if also other backends do something like
130 eb85ad27 2020-12-05 op ;; this (or if there is a better way) and 2) try to do the same.
131 eb85ad27 2020-12-05 op
132 af5ef7cd 2020-11-29 op ;;; Code:
133 af5ef7cd 2020-11-29 op
134 af5ef7cd 2020-11-29 op (eval-when-compile
135 af5ef7cd 2020-11-29 op (require 'subr-x))
136 af5ef7cd 2020-11-29 op
137 af5ef7cd 2020-11-29 op (require 'cl-lib)
138 af5ef7cd 2020-11-29 op (require 'seq)
139 23a0b465 2020-11-30 op (require 'vc)
140 3f25d9ff 2020-01-02 noreply (require 'vc-annotate)
141 f7012697 2021-08-17 op
142 f7012697 2021-08-17 op ;; FIXME: avoid loading this? We only need it for
143 f7012697 2021-08-17 op ;; log-edit-extract-headers in vc-got-checkin.
144 f7012697 2021-08-17 op (require 'log-edit)
145 6b6c8a78 2021-01-04 op
146 2d83de2e 2021-01-05 op ;; FIXME: avoid loading this? We only need it for
147 2d83de2e 2021-01-05 op ;; vc-dir-filename-mouse-map in our custom printer.
148 2d83de2e 2021-01-05 op (require 'vc-dir)
149 ba123905 2020-12-08 op
150 95a78ecb 2021-08-31 op ;; FIXME: avoid loading this? We only need it for
151 95a78ecb 2021-08-31 op ;; compilation-{directory,arguments}.
152 95a78ecb 2021-08-31 op (require 'compile)
153 95a78ecb 2021-08-31 op
154 95a78ecb 2021-08-31 op ;; FIXME: avoid loading this? We only need it for
155 95a78ecb 2021-08-31 op ;; log-view-{file-re,per-file-logs,message-re}.
156 95a78ecb 2021-08-31 op (require 'log-view)
157 95a78ecb 2021-08-31 op
158 e79563bd 2020-12-31 noreply (defgroup vc-got nil
159 e79563bd 2020-12-31 noreply "VC GoT backend."
160 e79563bd 2020-12-31 noreply :group 'vc)
161 af5ef7cd 2020-11-29 op
162 e79563bd 2020-12-31 noreply (defcustom vc-got-program "got"
163 e79563bd 2020-12-31 noreply "Name of the Got executable (excluding any arguments)."
164 6eea6cfb 2021-01-05 op :type 'string)
165 e79563bd 2020-12-31 noreply
166 12ca62f2 2020-12-26 op (defcustom vc-got-diff-switches t
167 12ca62f2 2020-12-26 op "String or list of strings specifying switches for Got diff under VC.
168 12ca62f2 2020-12-26 op If nil, use the value of `vc-diff-switches'. If t, use no switches."
169 12ca62f2 2020-12-26 op :type '(choice (const :tag "Unspecified" nil)
170 12ca62f2 2020-12-26 op (const :tag "None" t)
171 12ca62f2 2020-12-26 op (string :tag "Argument String")
172 6eea6cfb 2021-01-05 op (repeat :tag "Argument List" :value ("") string)))
173 12ca62f2 2020-12-26 op
174 af5ef7cd 2020-11-29 op ;; helpers
175 95a78ecb 2021-08-31 op (defmacro vc-got--with-emacs-version<= (version &rest body)
176 95a78ecb 2021-08-31 op "Eval BODY only when the Emacs version in greater or equal VERSION."
177 95a78ecb 2021-08-31 op (declare (debug body)
178 95a78ecb 2021-08-31 op (indent defun))
179 95a78ecb 2021-08-31 op (when (version<= version emacs-version)
180 95a78ecb 2021-08-31 op `(progn ,@body)))
181 95a78ecb 2021-08-31 op
182 f09d6359 2020-12-31 noreply (defun vc-got--program-version ()
183 76d978fa 2021-01-05 op "Return string representing the got version."
184 f09d6359 2020-12-31 noreply (let (process-file-side-effects)
185 f09d6359 2020-12-31 noreply (with-temp-buffer
186 f09d6359 2020-12-31 noreply (vc-got--call "-V")
187 f09d6359 2020-12-31 noreply (substring (buffer-string) 4 -1))))
188 af5ef7cd 2020-11-29 op
189 af5ef7cd 2020-11-29 op (defun vc-got-root (file)
190 af5ef7cd 2020-11-29 op "Return the work tree root for FILE, or nil."
191 6a973a79 2021-08-11 op (vc-find-root file ".got"))
192 af5ef7cd 2020-11-29 op
193 af5ef7cd 2020-11-29 op (defmacro vc-got-with-worktree (file &rest body)
194 af5ef7cd 2020-11-29 op "Evaluate BODY in the work tree directory of FILE."
195 3efc7598 2021-09-09 op (declare (debug t) (indent defun))
196 af5ef7cd 2020-11-29 op `(when-let (default-directory (vc-got-root ,file))
197 af5ef7cd 2020-11-29 op ,@body))
198 686eac9a 2020-12-07 op
199 686eac9a 2020-12-07 op (defun vc-got--repo-root ()
200 686eac9a 2020-12-07 op "Return the path to the repository root.
201 686eac9a 2020-12-07 op Assume `default-directory' is inside a got worktree."
202 686eac9a 2020-12-07 op (vc-got-with-worktree default-directory
203 686eac9a 2020-12-07 op (with-temp-buffer
204 686eac9a 2020-12-07 op (insert-file-contents ".got/repository")
205 76d978fa 2021-01-05 op (string-trim (buffer-string) "" "\n"))))
206 af5ef7cd 2020-11-29 op
207 af5ef7cd 2020-11-29 op (defun vc-got--call (&rest args)
208 76d978fa 2021-01-05 op "Call `vc-got-program' with ARGS.
209 76d978fa 2021-01-05 op The output will be placed in the current buffer."
210 fab791a2 2020-01-03 op (apply #'process-file vc-got-program nil (current-buffer) nil
211 3efc7598 2021-09-09 op (apply #'nconc (mapcar (lambda (s) (if (listp s) s (list s))) args))))
212 af5ef7cd 2020-11-29 op
213 23a0b465 2020-11-30 op (defun vc-got--add (files)
214 23a0b465 2020-11-30 op "Add FILES to got, passing `vc-register-switches' to the command invocation."
215 23a0b465 2020-11-30 op (with-temp-buffer
216 c3185bf7 2021-08-11 op (vc-got--call "add" vc-register-switches "--" files)))
217 23a0b465 2020-11-30 op
218 0a66694e 2020-01-02 op (defun vc-got--log (&optional path limit start-commit stop-commit
219 0a66694e 2020-01-02 op search-pattern reverse)
220 76d978fa 2021-01-05 op "Execute the log command in the worktree of PATH in the current buffer.
221 23a0b465 2020-11-30 op LIMIT limits the maximum number of commit returned.
222 23a0b465 2020-11-30 op
223 518ede14 2020-12-05 op START-COMMIT: start traversing history at the specified commit.
224 9ad1eb5d 2020-12-07 op STOP-COMMIT: stop traversing history at the specified commit.
225 518ede14 2020-12-05 op SEARCH-PATTERN: limit to log messages matched by the regexp given.
226 0a66694e 2020-01-02 op REVERSE: display the log messages in reverse order.
227 518ede14 2020-12-05 op
228 23a0b465 2020-11-30 op Return nil if the command failed or if PATH isn't included in any
229 23a0b465 2020-11-30 op worktree."
230 3efc7598 2021-09-09 op (let ((process-file-side-effects nil))
231 0a66694e 2020-01-02 op (vc-got-with-worktree (or path default-directory)
232 0a3316a6 2021-02-22 op (when (zerop
233 0a3316a6 2021-02-22 op (save-excursion
234 0a3316a6 2021-02-22 op (vc-got--call "log"
235 3efc7598 2021-09-09 op (and limit (list "-l" (format "%s" limit)))
236 3efc7598 2021-09-09 op (and start-commit (list "-c" start-commit))
237 3efc7598 2021-09-09 op (and stop-commit (list "-x" stop-commit))
238 3efc7598 2021-09-09 op (and search-pattern (list "-s" search-pattern))
239 3efc7598 2021-09-09 op (and reverse '("-R"))
240 c3185bf7 2021-08-11 op "--"
241 0a3316a6 2021-02-22 op path)))
242 0a3316a6 2021-02-22 op (save-excursion
243 3ec8a8b4 2021-08-17 op (delete-matching-lines
244 3ec8a8b4 2021-08-17 op "^-----------------------------------------------$")
245 0a3316a6 2021-02-22 op t)))))
246 af5ef7cd 2020-11-29 op
247 887e0699 2021-02-22 op (defun vc-got--status (status-codes dir-or-file &optional files)
248 668dc8eb 2021-01-04 op "Return a list of lists '(FILE STATUS STAGE-STATUS).
249 af5ef7cd 2020-11-29 op DIR-OR-FILE can be either a directory or a file. If FILES is
250 af5ef7cd 2020-11-29 op given, return the status of those files, otherwise the status of
251 668dc8eb 2021-01-04 op DIR-OR-FILE. STATUS-CODES is either nil, or a string that's
252 668dc8eb 2021-01-04 op passed as the -s flag to got status to limit the types of status
253 668dc8eb 2021-01-04 op to report (e.g. \"CD\" to report only conflicts and deleted
254 668dc8eb 2021-01-04 op files)."
255 2d039a22 2021-02-21 op (with-temp-buffer
256 2d039a22 2021-02-21 op (let* ((default-directory (expand-file-name
257 2d039a22 2021-02-21 op (if (file-directory-p dir-or-file)
258 2d039a22 2021-02-21 op dir-or-file
259 2d039a22 2021-02-21 op (file-name-directory dir-or-file))))
260 2d039a22 2021-02-21 op (root (vc-got-root default-directory))
261 2d039a22 2021-02-21 op (process-file-side-effects))
262 2d039a22 2021-02-21 op (when (zerop (vc-got--call "status"
263 3efc7598 2021-09-09 op (and status-codes (list "-s" status-codes))
264 c3185bf7 2021-08-11 op "--"
265 2d039a22 2021-02-21 op (or files dir-or-file)))
266 2d039a22 2021-02-21 op (goto-char (point-min))
267 2d039a22 2021-02-21 op (cl-loop until (eobp)
268 3ec8a8b4 2021-08-17 op collect (vc-got--parse-status-line root)
269 2d039a22 2021-02-21 op do (forward-line))))))
270 3ec8a8b4 2021-08-17 op
271 3ec8a8b4 2021-08-17 op (defun vc-got--parse-status-line (root)
272 3ec8a8b4 2021-08-17 op "Parse a line of the the output of status.
273 3ec8a8b4 2021-08-17 op ROOT is the root of the repo."
274 3ec8a8b4 2021-08-17 op ;; the format of each line is
275 3ec8a8b4 2021-08-17 op ;; <status-char> <stage-char> <spc> <filename> \n
276 3ec8a8b4 2021-08-17 op (let* ((file-status (prog1 (vc-got--parse-status-char
277 3ec8a8b4 2021-08-17 op (char-after))
278 3ec8a8b4 2021-08-17 op (forward-char)))
279 3ec8a8b4 2021-08-17 op (stage-status (let* ((c (char-after)))
280 3ec8a8b4 2021-08-17 op (prog1
281 3ec8a8b4 2021-08-17 op (when (member c '(?M ?A ?D))
282 3ec8a8b4 2021-08-17 op c)
283 3ec8a8b4 2021-08-17 op (forward-char))))
284 3ec8a8b4 2021-08-17 op (filename (progn
285 3ec8a8b4 2021-08-17 op (forward-char)
286 3ec8a8b4 2021-08-17 op (buffer-substring (point)
287 3ec8a8b4 2021-08-17 op (line-end-position)))))
288 3ec8a8b4 2021-08-17 op (list (file-relative-name (expand-file-name filename root)
289 3ec8a8b4 2021-08-17 op default-directory)
290 3ec8a8b4 2021-08-17 op (or file-status (and stage-status 'up-to-date))
291 3ec8a8b4 2021-08-17 op stage-status)))
292 af5ef7cd 2020-11-29 op
293 668dc8eb 2021-01-04 op (defun vc-got--parse-status-char (c)
294 668dc8eb 2021-01-04 op "Parse status char C into a symbol accepted by `vc-state'."
295 668dc8eb 2021-01-04 op (cl-case c
296 668dc8eb 2021-01-04 op (?M 'edited)
297 668dc8eb 2021-01-04 op (?A 'added)
298 668dc8eb 2021-01-04 op (?D 'removed)
299 668dc8eb 2021-01-04 op (?C 'conflict)
300 668dc8eb 2021-01-04 op (?! 'missing)
301 76d978fa 2021-01-05 op (?~ 'edited) ; XXX: what does it means for a file to be ``obstructed''?
302 668dc8eb 2021-01-04 op (?? 'unregistered)
303 76d978fa 2021-01-05 op (?m 'edited) ; modified file modes
304 668dc8eb 2021-01-04 op (?N nil)))
305 af5ef7cd 2020-11-29 op
306 23a0b465 2020-11-30 op (defun vc-got--tree-parse ()
307 23a0b465 2020-11-30 op "Parse into an alist the output of got tree -i in the current buffer."
308 23a0b465 2020-11-30 op (goto-char (point-min))
309 3efc7598 2021-09-09 op (let (alist)
310 3efc7598 2021-09-09 op (while (re-search-forward "^\\([[:word:]]+\\) \\(?:.+\\)+$" nil t)
311 3efc7598 2021-09-09 op (push (cons (match-string 2) (match-string 1)) alist))
312 3efc7598 2021-09-09 op alist))
313 23a0b465 2020-11-30 op
314 23a0b465 2020-11-30 op (defun vc-got--tree (commit path)
315 67332bad 2021-01-05 op "Return an alist representing the got tree command output.
316 76d978fa 2021-01-05 op The outputted tree will be localised in the given PATH at the
317 67332bad 2021-01-05 op given COMMIT."
318 23a0b465 2020-11-30 op (vc-got-with-worktree path
319 3efc7598 2021-09-09 op (let ((process-file-side-effects nil))
320 76d978fa 2021-01-05 op (with-temp-buffer
321 c3185bf7 2021-08-11 op (when (zerop (vc-got--call "tree" "-c" commit "-i" "--" path))
322 76d978fa 2021-01-05 op (vc-got--tree-parse))))))
323 23a0b465 2020-11-30 op
324 23a0b465 2020-11-30 op (defun vc-got--cat (commit obj-id)
325 23a0b465 2020-11-30 op "Execute got cat -c COMMIT OBJ-ID in the current buffer."
326 76d978fa 2021-01-05 op (let (process-file-side-effects)
327 76d978fa 2021-01-05 op (zerop (vc-got--call "cat" "-c" commit obj-id))))
328 eb85ad27 2020-12-05 op
329 eb85ad27 2020-12-05 op (defun vc-got--revert (&rest files)
330 76d978fa 2021-01-05 op "Execute got revert FILES."
331 eb85ad27 2020-12-05 op (vc-got-with-worktree (car files)
332 eb85ad27 2020-12-05 op (with-temp-buffer
333 c3185bf7 2021-08-11 op (zerop (vc-got--call "revert" "--" files)))))
334 eb85ad27 2020-12-05 op
335 eb85ad27 2020-12-05 op (defun vc-got--list-branches ()
336 eb85ad27 2020-12-05 op "Return an alist of (branch . commit)."
337 76d978fa 2021-01-05 op (let (process-file-side-effects)
338 76d978fa 2021-01-05 op (with-temp-buffer
339 76d978fa 2021-01-05 op (when (zerop (vc-got--call "branch" "-l"))
340 3efc7598 2021-09-09 op (let (alist)
341 3efc7598 2021-09-09 op (goto-char (point-min))
342 3efc7598 2021-09-09 op (while (re-search-forward "^\\* \\(.+\\): \\([[:word:]]+\\)$" nil t)
343 3efc7598 2021-09-09 op (push (cons (match-string 1) (match-string 2)) alist))
344 3efc7598 2021-09-09 op alist)))))
345 eb85ad27 2020-12-05 op
346 694534b4 2020-12-05 op (defun vc-got--current-branch ()
347 694534b4 2020-12-05 op "Return the current branch."
348 76d978fa 2021-01-05 op (let (process-file-side-effects)
349 76d978fa 2021-01-05 op (with-temp-buffer
350 76d978fa 2021-01-05 op (when (zerop (vc-got--call "branch"))
351 76d978fa 2021-01-05 op (string-trim (buffer-string) "" "\n")))))
352 eb85ad27 2020-12-05 op
353 eb85ad27 2020-12-05 op (defun vc-got--integrate (branch)
354 eb85ad27 2020-12-05 op "Integrate BRANCH into the current one."
355 eb85ad27 2020-12-05 op (with-temp-buffer
356 76d978fa 2021-01-05 op (zerop (vc-got--call "integrate" branch))))
357 db89d6fd 2021-08-16 op
358 db89d6fd 2021-08-16 op (defun vc-got--update (branch &optional paths)
359 db89d6fd 2021-08-16 op "Update to a different commit or BRANCH.
360 db89d6fd 2021-08-16 op Optionally restrict the update operation to files at or within
361 db89d6fd 2021-08-16 op the specified PATHS."
362 db89d6fd 2021-08-16 op (with-temp-buffer
363 db89d6fd 2021-08-16 op (unless (zerop (vc-got--call "update" "-b" branch "--" paths))
364 db89d6fd 2021-08-16 op (error "[vc-got] can't update to branch %s: %s"
365 db89d6fd 2021-08-16 op branch
366 db89d6fd 2021-08-16 op (buffer-string)))))
367 23a0b465 2020-11-30 op
368 1d573c91 2021-08-17 op (defun vc-got--diff (&rest files)
369 1d573c91 2021-08-17 op "Call got diff against FILES.
370 1d573c91 2021-08-17 op The result will be stored in the current buffer."
371 76d978fa 2021-01-05 op (let (process-file-side-effects)
372 76d978fa 2021-01-05 op (zerop (vc-got--call "diff"
373 76d978fa 2021-01-05 op (vc-switches 'got 'diff)
374 c3185bf7 2021-08-11 op "--"
375 1d573c91 2021-08-17 op (mapcar #'file-relative-name files)))))
376 6b6c8a78 2021-01-04 op
377 6b6c8a78 2021-01-04 op (defun vc-got--unstage (file-or-directory)
378 6b6c8a78 2021-01-04 op "Unstage all the staged hunks at or within FILE-OR-DIRECTORY.
379 6b6c8a78 2021-01-04 op If it's nil, unstage every staged changes across the entire work
380 6b6c8a78 2021-01-04 op tree."
381 c3185bf7 2021-08-11 op (zerop (vc-got--call "unstage" "--" file-or-directory)))
382 a96df0e8 2020-01-03 noreply
383 a96df0e8 2020-01-03 noreply (defun vc-got--remove (file &optional force keep-local)
384 76d978fa 2021-01-05 op "Use got to remove FILE.
385 76d978fa 2021-01-05 op If FORCE is non-nil perform the operation even if a file contains
386 76d978fa 2021-01-05 op local modification. If KEEP-LOCAL is non-nil keep the affected
387 76d978fa 2021-01-05 op files on disk."
388 a96df0e8 2020-01-03 noreply (vc-got-with-worktree (or file default-directory)
389 a96df0e8 2020-01-03 noreply (with-temp-buffer
390 76d978fa 2021-01-05 op (zerop (vc-got--call "remove"
391 3efc7598 2021-09-09 op (and force "-f")
392 3efc7598 2021-09-09 op (and keep-local "-k")
393 c3185bf7 2021-08-11 op "--"
394 76d978fa 2021-01-05 op file)))))
395 eb85ad27 2020-12-05 op
396 5fb2f474 2021-08-10 op (defun vc-got--ref ()
397 5fb2f474 2021-08-10 op "Return a list of all references."
398 3efc7598 2021-09-09 op (let ((process-file-side-effects nil)
399 5fb2f474 2021-08-10 op (re "^refs/\\(heads\\|remotes\\|tags\\)/\\(.*\\):")
400 5fb2f474 2021-08-10 op ;; hardcoding HEAD because it's always present and the regexp
401 5fb2f474 2021-08-10 op ;; won't match it.
402 5fb2f474 2021-08-10 op (table (list "HEAD")))
403 5fb2f474 2021-08-10 op (vc-got-with-worktree default-directory
404 5fb2f474 2021-08-10 op (with-temp-buffer
405 5fb2f474 2021-08-10 op (when (zerop (vc-got--call "ref" "-l"))
406 5fb2f474 2021-08-10 op (goto-char (point-min))
407 5fb2f474 2021-08-10 op (while (re-search-forward re nil t)
408 5fb2f474 2021-08-10 op (push (match-string 2) table))
409 5fb2f474 2021-08-10 op table)))))
410 8014bde1 2021-08-10 op
411 8014bde1 2021-08-10 op (defun vc-got--branch (name)
412 8014bde1 2021-08-10 op "Try to create and switch to the branch called NAME."
413 8014bde1 2021-08-10 op (let (process-file-side-effects)
414 8014bde1 2021-08-10 op (vc-got-with-worktree default-directory
415 8014bde1 2021-08-10 op (with-temp-buffer
416 c3185bf7 2021-08-11 op (if (zerop (vc-got--call "branch" "--" name))
417 8014bde1 2021-08-10 op t
418 8014bde1 2021-08-10 op (error "[vc-got] can't create branch %s: %s" name
419 8014bde1 2021-08-10 op (buffer-string)))))))
420 5fb2f474 2021-08-10 op
421 af5ef7cd 2020-11-29 op
422 af5ef7cd 2020-11-29 op ;; Backend properties
423 af5ef7cd 2020-11-29 op
424 af5ef7cd 2020-11-29 op (defun vc-got-revision-granularity ()
425 af5ef7cd 2020-11-29 op "Got has REPOSITORY granularity."
426 af5ef7cd 2020-11-29 op 'repository)
427 af5ef7cd 2020-11-29 op
428 af5ef7cd 2020-11-29 op (defun vc-got-update-on-retrieve-tag ()
429 84beb0d4 2021-08-17 op "Like vc-git, vc-got don't need to buffers on `retrieve-tag'."
430 af5ef7cd 2020-11-29 op nil)
431 af5ef7cd 2020-11-29 op
432 af5ef7cd 2020-11-29 op
433 af5ef7cd 2020-11-29 op ;; State-querying functions
434 af5ef7cd 2020-11-29 op
435 af5ef7cd 2020-11-29 op ;;;###autoload (defun vc-got-registered (file)
436 af5ef7cd 2020-11-29 op ;;;###autoload "Return non-nil if FILE is registered with got."
437 af5ef7cd 2020-11-29 op ;;;###autoload (when (vc-find-root file ".got")
438 af5ef7cd 2020-11-29 op ;;;###autoload (load "vc-got" nil t)
439 af5ef7cd 2020-11-29 op ;;;###autoload (vc-got-registered file)))
440 af5ef7cd 2020-11-29 op
441 af5ef7cd 2020-11-29 op (defun vc-got-registered (file)
442 af5ef7cd 2020-11-29 op "Return non-nil if FILE is registered with got."
443 af5ef7cd 2020-11-29 op (if (file-directory-p file)
444 76d978fa 2021-01-05 op nil ; got doesn't track directories
445 4093d2f9 2020-12-04 op (when (vc-find-root file ".got")
446 668dc8eb 2021-01-04 op (let ((s (vc-got-state file)))
447 668dc8eb 2021-01-04 op (not (or (eq s 'unregistered)
448 668dc8eb 2021-01-04 op (null s)))))))
449 af5ef7cd 2020-11-29 op
450 af5ef7cd 2020-11-29 op (defun vc-got-state (file)
451 af5ef7cd 2020-11-29 op "Return the current version control state of FILE. See `vc-state'."
452 af5ef7cd 2020-11-29 op (unless (file-directory-p file)
453 76d978fa 2021-01-05 op (let (process-file-side-effects)
454 76d978fa 2021-01-05 op ;; Manually calling got status and checking the result inline to
455 76d978fa 2021-01-05 op ;; avoid building the data structure in vc-got--status.
456 76d978fa 2021-01-05 op (with-temp-buffer
457 c3185bf7 2021-08-11 op (when (zerop (vc-got--call "status" "--" file))
458 76d978fa 2021-01-05 op (goto-char (point-min))
459 76d978fa 2021-01-05 op (if (eobp)
460 76d978fa 2021-01-05 op 'up-to-date
461 76d978fa 2021-01-05 op (vc-got--parse-status-char (char-after))))))))
462 dcb5b83a 2021-01-08 op
463 dcb5b83a 2021-01-08 op (defun vc-got--dir-filter-files (files)
464 dcb5b83a 2021-01-08 op "Remove ., .. and .got from FILES."
465 dcb5b83a 2021-01-08 op (cl-loop for file in files
466 dcb5b83a 2021-01-08 op unless (or (string= file "..")
467 dcb5b83a 2021-01-08 op (string= file ".")
468 dcb5b83a 2021-01-08 op (string= file ".got"))
469 dcb5b83a 2021-01-08 op collect file))
470 af5ef7cd 2020-11-29 op
471 af5ef7cd 2020-11-29 op (defun vc-got-dir-status-files (dir files update-function)
472 5b4a6b90 2021-01-04 op "Build the status for FILES in DIR.
473 76d978fa 2021-01-05 op The builded result is given to the callback UPDATE-FUNCTION. If
474 5b4a6b90 2021-01-04 op FILES is nil, consider all the files in DIR."
475 dcb5b83a 2021-01-08 op (let* ((fs (vc-got--dir-filter-files (or files (directory-files dir))))
476 d346ca63 2021-01-08 op ;; XXX: we call with files, wich will probably be nil on the
477 d346ca63 2021-01-08 op ;; first run, so we catch deleted, missing and edited files
478 d346ca63 2021-01-08 op ;; in subdirectories.
479 d346ca63 2021-01-08 op (res (vc-got--status nil dir files))
480 d346ca63 2021-01-08 op double-check)
481 82289421 2020-01-02 op (cl-loop for file in fs
482 76d978fa 2021-01-05 op do (when (and (not (cdr (assoc file res #'string=)))
483 76d978fa 2021-01-05 op (not (file-directory-p file))
484 76d978fa 2021-01-05 op ;; if file doesn't exists, it's a
485 76d978fa 2021-01-05 op ;; untracked file that was removed.
486 76d978fa 2021-01-05 op (file-exists-p file))
487 d346ca63 2021-01-08 op ;; if we don't know the status of a file here, it's
488 d346ca63 2021-01-08 op ;; either up-to-date or ignored. Save it for a
489 d346ca63 2021-01-08 op ;; double check
490 d346ca63 2021-01-08 op (push file double-check)))
491 cb973832 2021-01-08 op (cl-loop with statuses = (vc-got--status nil dir double-check)
492 cb973832 2021-01-08 op for file in double-check
493 cb973832 2021-01-08 op unless (eq 'unregistered (cadr (assoc file statuses #'string=)))
494 d346ca63 2021-01-08 op do (push (list file 'up-to-date nil) res))
495 d346ca63 2021-01-08 op (funcall update-function res nil)))
496 af5ef7cd 2020-11-29 op
497 c27df03e 2020-01-03 op (defun vc-got-dir-extra-headers (dir)
498 c27df03e 2020-01-03 op "Return a string for the `vc-dir' buffer heading for directory DIR."
499 76d978fa 2021-01-05 op (let ((remote (vc-got-repository-url dir)))
500 76d978fa 2021-01-05 op (concat (propertize "Repository : " 'face 'font-lock-type-face)
501 76d978fa 2021-01-05 op (vc-got--repo-root) "\n"
502 76d978fa 2021-01-05 op (when remote
503 76d978fa 2021-01-05 op (concat
504 76d978fa 2021-01-05 op (propertize "Remote URL : " 'face 'font-lock-type-face)
505 76d978fa 2021-01-05 op (vc-got-repository-url dir) "\n"))
506 76d978fa 2021-01-05 op (propertize "Branch : " 'face 'font-lock-type-face)
507 76d978fa 2021-01-05 op (vc-got--current-branch))))
508 2d83de2e 2021-01-05 op
509 2d83de2e 2021-01-05 op (defun vc-got-dir-printer (info)
510 2d83de2e 2021-01-05 op "Pretty-printer for the vc-dir-fileinfo structure INFO."
511 2d83de2e 2021-01-05 op (let* ((isdir (vc-dir-fileinfo->directory info))
512 76d978fa 2021-01-05 op (state (if isdir "" (vc-dir-fileinfo->state info)))
513 76d978fa 2021-01-05 op (stage-state (vc-dir-fileinfo->extra info))
514 76d978fa 2021-01-05 op (filename (vc-dir-fileinfo->name info)))
515 2d83de2e 2021-01-05 op (insert
516 1b2afa91 2021-08-17 op " "
517 2d83de2e 2021-01-05 op (propertize
518 2d83de2e 2021-01-05 op (format "%c" (if (vc-dir-fileinfo->marked info) ?* ? ))
519 2d83de2e 2021-01-05 op 'face 'font-lock-type-face)
520 1b2afa91 2021-08-17 op " "
521 9e019413 2021-01-05 op (propertize
522 1b2afa91 2021-08-17 op (format "%-12s" state)
523 2d83de2e 2021-01-05 op 'face (cond ((eq state 'up-to-date) 'font-lock-builtin-face)
524 76d978fa 2021-01-05 op ((memq state '(missing conflict)) 'font-lock-warning-face)
525 76d978fa 2021-01-05 op ((eq state 'edited) 'font-lock-constant-face)
526 76d978fa 2021-01-05 op (t 'font-lock-variable-name-face))
527 1b2afa91 2021-08-17 op 'mouse-face 'highlight
528 95a78ecb 2021-08-31 op 'keymap (vc-got--with-emacs-version<= "28.0.50"
529 95a78ecb 2021-08-31 op vc-dir-status-mouse-map))
530 a8466f02 2020-12-07 op
531 1b2afa91 2021-08-17 op " " (propertize
532 1b2afa91 2021-08-17 op (if stage-state
533 1b2afa91 2021-08-17 op (format "%c" stage-state)
534 1b2afa91 2021-08-17 op " ")
535 1b2afa91 2021-08-17 op 'face (cond ((memq stage-state '(?A ?E)) 'font-lock-constant-face)
536 1b2afa91 2021-08-17 op ((eq stage-state ?R) 'font-lock-warning-face)
537 1b2afa91 2021-08-17 op (t 'font-lock-variable-name-face)))
538 1b2afa91 2021-08-17 op " "
539 1b2afa91 2021-08-17 op (propertize filename
540 1b2afa91 2021-08-17 op 'face (if isdir 'font-lock-comment-delimiter-face
541 1b2afa91 2021-08-17 op 'font-lock-function-name-face)
542 1b2afa91 2021-08-17 op 'help-echo
543 1b2afa91 2021-08-17 op (if isdir
544 3ec8a8b4 2021-08-17 op (concat
545 3ec8a8b4 2021-08-17 op "Directory\n"
546 3ec8a8b4 2021-08-17 op "VC operations can be applied to it\n"
547 3ec8a8b4 2021-08-17 op "mouse-3: Pop-up menu")
548 1b2afa91 2021-08-17 op "File\nmouse-3: Pop-up menu")
549 1b2afa91 2021-08-17 op 'mouse-face 'highlight
550 1b2afa91 2021-08-17 op 'keymap vc-dir-filename-mouse-map))))
551 1b2afa91 2021-08-17 op
552 af5ef7cd 2020-11-29 op (defun vc-got-working-revision (file)
553 3ec8a8b4 2021-08-17 op "Return the last commit that touched FILE or \"0\" if it's newly added."
554 af5ef7cd 2020-11-29 op (or
555 af5ef7cd 2020-11-29 op (with-temp-buffer
556 518ede14 2020-12-05 op (when (vc-got--log file 1)
557 af5ef7cd 2020-11-29 op (let (start)
558 af5ef7cd 2020-11-29 op (goto-char (point-min))
559 76d978fa 2021-01-05 op (forward-word) ; skip "commit"
560 76d978fa 2021-01-05 op (forward-char) ; skip the space
561 76d978fa 2021-01-05 op (setq start (point)) ; store start of the SHA
562 76d978fa 2021-01-05 op (forward-word) ; goto SHA end
563 af5ef7cd 2020-11-29 op (buffer-substring start (point)))))
564 af5ef7cd 2020-11-29 op ;; special case: if this file is added but has no previous commits
565 af5ef7cd 2020-11-29 op ;; touching it, got log will fail (as expected), but we have to
566 af5ef7cd 2020-11-29 op ;; return "0".
567 af5ef7cd 2020-11-29 op (when (eq (vc-got-state file) 'added)
568 af5ef7cd 2020-11-29 op "0")))
569 af5ef7cd 2020-11-29 op
570 af5ef7cd 2020-11-29 op (defun vc-got-checkout-model (_files)
571 01bf4e07 2021-08-17 op "Return the checkout model.
572 01bf4e07 2021-08-17 op Got uses an implicit checkout model for every file."
573 af5ef7cd 2020-11-29 op 'implicit)
574 af5ef7cd 2020-11-29 op
575 694534b4 2020-12-05 op (defun vc-got-mode-line-string (file)
576 694534b4 2020-12-05 op "Return the VC mode line string for FILE."
577 694534b4 2020-12-05 op (vc-got-with-worktree file
578 694534b4 2020-12-05 op (let ((def (vc-default-mode-line-string 'Got file)))
579 694534b4 2020-12-05 op (concat (substring def 0 4) (vc-got--current-branch)))))
580 694534b4 2020-12-05 op
581 23a0b465 2020-11-30 op
582 23a0b465 2020-11-30 op ;; state-changing functions
583 23a0b465 2020-11-30 op
584 23a0b465 2020-11-30 op (defun vc-got-create-repo (_backend)
585 7726b6c9 2021-08-10 op "Create an empty repository in the current directory."
586 7726b6c9 2021-08-10 op (error "[vc-got] create-repo not implemented"))
587 23a0b465 2020-11-30 op
588 23a0b465 2020-11-30 op (defun vc-got-register (files &optional _comment)
589 23a0b465 2020-11-30 op "Register FILES, passing `vc-register-switches' to the backend command."
590 23a0b465 2020-11-30 op (vc-got--add files))
591 23a0b465 2020-11-30 op
592 9e805da8 2020-11-30 op (defalias 'vc-got-responsible-p #'vc-got-root)
593 241a3b12 2021-08-11 op
594 241a3b12 2021-08-11 op (defun vc-got-unregister (file)
595 241a3b12 2021-08-11 op "Unregister FILE."
596 9114bbc3 2021-08-11 op (vc-got--remove file t t))
597 23a0b465 2020-11-30 op
598 23a0b465 2020-11-30 op (defun vc-got-checkin (files comment &optional _rev)
599 23a0b465 2020-11-30 op "Commit FILES with COMMENT as commit message."
600 23a0b465 2020-11-30 op (with-temp-buffer
601 ad36649b 2021-02-25 op (unless (zerop (vc-got--call "commit" "-m"
602 e7747ce0 2021-08-11 op (log-edit-extract-headers nil comment)
603 c3185bf7 2021-08-11 op "--"
604 ad36649b 2021-02-25 op files))
605 26362bf0 2021-08-11 op (error "[vc-got] can't commit: %s" (buffer-string)))))
606 23a0b465 2020-11-30 op
607 23a0b465 2020-11-30 op (defun vc-got-find-revision (file rev buffer)
608 c0c9a339 2020-12-04 op "Fill BUFFER with the content of FILE in the given revision REV."
609 23a0b465 2020-11-30 op (when-let (obj-id (assoc file (vc-got--tree rev file) #'string=))
610 23a0b465 2020-11-30 op (with-current-buffer buffer
611 23a0b465 2020-11-30 op (vc-got-with-worktree file
612 23a0b465 2020-11-30 op (vc-got--cat rev obj-id)))))
613 55091167 2020-12-05 op
614 eb85ad27 2020-12-05 op (defun vc-got-checkout (_file &optional _rev)
615 76d978fa 2021-01-05 op "Checkout revision REV of FILE.
616 76d978fa 2021-01-05 op If REV is t, checkout from the head."
617 7726b6c9 2021-08-10 op (error "[vc-got] checkout not implemented"))
618 eb85ad27 2020-12-05 op
619 eb85ad27 2020-12-05 op (defun vc-got-revert (file &optional _content-done)
620 eb85ad27 2020-12-05 op "Revert FILE back to working revision."
621 eb85ad27 2020-12-05 op (vc-got--revert file))
622 eb85ad27 2020-12-05 op
623 eb85ad27 2020-12-05 op (defun vc-got-merge-branch ()
624 eb85ad27 2020-12-05 op "Prompt for a branch and integrate it into the current one."
625 eb85ad27 2020-12-05 op ;; XXX: be smart and try to "got rebase" if "got integrate" fails?
626 eb85ad27 2020-12-05 op (let* ((branches (cl-loop for (branch . commit) in (vc-got--list-branches)
627 eb85ad27 2020-12-05 op collect branch))
628 eb85ad27 2020-12-05 op (branch (completing-read "Merge from branch: " branches)))
629 eb85ad27 2020-12-05 op (when branch
630 eb85ad27 2020-12-05 op (vc-got--integrate branch))))
631 686eac9a 2020-12-07 op
632 74b00009 2021-08-31 op (defun vc-got--proc-filter (proc s)
633 74b00009 2021-08-31 op "Custom output filter for async process PROC.
634 74b00009 2021-08-31 op It's like `vc-process-filter' but supports \r inside S."
635 74b00009 2021-08-31 op (let ((buffer (process-buffer proc)))
636 74b00009 2021-08-31 op (when (buffer-live-p buffer)
637 74b00009 2021-08-31 op (with-current-buffer buffer
638 74b00009 2021-08-31 op (save-excursion
639 74b00009 2021-08-31 op (let ((buffer-undo-list t)
640 74b00009 2021-08-31 op (inhibit-read-only t))
641 74b00009 2021-08-31 op (goto-char (process-mark proc))
642 74b00009 2021-08-31 op (if (not (string-match ".*\r\\(.*\\)" s))
643 74b00009 2021-08-31 op (insert s)
644 74b00009 2021-08-31 op ;; handle \r
645 74b00009 2021-08-31 op (end-of-line)
646 74b00009 2021-08-31 op (let ((end (point)))
647 74b00009 2021-08-31 op (beginning-of-line)
648 74b00009 2021-08-31 op (delete-region (point) end))
649 74b00009 2021-08-31 op (insert (match-string 1 s)))
650 74b00009 2021-08-31 op (set-marker (process-mark proc) (point))))))))
651 74b00009 2021-08-31 op
652 dec54a74 2021-02-21 op (defun vc-got--push-pull (cmd op prompt)
653 dec54a74 2021-02-21 op "Execute CMD OP, or prompt the user if PROMPT is non-nil."
654 dec54a74 2021-02-21 op (let ((buffer (format "*vc-got : %s*" (expand-file-name default-directory))))
655 686eac9a 2020-12-07 op (when-let (cmd (if prompt
656 686eac9a 2020-12-07 op (split-string
657 686eac9a 2020-12-07 op (read-shell-command (format "%s %s command: " cmd op)
658 1870c8bd 2021-03-27 op (format "%s %s " cmd op))
659 686eac9a 2020-12-07 op " " t)
660 686eac9a 2020-12-07 op (list cmd op)))
661 dec54a74 2021-02-21 op (apply #'vc-do-async-command buffer default-directory cmd)
662 dec54a74 2021-02-21 op ;; this comes from vc-git.el. We're using git to push, so in
663 dec54a74 2021-02-21 op ;; part it makes sense, but we should revisit for full Got
664 dec54a74 2021-02-21 op ;; support.
665 dec54a74 2021-02-21 op (with-current-buffer buffer
666 74b00009 2021-08-31 op (vc-compilation-mode 'got)
667 74b00009 2021-08-31 op (let ((comp-cmd (mapconcat #'identity cmd " "))
668 74b00009 2021-08-31 op (proc (get-buffer-process buffer)))
669 95a78ecb 2021-08-31 op (setq-local compile-command comp-cmd)
670 95a78ecb 2021-08-31 op (setq-local compilation-directory default-directory)
671 95a78ecb 2021-08-31 op (setq-local compilation-arguments (list comp-cmd
672 dec54a74 2021-02-21 op nil
673 dec54a74 2021-02-21 op (lambda (_ign) buffer)
674 74b00009 2021-08-31 op nil))
675 74b00009 2021-08-31 op ;; Setup a custom process filter that handles \r.
676 74b00009 2021-08-31 op (set-process-filter proc #'vc-got--proc-filter)))
677 dec54a74 2021-02-21 op (vc-set-async-update buffer))))
678 eb85ad27 2020-12-05 op
679 3ec8a8b4 2021-08-17 op ;; TODO: this could be expanded. After a pull the worktree needs to
680 3ec8a8b4 2021-08-17 op ;; be updated, either with a ``got update -b branch-name'' and
681 3ec8a8b4 2021-08-17 op ;; eventually a rebase.
682 eb85ad27 2020-12-05 op (defun vc-got-pull (prompt)
683 3ec8a8b4 2021-08-17 op "Execute a pull prompting for the full command if PROMPT is not nil."
684 dec54a74 2021-02-21 op (let ((default-directory (vc-got-root default-directory)))
685 dec54a74 2021-02-21 op (vc-got--push-pull vc-got-program "fetch" prompt)))
686 686eac9a 2020-12-07 op
687 686eac9a 2020-12-07 op (defun vc-got-push (prompt)
688 686eac9a 2020-12-07 op "Run git push (not got!) in the repository dir.
689 686eac9a 2020-12-07 op If PROMPT is non-nil, prompt for the git command to run."
690 dec54a74 2021-02-21 op (let ((default-directory (vc-got--repo-root)))
691 5154c5c2 2021-08-31 op (vc-got--push-pull vc-got-program "send" prompt)))
692 eb85ad27 2020-12-05 op
693 424f5152 2021-08-10 op
694 424f5152 2021-08-10 op ;; History functions
695 424f5152 2021-08-10 op
696 eb85ad27 2020-12-05 op (defun vc-got-print-log (files buffer &optional _shortlog start-revision limit)
697 eb85ad27 2020-12-05 op "Insert the revision log for FILES into BUFFER.
698 76d978fa 2021-01-05 op LIMIT limits the number of commits, optionally starting at
699 76d978fa 2021-01-05 op START-REVISION."
700 eb85ad27 2020-12-05 op (with-current-buffer buffer
701 eb85ad27 2020-12-05 op ;; the *vc-diff* may be read only
702 4571b1fd 2020-12-05 op (let ((inhibit-read-only t))
703 eb85ad27 2020-12-05 op (cl-loop for file in files
704 3ec8a8b4 2021-08-17 op do (vc-got--log (file-relative-name file)
705 3ec8a8b4 2021-08-17 op limit
706 3ec8a8b4 2021-08-17 op start-revision)))))
707 eb85ad27 2020-12-05 op
708 9ad1eb5d 2020-12-07 op (defun vc-got-log-outgoing (buffer remote-location)
709 9ad1eb5d 2020-12-07 op "Fill BUFFER with the diff between the local worktree branch and REMOTE-LOCATION."
710 9ad1eb5d 2020-12-07 op (vc-setup-buffer buffer)
711 a1839dca 2021-08-17 op (let ((rl (vc-got-next-revision
712 a1839dca 2021-08-17 op nil
713 a1839dca 2021-08-17 op (if (or (not remote-location) (string-empty-p remote-location))
714 a1839dca 2021-08-17 op (concat "origin/" (vc-got--current-branch))
715 a1839dca 2021-08-17 op remote-location)))
716 9ad1eb5d 2020-12-07 op (inhibit-read-only t))
717 9ad1eb5d 2020-12-07 op (with-current-buffer buffer
718 9ad1eb5d 2020-12-07 op (vc-got--log nil nil nil rl))))
719 6eda2f1f 2020-12-26 op
720 6eda2f1f 2020-12-26 op (defun vc-got-incoming (buffer remote-location)
721 6eda2f1f 2020-12-26 op "Fill BUFFER with the diff between the REMOTE-LOCATION and the local worktree branch."
722 6eda2f1f 2020-12-26 op (let ((rl (if (or (not remote-location) (string-empty-p remote-location))
723 6eda2f1f 2020-12-26 op (concat "origin/" (vc-got--current-branch))
724 6eda2f1f 2020-12-26 op remote-location))
725 6eda2f1f 2020-12-26 op (inhibit-read-only t))
726 6eda2f1f 2020-12-26 op (with-current-buffer buffer
727 6eda2f1f 2020-12-26 op (vc-got--log nil nil (vc-got--current-branch) rl))))
728 9ad1eb5d 2020-12-07 op
729 eb85ad27 2020-12-05 op (defun vc-got-log-search (buffer pattern)
730 eb85ad27 2020-12-05 op "Search commits for PATTERN and write the results found in BUFFER."
731 eb85ad27 2020-12-05 op (with-current-buffer buffer
732 eb85ad27 2020-12-05 op (let ((inhibit-read-only t))
733 9ad1eb5d 2020-12-07 op (vc-got--log nil nil nil nil pattern))))
734 eb85ad27 2020-12-05 op
735 0a3316a6 2021-02-22 op (define-derived-mode vc-got-log-view-mode log-view-mode "Got-Log-View"
736 0a3316a6 2021-02-22 op "Got-specific log-view mode.
737 0a3316a6 2021-02-22 op Heavily inspired by `vc-git-log-view-mode'."
738 0a3316a6 2021-02-22 op (require 'add-log)
739 95a78ecb 2021-08-31 op (setq-local log-view-file-re regexp-unmatchable)
740 95a78ecb 2021-08-31 op (setq-local log-view-per-file-logs nil)
741 95a78ecb 2021-08-31 op (setq-local log-view-message-re "^commit +\\([0-9a-z]+\\)")
742 95a78ecb 2021-08-31 op (setq-local log-view-font-lock-keywords
743 95a78ecb 2021-08-31 op (append
744 95a78ecb 2021-08-31 op `((,log-view-message-re (1 'change-log-acknowledgment)))
745 95a78ecb 2021-08-31 op ;; Handle the case:
746 95a78ecb 2021-08-31 op ;; user: foo@bar
747 95a78ecb 2021-08-31 op '(("^from: \\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)"
748 95a78ecb 2021-08-31 op (1 'change-log-email))
749 95a78ecb 2021-08-31 op ;; Handle the case:
750 95a78ecb 2021-08-31 op ;; user: FirstName LastName <foo@bar>
751 95a78ecb 2021-08-31 op ("^from: \\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]"
752 95a78ecb 2021-08-31 op (1 'change-log-name)
753 95a78ecb 2021-08-31 op (2 'change-log-email))
754 95a78ecb 2021-08-31 op ("^date: \\(.+\\)" (1 'change-log-date))))))
755 0a3316a6 2021-02-22 op
756 eb85ad27 2020-12-05 op ;; TODO: async
757 f18d3e11 2020-12-05 op ;; TODO: return 0 or 1
758 eb85ad27 2020-12-05 op (defun vc-got-diff (files &optional rev1 rev2 buffer _async)
759 eb85ad27 2020-12-05 op "Insert into BUFFER (or *vc-diff*) the diff for FILES from REV1 to REV2."
760 f457868b 2020-12-07 op (let* ((buffer (get-buffer-create (or buffer "*vc-diff*")))
761 eb85ad27 2020-12-05 op (inhibit-read-only t))
762 eb85ad27 2020-12-05 op (with-current-buffer buffer
763 8ec0bb76 2021-08-11 op (vc-got-with-worktree (or (car files)
764 8ec0bb76 2021-08-11 op default-directory)
765 e9a5df05 2021-08-10 op (if (and (null rev1)
766 e9a5df05 2021-08-10 op (null rev2))
767 e9a5df05 2021-08-10 op (dolist (file files)
768 e9a5df05 2021-08-10 op (vc-got--diff file))
769 e9a5df05 2021-08-10 op ;; TODO: if rev1 is nil, diff from the current version until
770 e9a5df05 2021-08-10 op ;; rev2.
771 83559c7c 2021-08-11 op ;;
772 e9a5df05 2021-08-10 op ;; TODO: if rev2 is nil as well, diff against an empty tree
773 e9a5df05 2021-08-10 op ;; (i.e. get the patch from `got log -p rev1')
774 83559c7c 2021-08-11 op ;;
775 83559c7c 2021-08-11 op ;; TODO: it would be nice to optionally include FILES here,
776 83559c7c 2021-08-11 op ;; it would make the `=' key on the *Annotate* buffer do the
777 83559c7c 2021-08-11 op ;; right thing, but AFAICS got doesn't provide something
778 83559c7c 2021-08-11 op ;; like this. Probably only hacking something with ``log
779 83559c7c 2021-08-11 op ;; -p'' and filtering?
780 e9a5df05 2021-08-10 op (vc-got--diff rev1 rev2))))))
781 5fb2f474 2021-08-10 op
782 5fb2f474 2021-08-10 op (defun vc-got-revision-completion-table (_files)
783 5fb2f474 2021-08-10 op "Return a completion table for existing revisions.
784 5fb2f474 2021-08-10 op Ignores FILES because GoT doesn't have the concept of ``file
785 5fb2f474 2021-08-10 op revisions''; instead, like with git, you have tags and branches."
786 5fb2f474 2021-08-10 op (letrec ((table (lazy-completion-table
787 5fb2f474 2021-08-10 op table (lambda () (vc-got--ref)))))
788 5fb2f474 2021-08-10 op table))
789 3f25d9ff 2020-01-02 noreply
790 3f25d9ff 2020-01-02 noreply (defun vc-got-annotate-command (file buf &optional rev)
791 67332bad 2021-01-05 op "Show annotated contents of FILE in buffer BUF. If given, use revision REV."
792 3f25d9ff 2020-01-02 noreply (let (process-file-side-effects)
793 3f25d9ff 2020-01-02 noreply (with-current-buffer buf
794 3f25d9ff 2020-01-02 noreply ;; FIXME: vc-ensure-vc-buffer won't recognise this buffer as managed
795 3f25d9ff 2020-01-02 noreply ;; by got unless vc-parent-buffer points to a buffer managed by got.
796 3f25d9ff 2020-01-02 noreply ;; investigate why this is needed.
797 3efc7598 2021-09-09 op (setq-local vc-parent-buffer (find-file-noselect file))
798 76d978fa 2021-01-05 op (vc-got--call "blame"
799 76d978fa 2021-01-05 op (when rev (list "-c" rev))
800 c3185bf7 2021-08-11 op "--"
801 76d978fa 2021-01-05 op file))))
802 3f25d9ff 2020-01-02 noreply
803 3f25d9ff 2020-01-02 noreply (defconst vc-got--annotate-re
804 3f25d9ff 2020-01-02 noreply (concat "^[0-9]\\{1,\\}) " ; line number followed by )
805 3f25d9ff 2020-01-02 noreply "\\([a-z0-9]+\\) " ; SHA-1 of commit
806 3f25d9ff 2020-01-02 noreply "\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\) " ; year-mm-dd
807 3f25d9ff 2020-01-02 noreply "\\([^ ]\\)+ ") ; author
808 3f25d9ff 2020-01-02 noreply "Regexp to match annotation output lines.
809 3f25d9ff 2020-01-02 noreply
810 3f25d9ff 2020-01-02 noreply Provides capture groups for:
811 3f25d9ff 2020-01-02 noreply 1. revision id
812 3f25d9ff 2020-01-02 noreply 2. date of commit
813 3f25d9ff 2020-01-02 noreply 3. author of commit")
814 3f25d9ff 2020-01-02 noreply
815 3f25d9ff 2020-01-02 noreply (defconst vc-got--commit-re "^commit \\([a-z0-9]+\\)"
816 3f25d9ff 2020-01-02 noreply "Regexp to match commit lines.
817 3f25d9ff 2020-01-02 noreply
818 3f25d9ff 2020-01-02 noreply Provides capture group for the commit revision id.")
819 3f25d9ff 2020-01-02 noreply
820 3f25d9ff 2020-01-02 noreply (defun vc-got-annotate-time ()
821 3f25d9ff 2020-01-02 noreply "Return the time of the next line of annotation at or after point.
822 3f25d9ff 2020-01-02 noreply Value is returned as floating point fractional number of days."
823 3f25d9ff 2020-01-02 noreply (save-excursion
824 3f25d9ff 2020-01-02 noreply (beginning-of-line)
825 3f25d9ff 2020-01-02 noreply (when (looking-at vc-got--annotate-re)
826 3f25d9ff 2020-01-02 noreply (let ((str (match-string-no-properties 2)))
827 3f25d9ff 2020-01-02 noreply (vc-annotate-convert-time
828 3f25d9ff 2020-01-02 noreply (encode-time 0 0 0
829 3f25d9ff 2020-01-02 noreply (string-to-number (substring str 8 10))
830 3f25d9ff 2020-01-02 noreply (string-to-number (substring str 5 7))
831 3f25d9ff 2020-01-02 noreply (string-to-number (substring str 0 4))))))))
832 eb85ad27 2020-12-05 op
833 3f25d9ff 2020-01-02 noreply (defun vc-got-annotate-extract-revision-at-line ()
834 67332bad 2021-01-05 op "Return revision corresponding to the current line or nil."
835 3f25d9ff 2020-01-02 noreply (save-excursion
836 3f25d9ff 2020-01-02 noreply (beginning-of-line)
837 3f25d9ff 2020-01-02 noreply (when (looking-at vc-got--annotate-re)
838 3f25d9ff 2020-01-02 noreply (match-string-no-properties 1))))
839 3f25d9ff 2020-01-02 noreply
840 424f5152 2021-08-10 op
841 8014bde1 2021-08-10 op ;; Tag system
842 6ab1c7b4 2021-08-11 op
843 6ab1c7b4 2021-08-11 op (defun vc-got--tag-callback (tag)
844 6ab1c7b4 2021-08-11 op "`log-edit' callback for `vc-got-create-tag'.
845 6ab1c7b4 2021-08-11 op Creates the TAG using the content of the current buffer."
846 6ab1c7b4 2021-08-11 op (interactive)
847 6ab1c7b4 2021-08-11 op (let ((msg (buffer-substring-no-properties (point-min)
848 6ab1c7b4 2021-08-11 op (point-max))))
849 6ab1c7b4 2021-08-11 op (with-temp-buffer
850 3dcaa71b 2021-08-31 op (unless (zerop (vc-got--call "tag"
851 3dcaa71b 2021-08-31 op "-m"
852 3dcaa71b 2021-08-31 op (log-edit-extract-headers nil msg)
853 3dcaa71b 2021-08-31 op "--"
854 3dcaa71b 2021-08-31 op tag))
855 6ab1c7b4 2021-08-11 op (error "[vc-got] can't create tag %s: %s" tag (buffer-string))))))
856 8014bde1 2021-08-10 op
857 8014bde1 2021-08-10 op (defun vc-got-create-tag (_dir name branchp)
858 8014bde1 2021-08-10 op "Attach the tag NAME to the state of the worktree.
859 6ab1c7b4 2021-08-11 op DIR is ignored (tags are global, not per-file). If BRANCHP is
860 6ab1c7b4 2021-08-11 op true, NAME should create a new branch otherwise it will pop-up a
861 6ab1c7b4 2021-08-11 op `log-edit' buffer to provide the tag message."
862 8014bde1 2021-08-10 op ;; TODO: vc reccomends to ensure that all the file are in a clean
863 8014bde1 2021-08-10 op ;; state, but is it useful?
864 8014bde1 2021-08-10 op (if branchp
865 8014bde1 2021-08-10 op (vc-got--branch name)
866 6ab1c7b4 2021-08-11 op (let ((buf (get-buffer-create "*vc-got tag*")))
867 6ab1c7b4 2021-08-11 op (with-current-buffer buf
868 6ab1c7b4 2021-08-11 op (erase-buffer)
869 3dcaa71b 2021-08-31 op (save-excursion
870 3dcaa71b 2021-08-31 op (insert "Summary: tag " name "\n\n"))
871 3dcaa71b 2021-08-31 op (move-end-of-line 1)
872 6ab1c7b4 2021-08-11 op (switch-to-buffer buf)
873 6ab1c7b4 2021-08-11 op (log-edit (lambda ()
874 6ab1c7b4 2021-08-11 op (interactive)
875 6ab1c7b4 2021-08-11 op (unwind-protect
876 6ab1c7b4 2021-08-11 op (vc-got--tag-callback name)
877 6ab1c7b4 2021-08-11 op (kill-buffer buf))))))))
878 8014bde1 2021-08-10 op
879 09d59379 2021-08-11 op (defun vc-got-retrieve-tag (dir name _update)
880 09d59379 2021-08-11 op "Switch to the tag NAME for files at or below DIR."
881 09d59379 2021-08-11 op (let ((default-directory dir))
882 db89d6fd 2021-08-16 op (vc-got--update name dir)))
883 09d59379 2021-08-11 op
884 8014bde1 2021-08-10 op
885 424f5152 2021-08-10 op ;; Miscellaneous
886 424f5152 2021-08-10 op
887 2552a6c7 2021-08-11 op (defun vc-got-find-ignore-file (file)
888 2552a6c7 2021-08-11 op "Return the gitignore file that controls FILE."
889 2552a6c7 2021-08-11 op (expand-file-name ".gitignore"
890 2552a6c7 2021-08-11 op (vc-got-root file)))
891 2552a6c7 2021-08-11 op
892 3f25d9ff 2020-01-02 noreply (defun vc-got-previous-revision (file rev)
893 3ec8a8b4 2021-08-17 op "Return the revision number that precedes REV for FILE or nil."
894 3f25d9ff 2020-01-02 noreply (with-temp-buffer
895 3f25d9ff 2020-01-02 noreply (vc-got--log file 2 rev nil nil t)
896 3f25d9ff 2020-01-02 noreply (goto-char (point-min))
897 3f25d9ff 2020-01-02 noreply (keep-lines "^commit")
898 3f25d9ff 2020-01-02 noreply (when (looking-at vc-got--commit-re)
899 3f25d9ff 2020-01-02 noreply (match-string-no-properties 1))))
900 3f25d9ff 2020-01-02 noreply
901 3f25d9ff 2020-01-02 noreply (defun vc-got-next-revision (file rev)
902 3ec8a8b4 2021-08-17 op "Return the revision number that follows REV for FILE or nil."
903 3f25d9ff 2020-01-02 noreply (with-temp-buffer
904 3f25d9ff 2020-01-02 noreply (vc-got--log file nil nil rev)
905 3f25d9ff 2020-01-02 noreply (keep-lines "^commit" (point-min) (point-max))
906 3f25d9ff 2020-01-02 noreply (goto-char (point-max))
907 76d978fa 2021-01-05 op (forward-line -1) ; return from empty line to last actual commit
908 3f25d9ff 2020-01-02 noreply (unless (= (point) (point-min))
909 3f25d9ff 2020-01-02 noreply (forward-line -1)
910 3f25d9ff 2020-01-02 noreply (when (looking-at vc-got--commit-re)
911 3f25d9ff 2020-01-02 noreply (match-string-no-properties 1)))))
912 3f25d9ff 2020-01-02 noreply
913 a96df0e8 2020-01-03 noreply (defun vc-got-delete-file (file)
914 a96df0e8 2020-01-03 noreply "Delete FILE locally and mark it deleted in work tree."
915 a96df0e8 2020-01-03 noreply (vc-got--remove file t))
916 a96df0e8 2020-01-03 noreply
917 c151c257 2021-08-03 op (defun vc-got-find-file-hook ()
918 c151c257 2021-08-03 op "Activate `smerge-mode' if there is a conflict."
919 c151c257 2021-08-03 op ;; just like vc-git-find-file-hook
920 c151c257 2021-08-03 op (when (and buffer-file-name
921 c151c257 2021-08-03 op (eq (vc-state buffer-file-name 'Got) 'conflict)
922 c151c257 2021-08-03 op (save-excursion
923 c151c257 2021-08-03 op (goto-char (point-min))
924 c151c257 2021-08-03 op (re-search-forward "^<<<<<<< " nil 'noerror)))
925 c151c257 2021-08-03 op (smerge-start-session)
926 c151c257 2021-08-03 op (vc-message-unresolved-conflicts buffer-file-name)))
927 c151c257 2021-08-03 op
928 7bb16f79 2020-01-03 op (defun vc-got-conflicted-files (dir)
929 7bb16f79 2020-01-03 op "Return the list of files with conflicts in directory DIR."
930 7bb16f79 2020-01-03 op (let* ((root (vc-got-root dir))
931 7bb16f79 2020-01-03 op (default-directory root)
932 3efc7598 2021-09-09 op (process-file-side-effects nil))
933 3efc7598 2021-09-09 op (cl-loop for (file status _) in (vc-got--status "C" ".")
934 3efc7598 2021-09-09 op when (and (eq status 'conflict)
935 3efc7598 2021-09-09 op (file-in-directory-p file dir))
936 3efc7598 2021-09-09 op collect file)))
937 7bb16f79 2020-01-03 op
938 8b635a9f 2020-01-03 op (defun vc-got-repository-url (_file &optional remote-name)
939 8b635a9f 2020-01-03 op "Return URL for REMOTE-NAME, or for \"origin\" if nil."
940 8b635a9f 2020-01-03 op (let* ((default-directory (vc-got--repo-root))
941 8b635a9f 2020-01-03 op (remote-name (or remote-name "origin"))
942 8b635a9f 2020-01-03 op (heading (concat "[remote \"" remote-name "\"]"))
943 76d978fa 2021-01-05 op (conf (cond ((file-exists-p ".git/config") ".git/config")
944 76d978fa 2021-01-05 op ((file-exists-p ".git") nil)
945 76d978fa 2021-01-05 op ((file-exists-p "config") "config")))
946 8b635a9f 2020-01-03 op found)
947 6f42ede4 2021-01-05 op (when conf
948 6f42ede4 2021-01-05 op (with-temp-buffer
949 f8a9db56 2020-01-03 op (insert-file-contents conf)
950 f8a9db56 2020-01-03 op (goto-char (point-min))
951 f8a9db56 2020-01-03 op (when (search-forward heading nil t)
952 f8a9db56 2020-01-03 op (forward-line)
953 f8a9db56 2020-01-03 op (while (and (not found)
954 76d978fa 2021-01-05 op (looking-at ".*=") ; too broad?
955 7a5ead65 2020-01-03 op (not (= (point) (point-max))))
956 f8a9db56 2020-01-03 op (when (looking-at ".*url = \\(.*\\)")
957 7a5ead65 2020-01-03 op (setq found (match-string-no-properties 1)))
958 7a5ead65 2020-01-03 op (forward-line))
959 f8a9db56 2020-01-03 op found)))))
960 8b635a9f 2020-01-03 op
961 af5ef7cd 2020-11-29 op (provide 'vc-got)
962 af5ef7cd 2020-11-29 op ;;; vc-got.el ends here