1 af5ef7cd 2020-11-29 op ;; vc-got.el --- Game of Tree backend for VC -*- lexical-binding: t; -*-
3 af5ef7cd 2020-11-29 op ;; Copyright © 2020 Omar Polo <op@omarpolo.com>
5 af5ef7cd 2020-11-29 op ;; This file is not part of GNU Emacs.
7 af5ef7cd 2020-11-29 op ;; This file is free software.
9 af5ef7cd 2020-11-29 op ;; Permission to use, copy, modify, and distribute this software for
10 af5ef7cd 2020-11-29 op ;; any purpose with or without fee is hereby granted, provided that
11 af5ef7cd 2020-11-29 op ;; the above copyright notice and this permission notice appear in all
14 af5ef7cd 2020-11-29 op ;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
15 af5ef7cd 2020-11-29 op ;; WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
16 af5ef7cd 2020-11-29 op ;; WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE
17 af5ef7cd 2020-11-29 op ;; AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
18 af5ef7cd 2020-11-29 op ;; CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS
19 af5ef7cd 2020-11-29 op ;; OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT,
20 af5ef7cd 2020-11-29 op ;; NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
21 af5ef7cd 2020-11-29 op ;; CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
23 af5ef7cd 2020-11-29 op ;; Author: Omar Polo <op@omarpolo.com>
24 af5ef7cd 2020-11-29 op ;; URL: https://git.omarpolo.com/vc-got
25 af5ef7cd 2020-11-29 op ;; Keywords: vc vc-backend
27 af5ef7cd 2020-11-29 op ;;; Commentary
29 af5ef7cd 2020-11-29 op ;; Backend implementation status
31 af5ef7cd 2020-11-29 op ;; Function marked with `*' are required, those with `-' are optional.
33 af5ef7cd 2020-11-29 op ;; FUNCTION NAME STATUS
35 af5ef7cd 2020-11-29 op ;; BACKEND PROPERTIES:
36 af5ef7cd 2020-11-29 op ;; * revision-granularity DONE
37 af5ef7cd 2020-11-29 op ;; - update-on-retrieve-tag XXX: what should this do?
39 af5ef7cd 2020-11-29 op ;; STATE-QUERYING FUNCTIONS:
40 af5ef7cd 2020-11-29 op ;; * registered DONE
41 af5ef7cd 2020-11-29 op ;; * state DONE
42 af5ef7cd 2020-11-29 op ;; - dir-status-files DONE
43 af5ef7cd 2020-11-29 op ;; - dir-extra-headers NOT IMPLEMENTED
44 af5ef7cd 2020-11-29 op ;; - dir-printer NOT IMPLEMENTED
45 af5ef7cd 2020-11-29 op ;; - status-fileinfo-extra NOT IMPLEMENTED
46 af5ef7cd 2020-11-29 op ;; * working-revision DONE
47 af5ef7cd 2020-11-29 op ;; * checkout-model DONE
48 af5ef7cd 2020-11-29 op ;; - mode-line-string NOT IMPLEMENTED
50 23a0b465 2020-11-30 op ;; STATE-CHANGING FUNCTIONS:
51 23a0b465 2020-11-30 op ;; * create-repo NOT IMPLEMENTED
52 23a0b465 2020-11-30 op ;; I don't think got init does
53 23a0b465 2020-11-30 op ;; what this function is supposed
55 23a0b465 2020-11-30 op ;; * register DONE
56 23a0b465 2020-11-30 op ;; - responsible-p DONE
57 23a0b465 2020-11-30 op ;; - receive-file NOT IMPLEMENTED
58 23a0b465 2020-11-30 op ;; - unregister NOT IMPLEMENTED
59 23a0b465 2020-11-30 op ;; use remove?
60 23a0b465 2020-11-30 op ;; * checkin DONE
61 23a0b465 2020-11-30 op ;; * find-revision DONE
63 af5ef7cd 2020-11-29 op ;; TODO: use the idiom
64 af5ef7cd 2020-11-29 op ;; (let (process-file-side-effects) ...)
65 af5ef7cd 2020-11-29 op ;; when the got command WON'T change the file. This can enable some
66 af5ef7cd 2020-11-29 op ;; emacs optimizations
70 af5ef7cd 2020-11-29 op (eval-when-compile
71 af5ef7cd 2020-11-29 op (require 'subr-x))
73 af5ef7cd 2020-11-29 op (require 'cl-lib)
74 af5ef7cd 2020-11-29 op (require 'seq)
77 af5ef7cd 2020-11-29 op (defvar vc-got-cmd "got"
78 af5ef7cd 2020-11-29 op "The got command.")
82 af5ef7cd 2020-11-29 op (defun vc-got-root (file)
83 af5ef7cd 2020-11-29 op "Return the work tree root for FILE, or nil."
84 f6e414a6 2020-11-30 op (or (vc-file-getprop file 'got-root)
85 f6e414a6 2020-11-30 op (vc-file-setprop file 'got-root (vc-find-root file ".got"))))
87 af5ef7cd 2020-11-29 op (defmacro vc-got-with-worktree (file &rest body)
88 af5ef7cd 2020-11-29 op "Evaluate BODY in the work tree directory of FILE."
89 af5ef7cd 2020-11-29 op (declare (indent defun))
90 af5ef7cd 2020-11-29 op `(when-let (default-directory (vc-got-root ,file))
93 af5ef7cd 2020-11-29 op (defun vc-got--call (&rest args)
94 af5ef7cd 2020-11-29 op "Call `vc-got-cmd' in the `default-directory' with ARGS and put the output in the current buffer."
95 af5ef7cd 2020-11-29 op (apply #'process-file vc-got-cmd nil (current-buffer) nil args))
97 23a0b465 2020-11-30 op (defun vc-got--add (files)
98 23a0b465 2020-11-30 op "Add FILES to got, passing `vc-register-switches' to the command invocation."
99 23a0b465 2020-11-30 op (with-temp-buffer
100 23a0b465 2020-11-30 op (apply #'vc-got--call "add" (append vc-register-switches files))))
102 af5ef7cd 2020-11-29 op (defun vc-got--log (limit path)
103 23a0b465 2020-11-30 op "Execute the log command in the worktree of PATH.
105 23a0b465 2020-11-30 op The output of the command will be put in the current-buffer.
107 23a0b465 2020-11-30 op LIMIT limits the maximum number of commit returned.
109 23a0b465 2020-11-30 op Return nil if the command failed or if PATH isn't included in any
111 af5ef7cd 2020-11-29 op (vc-got-with-worktree path
112 af5ef7cd 2020-11-29 op (zerop (vc-got--call "log" "-l" (format "%s" limit) path))))
114 af5ef7cd 2020-11-29 op (defun vc-got--status (dir-or-file &rest files)
115 af5ef7cd 2020-11-29 op "Return the output of ``got status''.
117 af5ef7cd 2020-11-29 op DIR-OR-FILE can be either a directory or a file. If FILES is
118 af5ef7cd 2020-11-29 op given, return the status of those files, otherwise the status of
119 af5ef7cd 2020-11-29 op DIR-OR-FILE."
120 af5ef7cd 2020-11-29 op (vc-got-with-worktree dir-or-file
121 af5ef7cd 2020-11-29 op (with-temp-buffer
123 af5ef7cd 2020-11-29 op (apply #'vc-got--call "status" files)
124 af5ef7cd 2020-11-29 op (vc-got--call "status" dir-or-file))
125 af5ef7cd 2020-11-29 op (buffer-string))))
127 af5ef7cd 2020-11-29 op (defun vc-got--parse-status-flag (flag)
128 af5ef7cd 2020-11-29 op "Parse FLAG, see `vc-state'."
129 af5ef7cd 2020-11-29 op ;; got outputs nothing if the file is up-to-date
130 af5ef7cd 2020-11-29 op (if (string-empty-p flag)
132 af5ef7cd 2020-11-29 op ;; trying to follow the order of the manpage
133 af5ef7cd 2020-11-29 op (cl-case (aref flag 0)
136 af5ef7cd 2020-11-29 op (?D 'removed)
137 af5ef7cd 2020-11-29 op (?C 'conflict)
138 af5ef7cd 2020-11-29 op (?! 'missing)
139 af5ef7cd 2020-11-29 op (?~ 'edited) ;XXX: what does it means for a file to be ``obstructed''?
140 af5ef7cd 2020-11-29 op (?? 'unregistered)
141 af5ef7cd 2020-11-29 op (?m 'edited) ;modified file modes
144 af5ef7cd 2020-11-29 op (defun vc-got--parse-status (output)
145 af5ef7cd 2020-11-29 op "Parse the OUTPUT of got status and return an alist of (FILE . STATUS)."
146 af5ef7cd 2020-11-29 op ;; XXX: the output of got is line-oriented and will break if
147 af5ef7cd 2020-11-29 op ;; filenames contains spaces or newlines.
148 af5ef7cd 2020-11-29 op (cl-loop for line in (split-string output "\n" t)
149 af5ef7cd 2020-11-29 op collect (cl-destructuring-bind (status file) (split-string line " " t " ")
150 af5ef7cd 2020-11-29 op `(,file . ,(vc-got--parse-status-flag status)))))
152 23a0b465 2020-11-30 op (defun vc-got--tree-parse ()
153 23a0b465 2020-11-30 op "Parse into an alist the output of got tree -i in the current buffer."
154 23a0b465 2020-11-30 op (goto-char (point-min))
156 23a0b465 2020-11-30 op until (= (point) (point-max))
157 23a0b465 2020-11-30 op collect (let* ((obj-start (point))
158 23a0b465 2020-11-30 op (_ (forward-word))
159 23a0b465 2020-11-30 op (obj (buffer-substring obj-start (point)))
160 23a0b465 2020-11-30 op (_ (forward-char)) ;skip the space
161 23a0b465 2020-11-30 op (filename-start (point))
162 23a0b465 2020-11-30 op (_ (move-end-of-line nil))
163 23a0b465 2020-11-30 op (filename (buffer-substring filename-start (point))))
164 23a0b465 2020-11-30 op ;; goto the start of the next line
165 23a0b465 2020-11-30 op (forward-line)
166 23a0b465 2020-11-30 op (move-beginning-of-line nil)
167 23a0b465 2020-11-30 op `(,filename . ,obj))))
169 23a0b465 2020-11-30 op (defun vc-got--tree (commit path)
170 23a0b465 2020-11-30 op (vc-got-with-worktree path
171 23a0b465 2020-11-30 op (with-temp-buffer
172 23a0b465 2020-11-30 op (vc-got--call "tree" "-c" commit "-i" path)
173 23a0b465 2020-11-30 op (vc-got--tree-parse))))
175 23a0b465 2020-11-30 op (defun vc-got--cat (commit obj-id)
176 23a0b465 2020-11-30 op "Execute got cat -c COMMIT OBJ-ID in the current buffer."
177 23a0b465 2020-11-30 op (vc-got--call "cat" "-c" commit obj-id))
180 af5ef7cd 2020-11-29 op ;; Backend properties
182 af5ef7cd 2020-11-29 op (defun vc-got-revision-granularity ()
183 af5ef7cd 2020-11-29 op "Got has REPOSITORY granularity."
186 af5ef7cd 2020-11-29 op ;; XXX: what this should do? The description is not entirely clear
187 af5ef7cd 2020-11-29 op (defun vc-got-update-on-retrieve-tag ()
191 af5ef7cd 2020-11-29 op ;; State-querying functions
193 af5ef7cd 2020-11-29 op ;;;###autoload (defun vc-got-registered (file)
194 af5ef7cd 2020-11-29 op ;;;###autoload "Return non-nil if FILE is registered with got."
195 af5ef7cd 2020-11-29 op ;;;###autoload (when (vc-find-root file ".got")
196 af5ef7cd 2020-11-29 op ;;;###autoload (load "vc-got" nil t)
197 af5ef7cd 2020-11-29 op ;;;###autoload (vc-got-registered file)))
199 af5ef7cd 2020-11-29 op (defun vc-got-registered (file)
200 af5ef7cd 2020-11-29 op "Return non-nil if FILE is registered with got."
201 af5ef7cd 2020-11-29 op (if (file-directory-p file)
202 af5ef7cd 2020-11-29 op nil ;got doesn't track directories
203 af5ef7cd 2020-11-29 op (let ((status (vc-got--status file)))
204 af5ef7cd 2020-11-29 op (not (or (string-prefix-p "?" status)
205 af5ef7cd 2020-11-29 op (string-prefix-p "N" status))))))
207 af5ef7cd 2020-11-29 op ;; (vc-got-registered "/usr/ports/mystuff/net/td")
208 af5ef7cd 2020-11-29 op ;; (vc-got-registered "/usr/ports/mystuff/net/td/Makefile")
209 af5ef7cd 2020-11-29 op ;; (vc-got-registered "/usr/ports/mystuff/tmp")
210 af5ef7cd 2020-11-29 op ;; (vc-got-registered "/usr/ports/mystuff/no-existant")
212 af5ef7cd 2020-11-29 op (defun vc-got-state (file)
213 af5ef7cd 2020-11-29 op "Return the current version control state of FILE. See `vc-state'."
214 af5ef7cd 2020-11-29 op (unless (file-directory-p file)
215 af5ef7cd 2020-11-29 op (vc-got--parse-status-flag (vc-got--status file))))
217 af5ef7cd 2020-11-29 op ;; (vc-got-state "/usr/ports/mystuff/net/td")
218 af5ef7cd 2020-11-29 op ;; (vc-got-state "/usr/ports/mystuff/net/td/Makefile")
219 af5ef7cd 2020-11-29 op ;; (vc-got-state "/usr/ports/mystuff/tmp")
220 af5ef7cd 2020-11-29 op ;; (vc-got-state "/usr/ports/mystuff/non-existant")
222 af5ef7cd 2020-11-29 op (defun vc-got-dir-status-files (dir files update-function)
223 af5ef7cd 2020-11-29 op (let* ((files (seq-filter (lambda (file)
224 af5ef7cd 2020-11-29 op (and (not (string= file ".."))
225 af5ef7cd 2020-11-29 op (not (string= file "."))
226 af5ef7cd 2020-11-29 op (not (string= file ".got"))))
228 af5ef7cd 2020-11-29 op (directory-files dir))))
229 af5ef7cd 2020-11-29 op (statuses (vc-got--parse-status
230 af5ef7cd 2020-11-29 op (apply #'vc-got--status dir files)))
231 af5ef7cd 2020-11-29 op (default-directory dir))
233 af5ef7cd 2020-11-29 op with result = nil
234 af5ef7cd 2020-11-29 op for file in files
235 af5ef7cd 2020-11-29 op do (setq result
237 af5ef7cd 2020-11-29 op (if (file-directory-p file)
238 af5ef7cd 2020-11-29 op (list file 'unregistered nil)
239 af5ef7cd 2020-11-29 op (if-let (status (cdr (assoc file statuses #'string=)))
240 af5ef7cd 2020-11-29 op (list file status nil)
241 af5ef7cd 2020-11-29 op (list file 'up-to-date nil)))
243 af5ef7cd 2020-11-29 op finally (funcall update-function result nil))))
245 af5ef7cd 2020-11-29 op ;; (let ((dir "/usr/ports/mystuff"))
246 af5ef7cd 2020-11-29 op ;; (vc-got-dir-status-files dir nil (lambda (res _t)
247 af5ef7cd 2020-11-29 op ;; (message "got %s" res))))
249 af5ef7cd 2020-11-29 op (defun vc-got-working-revision (file)
250 af5ef7cd 2020-11-29 op "Return the id of the last commit that touched the FILE.
252 af5ef7cd 2020-11-29 op Return \"0\" for a file added but not yet committed."
254 af5ef7cd 2020-11-29 op (with-temp-buffer
255 af5ef7cd 2020-11-29 op (when (vc-got--log 1 file)
257 af5ef7cd 2020-11-29 op (goto-char (point-min))
258 af5ef7cd 2020-11-29 op (forward-line 1) ;skip the ----- line
259 af5ef7cd 2020-11-29 op (forward-word) ;skip "commit"
260 af5ef7cd 2020-11-29 op (forward-char) ;skip the space
261 af5ef7cd 2020-11-29 op (setq start (point)) ;store start of the SHA
262 af5ef7cd 2020-11-29 op (forward-word) ;goto SHA end
263 af5ef7cd 2020-11-29 op (buffer-substring start (point)))))
264 af5ef7cd 2020-11-29 op ;; special case: if this file is added but has no previous commits
265 af5ef7cd 2020-11-29 op ;; touching it, got log will fail (as expected), but we have to
266 af5ef7cd 2020-11-29 op ;; return "0".
267 af5ef7cd 2020-11-29 op (when (eq (vc-got-state file) 'added)
270 af5ef7cd 2020-11-29 op ;; (vc-got-working-revision "/usr/ports/mystuff/non-existant")
271 af5ef7cd 2020-11-29 op ;; (vc-got-working-revision "/usr/ports/mystuff/CVS")
272 af5ef7cd 2020-11-29 op ;; (vc-got-working-revision "/usr/ports/mystuff/tmp")
273 af5ef7cd 2020-11-29 op ;; (vc-got-working-revision "/usr/ports/mystuff/net/td/Makefile")
275 af5ef7cd 2020-11-29 op (defun vc-got-checkout-model (_files)
279 23a0b465 2020-11-30 op ;; state-changing functions
281 23a0b465 2020-11-30 op (defun vc-got-create-repo (_backend)
282 23a0b465 2020-11-30 op (error "vc got: create-repo not implemented"))
284 23a0b465 2020-11-30 op (defun vc-got-register (files &optional _comment)
285 23a0b465 2020-11-30 op "Register FILES, passing `vc-register-switches' to the backend command."
286 23a0b465 2020-11-30 op (vc-got--add files))
288 9e805da8 2020-11-30 op (defalias 'vc-got-responsible-p #'vc-got-root)
290 23a0b465 2020-11-30 op (defun vc-got-checkin (files comment &optional _rev)
291 23a0b465 2020-11-30 op "Commit FILES with COMMENT as commit message."
292 23a0b465 2020-11-30 op (with-temp-buffer
293 23a0b465 2020-11-30 op (apply #'vc-got--call "commit" "-m" comment files)))
295 23a0b465 2020-11-30 op (defun vc-got-find-revision (file rev buffer)
296 23a0b465 2020-11-30 op (when-let (obj-id (assoc file (vc-got--tree rev file) #'string=))
297 23a0b465 2020-11-30 op (with-current-buffer buffer
298 23a0b465 2020-11-30 op (vc-got-with-worktree file
299 23a0b465 2020-11-30 op (vc-got--cat rev obj-id)))))
301 af5ef7cd 2020-11-29 op (provide 'vc-got)
302 af5ef7cd 2020-11-29 op ;;; vc-got.el ends here
